If my input is a list of lists, then I want to output a list with elements from the input so that they are shuffled like a deck of playing cards.
For example, if input is '((1 2 3) (4 5)) then I want output to show up as '(1 4 2 5 3).
My idea is to first remove an element from the first list inside of a list, and then move that list of a list to the back of the list. This way, the first element of the next list of a list can then be appended.
Here is my code so far:
(define (shuffle ls)
(if (null? ls) '()
(cond ((null? car (ls)) (append (cdr (ls)) (list (cdr(car(ls)))))))
(else (car (car (ls)))
(append (cdr (ls)) (list (cdr (car (ls))))
(shuffle (cdr (ls)))))))
[All the code snippets here require SRFI 1 to be loaded first.]
What you seem to be wanting is to zip the lists:
> (zip '(1 2 3) '(4 5))
((1 4) (2 5))
However, as you can see, this stops when it gets to the end of the shortest list. Maybe you can write a custom zip that will stop after all elements are exhausted:
(define (my-zip l1 l2)
(cond ((and (null? l1) (null? l2)) '())
((null? l1) (cons (car l2) (my-zip l1 (cdr l2))))
((null? l2) (cons (car l1) (my-zip (cdr l1) l2)))
(else (cons* (car l1) (car l2) (my-zip (cdr l1) (cdr l2))))))
Let's try it out!
> (my-zip '(1 2 3) '(4 5))
(1 4 2 5 3)
> (my-zip '(1 2 3) '(4 5 6 7))
(1 4 2 5 3 6 7)
this would work too... i use chicken scheme so i have to "import" filter from srfi-1.
(use srfi-1)
(define *deck* '((1 2 3 4) (5 6 7) (9 10 11 12)))
(define nullcar?
(lambda (x)
(if (not (null? x))
(null? (car x)))))
(define nullcdr?
(lambda (x)
(if (not (null? x))
(null? (cdr x)))))
(define notnulls
(lambda (x)
(filter (lambda (e)
(not (null? e)))
x)))
(define firsts
(lambda (l)
(if (not (null? l))
(map (lambda (x)
(if (not (null? x))
(car x)
'()))
l))))
(define shuf
(lambda (d)
(notnulls
(append (firsts d)
(if (not (nullcar? d))
(if (not (nullcdr? d))
(shuf (map cdr (notnulls d)))
'())
'())))))
cheers!
Related
I'm currently working on building a function that returns a row of Pascal's triangle. My function passes in a list that contains a row in Pascal's triangle and returns the next row depending on which row was passed in.
ex. pass in '(1 2 1) and it should return '(1 3 3 1).
However I cannot seem to get the beginning 1 in the list.
(define build-next
(lambda(thisRow)
(cond
[(null? thisRow) '(1)]
[(null? (cdr thisRow)) (cons 1 (cdr thisRow))]
[else (cons (+ (car thisRow) (car (cdr thisRow))) (build-next(cdr thisRow)))])))
(build-next '(1 2 1))
Running this code will give me the output
'(3 3 1)
without the leading 1
Your functions works if the input row has a zero as first element.
Renaming your original function to build-next-helper and introducing
a new build-next that simply calls your existing function after prefixing a zero works fine:
(define build-next-helper
(lambda (thisRow)
(cond
[(null? thisRow) '(1)]
[(null? (cdr thisRow)) (cons 1 (cdr thisRow))]
[else (cons (+ (car thisRow) (car (cdr thisRow)))
(build-next-helper (cdr thisRow)))])))
(define (build-next thisRow)
(build-next-helper (cons 0 thisRow)))
(build-next '(1 2 1))
You can also use a named let to write build-next as follows:
(define (build-next row)
(let loop ([row row]
[acc 0])
(cond
[(zero? acc)
(cons 1 (loop row (add1 acc)))]
[(null? row) empty]
[(null? (cdr row)) (list 1)]
[else
(cons (+ (car row) (cadr row))
(loop (cdr row) acc))])))
The loop parameter acc is used as an accumulator to add the leading 1 in the next row (ie. first cond case).
For example,
(build-next '()) ;;=> '(1)
(build-next '(1)) ;;=> '(1 1)
(build-next '(1 1)) ;;=> '(1 2 1)
(build-next '(1 2 1)) ;;=> '(1 3 3 1)
(build-next '(1 3 3 1)) ;;=> '(1 4 6 4 1)
(build-next '(1 4 6 4 1)) ;;=> '(1 5 10 10 5 1)
Here is a possible solution:
(define build-next
(lambda(thisRow)
(define helper-build-next
(lambda (lst prev)
(if (null? lst)
(list prev)
(cons (+ prev (car lst)) (helper-build-next (cdr lst) (car lst))))))
(if (null? thisRow)
(list 1)
(cons (car thisRow) (helper-build-next (cdr thisRow) (car thisRow))))))
The recursion is performed through a helper function, that gets the rest of the row and the previous element of the row. Initially the function checks if the parameter is the empty list, so that the first row of the triangle is returned. Otherwise, the helper function is called with the initial parameters.
i need to create a list such that the min is always at the outside in a list.
Example
input (1 2 3)
output (1 (2 3))
Here is my code, assuming that the numbers are in descending order, which i wish to extent later to a general case.
I am getting an unexpected output of (3 2 1 0 -1 -2 -3 ()).
How do I achieve this in scheme any ideas?'
(define (find-min-rest L)
(if (null? (cdr L)) (let ( (x (car L))) (cons x '( ())))
(let* ((ret-ans (find-min-rest (cdr L))) (cur-elem (car L)) (mini (car ret-ans)) (rem-list (cdr ret-ans)))
(cond ((> cur-elem mini) (cons cur-elem (cons mini rem-list)))))))
It'll be simpler if you use built-in procedures, and split the problem in parts. Notice that the following assumes that there's a single minimum, adjust as necessary:
(define (find-min-rest L)
(let* ((the-min (apply min L))
(the-rest (remove the-min L)))
(list the-min the-rest)))
(find-min-rest '(1 2 3))
=> '(1 (2 3))
The code
(define (find-min-rest L)
(if (null? (cdr L)) (let ( (x (car L))) (cons x '( ())))
(let* ((ret-ans (find-min-rest (cdr L))) (cur-elem (car L)) (mini (car ret-ans)) (rem-list (cdr ret-ans)))
(cond ((> cur-elem mini) (cons cur-elem (cons mini rem-list)))))))
I'm trying to teach myself functional language thinking and have written a procedure that takes a list and returns a list with duplicates filtered out. This works, but the output list is sorted in the order in which the last instance of each duplicate item is found in the input list.
(define (inlist L n)
(cond
((null? L) #f)
((= (car L) n) #t)
(else (inlist (cdr L) n))
))
(define (uniquelist L)
(cond
((null? L) '())
((= 1 (length L)) L)
((inlist (cdr L) (car L)) (uniquelist (cdr L)))
(else (cons (car L) (uniquelist (cdr L))))
))
So..
(uniquelist '(1 1 2 3)) => (1 2 3)
...but...
(uniquelist '(1 2 3 1)) => (2 3 1)
Is there a simple alternative that maintains the order of the first instance of each duplicate?
The best way to solve this problem would be to use Racket's built-in remove-duplicates procedure. But of course, you want to implement the solution from scratch. Here's a way using idiomatic Racket, and notice that we can use member (another built-in function) in place of inlist:
(define (uniquelist L)
(let loop ([lst (reverse L)] [acc empty])
(cond [(empty? lst)
acc]
[(member (first lst) (rest lst))
(loop (rest lst) acc)]
[else
(loop (rest lst) (cons (first lst) acc))])))
Or we can write the same procedure using standard Scheme, as shown in SICP:
(define (uniquelist L)
(let loop ((lst (reverse L)) (acc '()))
(cond ((null? lst)
acc)
((member (car lst) (cdr lst))
(loop (cdr lst) acc))
(else
(loop (cdr lst) (cons (car lst) acc))))))
The above makes use of a named let for iteration, and shows how to write a tail-recursive implementation. It works as expected:
(uniquelist '(1 1 2 3))
=> '(1 2 3)
(uniquelist '(1 2 3 1))
=> '(1 2 3)
I'm trying to reverse a list, here's my code:
(define (reverse list)
(if (null? list)
list
(list (reverse (cdr list)) (car list))))
so if i enter (reverse '(1 2 3 4)), I want it to come out as (4 3 2 1), but right now it's not giving me that. What am I doing wrong and how can I fix it?
The natural way to recur over a list is not the best way to solve this problem. Using append, as suggested in the accepted answer pointed by #lancery, is not a good idea either - and anyway if you're learning your way in Scheme it's best if you try to implement the solution yourself, I'll show you what to do, but first a tip - don't use list as a parameter name, that's a built-in procedure and you'd be overwriting it. Use other name, say, lst.
It's simpler to reverse a list by means of a helper procedure that accumulates the result of consing each element at the head of the result, this will have the effect of reversing the list - incidentally, the helper procedure is tail-recursive. Here's the general idea, fill-in the blanks:
(define (reverse lst)
(<???> lst '())) ; call the helper procedure
(define (reverse-aux lst acc)
(if <???> ; if the list is empty
<???> ; return the accumulator
(reverse-aux <???> ; advance the recursion over the list
(cons <???> <???>)))) ; cons current element with accumulator
Of course, in real-life you wouldn't implement reverse from scratch, there's a built-in procedure for that.
Here is a recursive procedure that describes an iterative process (tail recursive) of reversing a list in Scheme
(define (reverse lst)
(define (go lst tail)
(if (null? lst) tail
(go (cdr lst) (cons (car lst) tail))))
(go lst ())))
Using substitution model for (reverse (list 1 2 3 4))
;; (reverse (list 1 2 3 4))
;; (go (list 1 2 3 4) ())
;; (go (list 2 3 4) (list 1))
;; (go (list 3 4) (list 2 1))
;; (go (list 4) (list 3 2 1))
;; (go () (list 4 3 2 1))
;; (list 4 3 2 1)
Here is a recursive procedure that describes a recursive process (not tail recursive) of reversing a list in Scheme
(define (reverse2 lst)
(if (null? lst) ()
(append (reverse2 (cdr lst)) (list (car lst)))))
(define (append l1 l2)
(if (null? l1) l2
(cons (car l1) (append (cdr l1) l2))))
Using substitution model for (reverse2 (list 1 2 3 4))
;; (reverse2 (list 1 2 3 4))
;; (append (reverse2 (list 2 3 4)) (list 1))
;; (append (append (reverse2 (list 3 4)) (list 2)) (list 1))
;; (append (append (append (reverse2 (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (append (reverse2 ()) (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (append () (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (list 4) (list 3)) (list 2)) (list 1))
;; (append (append (list 4 3) (list 2)) (list 1))
;; (append (list 4 3 2) (list 1))
;; (list 4 3 2 1)
Tail recursive approach using a named let:
(define (reverse lst)
(let loop ([lst lst] [lst-reversed '()])
(if (empty? lst)
lst-reversed
(loop (rest lst) (cons (first lst) lst-reversed)))))
This is basically the same approach as having a helper function with an accumulator argument as in Oscar's answer, where the loop binding after let makes the let into an inner function you can call.
Here's a solution using build-list procedure:
(define reverse
(lambda (l)
(let ((len (length l)))
(build-list len
(lambda (i)
(list-ref l (- len i 1)))))))
This one works but it is not a tail recursive procedure:
(define (rev lst)
(if (null? lst)
'()
(append (rev (cdr lst)) (car lst))))
Tail recursive solution:
(define (reverse oldlist)
(define (t-reverse oldlist newlist)
(if (null? oldlist)
newlist
(t-reverse (cdr oldlist) (cons (car oldlist) newest))))
(t-reverse oldlist '()))
Just left fold the list using cons:
(define (reverse list) (foldl cons null list))
This is also efficient because foldl is tail recursive and there is no need for append. This can also be done point-free (using curry from racket):
(define reverse (curry foldl cons null))
(define reverse?
(lambda (l)
(define reverse-aux?
(lambda (l col)
(cond
((null? l) (col ))
(else
(reverse-aux? (cdr l)
(lambda ()
(cons (car l) (col))))))))
(reverse-aux? l (lambda () (quote ())))))
(reverse? '(1 2 3 4) )
One more answer similar to Oscar's. I have just started learning scheme, so excuse me in case you find issues :).
There's actually no need for appending or filling the body with a bunch of lambdas.
(define (reverse items)
(if (null? items)
'()
(cons (reverse (cdr items)) (car items))))
I think it would be better to use append instead of cons
(define (myrev l)
(if (null? l)
'()
(append (myrev (cdr l)) (list (car l)))
)
)
this another version with tail recursion
(define (myrev2 l)
(define (loop l acc)
(if (null? l)
acc
(loop (cdr l) (append (list (car l)) acc ))
)
)
(loop l '())
)
I am trying to add two numbers (from lists) together in scheme while preserving list format. However, when the numbers being used for calculations add to something greater than or equal to 10 I get an undesired result. For example:
(define (reverse lst)
(if (null? lst)
'()
(append (reverse (cdr lst))
(list (car lst)))))
(define (apa-add lst1 lst2)
(cond ((null? lst1) lst2)
((null? lst2) lst1)
((>= (+ (car lst1) (car lst2)) 10)
(append (apa-add (cdr lst1) (cdr lst2))
(list (quotient(+ (car lst1) (car lst2)) 10))
(list (modulo (+ (car lst1) (car lst2)) 10))))
(else
(append (apa-add (cdr lst1) (cdr lst2))
(list (+ (car lst1) (car lst2)))))))
(apa-add (reverse '(4 4 5)) (reverse'(3 5 8)))
returns
'(7 9 1 3)
How can I modify my code to fix this error? I wanted to use a let statement so I could add the evaluation of (quotient (+ (car lst1) (car lst2)) 10) to (list (+ (car lst1) (car lst2))) of the next call, but I couldn't think of how to do this.
Making this into a tail call simplifies things a bit.
(define (apa-add lst1 lst2)
(let loop ((carry 0) (L1 (reverse lst1)) (L2 (reverse lst2)) (sum '()))
(cond ((and (null? l1) (null? l2))
(if (zero? carry) sum (cons carry sum)))
((null? L1)
(loop (quotient (+ carry (car l2)) 10)
'()
(cdr L2)
(cons (modulo (+ carry (car l2)) 10) sum)))
((null? L2)
(loop (quotient (+ carry (car l1)) 10)
(cdr l1)
'()
(cons (modulo (+ carry (car l1)) 10) sum)))
(else
(loop (quotient (+ carry (car l1) (car l2)) 10)
(cdr l1)
(cdr l2)
(cons (modulo (+ carry (car l1) (car l2)) 10) sum))))))
(apa-add (list 4 4 5) (list 3 5 8))
;Value 4: (8 0 3)
probably wouldnt be too hard to convert to an n-arity function.
(define (apa-add . Lists)
(define (cdrs-no-null L)
(cond ((null? L) '())
((null? (cdar l)) (cdrs-no-null (cdr L)))
(else (cons (cdar l) (cdrs-no-null (cdr l))))))
(let loop ((carry 0) (Lists (map reverse Lists)) (sum '()))
(if (null? Lists)
(if (zero? carry) sum (cons carry sum))
(loop (quotient (fold + carry (map car Lists)) 10)
(cdrs-no-null Lists)
(cons (modulo (fold + carry (map car Lists)) 10) sum)))))
(apa-add (list 4 4 5) (list 3 5 8) (list 1 0 2 7))
;Value 11: (1 8 3 0)
(apa-add (list 4 4 5) (list 3 5 8))
;Value 12: (8 0 3)