im trying to write a function in Scheme where i accept a list and return all the different derangements (look below for definition) as a list of lists
derangement: A list where no item is in the same place as the original list
ex: '(a b c) -> '(cab)
any help is appreciated!
Compute all of the permutations of the input list and then filter out the ones that have an element in the same position as the input list. If you need more detail, leave a comment.
Edit 1:
Define (or maybe it's defined already? Good exercise, anyway) a procedure called filter that takes as its first argument a procedure p and a list l as its second argument. Return a list containing only the values for which (p l) returns a truthy value.
Define a procedure derangement? that tests if a list l1 is a derangement of l2. This will be handy when paired with filter.
The most obvious solution would be something like this:
(define filtered-permutations
(lambda (lst)
(filter
(lambda (permuted-list)
(deranged? permuted-list lst))
(permute lst))))
Since the number of derangements is considerably lower than then number of permutations, however, this is not very efficient. Here is a solution that mostly avoids generating permutations that are not derangements, but does use filter once, for the sake of simplicity:
(define deranged?
(lambda (lst1 lst2)
(if (null? lst1)
#t
(if (eq? (car lst1) (car lst2))
#f
(deranged? (cdr lst1) (cdr lst2))))))
(define derange
(lambda (lst)
(if (< (length lst) 2)
;; a list of zero or one elements can not be deranged
'()
(permute-helper lst lst))))
(define derange-helper
(lambda (lst template)
(if (= 2 (length lst))
(let ((one (car lst))
(two (cadr lst)))
(filter
(lambda (x)
(deranged? x template))
(list (list one two) (list two one))))
(let ((anchor (car template)))
(let loop ((todo lst)
(done '())
(result '()))
(if (null? todo)
result
(let ((item (car todo)))
(if (eq? item anchor)
;; this permutation would not be a derangement
(loop (cdr todo)
(cons item done)
result)
(let ((permutations
(map
(lambda (x)
(cons item x))
(derange-helper (append (cdr todo) done)
(cdr template)))))
(loop (cdr todo)
(cons item done)
(append result permutations)))))))))))
Related
My program works with all lists except the improper lists (which have an atom in the cdr field of the last cons cell). Please help upgrade this program to work with the improper lists:
(define (ndelete lst)
(let recur ((i 1) (rest lst))
(cond ((null? rest) '())
((= i 2) (recur 1 (cdr rest)))
(else (cons (car rest) (recur (+ i 1) (cdr rest)))))))
You just need to fix your base condition, (null? rest). If you want to support improper lists, you should check for (not (pair? rest)) instead.
Of course, this has an annoying side-effect of making your function handle any object - not just lists. For any non-list object, it just returns nil. If that's a problem for you, you'll need to encapsulate your recursive function and make sure lst is in fact a list. Like so:
(define (ndelete lst)
(letrec ((recur (lambda (i rest)
(cond ((not (pair? rest)) '())
((= i 2) (recur 1 (cdr rest)))
(else (cons (car rest) (recur (+ i 1) (cdr rest))))))))
(if (pair? lst)
(recur 1 lst)
(raise (condition (make-error)
(make-message-condition `(,lst is not a pair)))))))
I'm trying to do a program in scheme for a school assignment. Given a list, it's supposed to return all given permutations of that list. My issue is that I don't know why it would work for numbers but not characters. Doesn't seem like it would change any of the logic!
Here is my code:
(define (remove1 x lst)
(cond
((null? lst) '())
((= x (car lst)) (remove1 x (cdr lst)))
(else (cons (car lst)
(remove1 x (cdr lst))))))
(define (permute lst)
(cond
((= (length lst) 1) (list lst))
(else (apply append (map (lambda (i)
(map (lambda (j) (cons i j))
(permute (remove1 i lst))))
lst)))))
(permute '(1 2 3))
= is used for comparing numbers; for more general comparisons, use eq?, equal? or (as has been suggested) eqv?.
Assume (list "apple" "orange" "apple" "grape" "orange")and produce (list (list 2 "apple") (list 2 "orange") (list 1 "grape")).
The most common fruit will occur first in the produced list.
In the case of ties, order the tied pairs with the fruit in increasing alphabetical order.
use abstract list function such as map,filter, foldr and quicksort in local. no recursion.
i'm not sure how to do it without recursion.
i wrote like this:
(define (function list)
(cond
[(empty? list) empty]
[else
(local
(define (helper1 a b)
(cond
[(equal? a b) a]
[else b]))
(define T (foldr helper1 (first list) (rest list)))
(define (count a)
(cond
[(equal? a T) true]
[else false]))
(define new-list (quicksort (length (filter count list)) >))]
The most efficient way is to use a (mutable) hash table:
(define (count-by-type lst)
; create hash
(define h (make-hash))
; update hash, creating entries if needed, otherwise adding 1 to existing entry
(map (lambda (e) (hash-update! h e add1 0)) lst)
; create list of (count key) elements from hash and sort accordingly
(sort (map (lambda (e) (list (cdr e) (car e))) (hash->list h))
(lambda (x y) (or (> (car x) (car y))
(and (= (car x) (car y)) (string<? (cadr x) (cadr y)))))))
testing:
> (count-by-type (list "apple" "orange" "apple" "grape" "orange"))
'((2 "apple") (2 "orange") (1 "grape"))
I just rehashed my own answer from a previous question. This seems to be a similar assignment, but without struct
Using a hash you could do it with only one pass through the unsorted list, then produced a list that then was sorted with a special <-function that sorts by count, then fruit.
These hints are for a functional solution. First sort the argument (sort list-of-fruits string>?). that the in descending order and oposite of your result. .
Given the list has at least one element:
(let rec ((cur (car sorted-fruits)) (cnt 1) (lst (cdr sorted-fruits)) (acc '()))
(cond ((equal? cur (car lst)) (rec cur (add1 cnt) (cdr lst) acc))
(else (rec (car lst) 1 (cdr lst) (cons (list cnt cur) acc)))))
This will produce a list in ascending order with counts.
If you sort again:
(sort list-of-counts-and-fruit (lambda (x y) (>= (car x) (car y)))
sort in Racket is stable. That means if you have two with equal counts in the list they will end up in their original order. The original order was the ascending animal order so the result is ordered by count descending, then name ascending.
I guess your procedure can be made by chaining these together, perhaps using let to store intermediates to make expressions shorter and more readable.
Let's say we have this list '( (4 (1 2)) (5 (5 5)) (7 (3 1)) (1 (2 3)))
I am trying to write smth in Scheme in order to get the second element for every element in the list.. So the result will look like '( (1 2) (5 5) (3 1) (2 3))
I have this code so far..
(define (second list1)
(if (null? (cdr list1))
(cdr (car list1))
((cdr (car list1))(second (cdr list1)))))
Here's a straightforward solution:
(define (seconds lst)
(map cadr lst))
In general, when you want to transform every element of a list, map is the way to go.
All you need to do is map the built-in function second onto the list lst:
(map second lst)
Your error is that you lack an operator, perhaps cons. If you look at the consequent:
((cdr (car list1))(second (cdr list1)))
So Scheme expects (cdr (car list)) to be a procedure since it's in operator position in the form, but since it isn't you get an error. In addition (cdr (car x)) == cdar wont take the second element in every element but the tail of each element. cadar is what you're lookig for.
(define (second list1)00+
(if (null? (cdr list1))
(cons (cadar list1) '())
(cons (cadar list1) (second (cdr list1)))))
It will fail for the empty list. To fix this you let the consequemt take care of every element and the base case only to stop:
(define (second list1)
(if (null? list1)
'()
(cons (cadar list1) (second (cdr list1)))))
The result for a list will be the same. There is a procedure called map. It supports several list arguments, but the implementation for one is:
(define (map fun lst)
(if (null? lst)
'()
(cons (fun (car lst)) (map fun (cdr lst)))))
Looks familiar? Both make a list based on each element, but map is generic. Thus we should try to make (fun (car lst)) do the same as (cadar lst).
(define (second lst)
(map cadr lst)) ; (cadr (car x)) == (cadar x)
There you have it. Chris beat me to it, but I'd like to comment one of the other answers that uses the abbreviation second. It's defined in racket/base and the library SRFI-1, but it's not mentioned in the last Scheme reports. I.e. some implementations might require an extra library to be imported for it to work.
I'd like to create a Scheme function that yields true if it is passed a list that is composed entirely of identical elements. Such a list would be '(1 1 1 1). It would yield false with something like '(1 2 1 1).
This is what I have so far:
(define (list-equal? lst)
(define tmp (car lst))
(for-each (lambda (x)
(equal? x tmp))
lst)
)
Clearly this is incorrect, and I'm new to this. I guess I'm unable to express the step where I'm supposed to return #t or #f.
Thanks in advance!
EDIT:
I fiddled a bit and found a solution that seems to work very well, and with a minimal amount of code:
(define (list-equal? lst)
(andmap (lambda (x)
(equal? x (car lst)))
lst))
Thanks again for the help everyone.
Minimal amount of code, if you don't care that it only works for numbers:
(define (list-equel? lst)
(apply = lst))
Examples:
> (list-equel? '(1 1 2 1))
#f
> (list-equel? '(1 1 1 1))
#t
> (list-equel? '(1))
#t
The andmap solution is nice, but if andmap is not available, you can use this. It uses basic operations (and, or, null check, equality check) and handles empty lists and one element lists. Similar to Sean's implementation, but no helper definition is necessary.
(define (list-equal? args)
(or (or (null? args)
(null? (cdr args)))
(and (eq? (car args) (cadr args))
(list-equal? (cdr args)))))
Try something like this:
(define (list-equal? lst)
(define (helper el lst)
(or (null? lst)
(and (eq? el (car lst))
(helper (car lst) (cdr lst)))))
(or (null? lst)
(helper (car lst) (cdr lst))))
This might not be the cleanest implementation, but I think it will correctly handle the cases of empty lists and one-element lists.
In R6RS there's the for-all function, which takes a predicate and a list, and returns #t if the predicate returns true for all elements in the list and #f otherwise, which is exactly what you need here.
So if you're using R6RS (or any other scheme dialect that has the for-all function), you can just replace for-each with for-all in your code and it will work.
(define (list-equal? lst)
(if (= (cdr lst) null)
true
(and (equal? (car lst) (cadr lst))
(list-equal? (cdr lst)))))
Something like this should work:
(define (list-equal? lst)
(cond ((< (length lst) 2) #t)
(#t (and (equal? (car lst) (cadr lst))
(list-equal? (cdr lst))))))
The other answers in this thread all seem too complicated (I read through them all), so here's my take on it:
(define (all-equal? lst)
(define item (car lst))
(let next ((lst (cdr lst)))
(cond ((null? lst) #t)
((equal? item (car lst)) (next (cdr lst)))
(else #f))))
(It does not work with an empty list, by design. It's easy to add a (if (null? lst) #t ...) if necessary.)
A short, concise solution:
#lang racket
(define (all-equal? lst)
(for/and
([i (in-permutations lst)])
(equal? (first i) (second i))))
; TEST CASES
(require rackunit)
(check-false (all-equal? '(1 2 3)))
(check-true (all-equal? '(1 1 1)))
(check-true (all-equal? '()))
Note that this uses racket, so this may not work with your scheme implementation.
Yet another solution:
(define (all-same ls)
(cond
((or (null? ls)
(null? (cdr ls))) #t)
(else (and (equal? (car ls) (next ls))
(all-same (cdr ls)))))))
(define (next ls)
(cond
((or (null? ls)
(null? (cdr ls))) '())
(else (cadr ls)))))
For is bad in these languages. Try
(define list-equal?
(lambda (lst)
(if (= lst null)
(true)
(foldr = (car lst) (cdr lst))
)))