in "The Scheme Programming Language 4th Edition", there is a example as below:
(define product
(lambda (ls)
(call/cc
(lambda (break)
(let f ([ls ls])
(cond
[(null? ls) 1]
[(= (car ls) 0) (break 0)]
[else (* (car ls) (f (cdr ls)))]))))))
(product '(1 2 3 4 5)) => 120
(product '(7 3 8 0 1 9 5)) => 0
later it is converted into CPS in 3.3 as below
(define product
(lambda (ls k)
(let ([break k])
(let f ([ls ls] [k k])
(cond
[(null? ls) (k 1)]
[(= (car ls) 0) (break 0)]
[else (f (cdr ls)
(lambda (x)
(k (* (car ls) x))))])))))
(product '(1 2 3 4 5) (lambda (x) x)) => 120
(product '(7 3 8 0 1 9 5) (lambda (x) x)) => 0
I want to do it myself, The corresponding CPS is below
(define (product ls prod break)
(cond
((null? ls)
(break prod))
((= (car ls) 0)
(break 0))
(else
(product (cdr ls) (* prod (car ls)) break))))
(product '(1 2 3 4 5) 1 (lambda (x) x)) => 120
(product '(1 2 0 4 5) 1 (lambda (x) x)) => 0
I want to ask my CPS is right? T
Thanks in advance!
BEST REGARDS
I think this is the correct implementation :
(define inside-product #f) ;; to demonstrate the continuation
(define (product ls prod break)
(cond
((null? ls)
(begin
(set! inside-product prod)
(prod 1)))
((= (car ls) 0)
(break 0))
(else
(product (cdr ls) (lambda (x) (prod (* (car ls) x))) break))))
(define identity (lambda (x) x))
The idea of CPS is to keep a track of the recursion.
> (product (list 1 2 3) identity identity)
6
> (inside-product 4)
24
Related
I'm working on sorting a list of lists by their first element for example
(sort (list '(2 1 6 7) '(4 3 1 2 4 5) '(1 1))))
expected output => ('(1 1) '(2 1 6 7) '(4 3 1 2 4 5))
The algorithm I used is bubble sort. And I modified it to deal with lists. However, the code doesn't compile. The error is
mcar: contract violation
expected: mpair?
given: 4
Can someone correct my code and explain it. Thank you
(define (bubble L)
(if (null? (cdr L))
L
(if (< (car (car L)) (car (cadr L)))
(list (car L)
(bubble (car (cdr L))))
(list (cadr L)
(bubble (cons (car (car L)) (car (cddr L))))))))
(define (bubble-sort N L)
(cond ((= N 1) (bubble L))
(else
(bubble-sort (- N 1) (bubble L)))))
(define (bubble-set-up L)
(bubble-sort (length L) L))
(define t3 (list '(2 1 6 7) '(4 3 1 2 4 5) '(1 2 3) '(1 1)))
(bubble-set-up t3)
How about (sort (lambda (x y)(< (car x)(car y))) <YOUR_LIST>)?
I have fixed a few mistakes. There is at least one mistake left.
Consider the case where L only contains one element.
#lang r5rs
(define (bubble L)
(if (null? (cdr L))
L
(if (< (car (car L)) (car (cadr L)))
(cons (car L)
(bubble (cdr L)))
(cons (cadr L)
(bubble (cons (car L) (cddr L)))))))
(define (bubble-sort N L)
(cond ((= N 1) (bubble L))
(else
(bubble-sort (- N 1) (bubble L)))))
(define (bubble-set-up L)
(bubble-sort (length L) L))
(define t3 (list '(2 1 6 7) '(4 3 1 2 4 5) '(1 2 3) '(1 1)))
(display (bubble-set-up t3))
(newline)
I am trying to produce a list of lists which has *.
Here is what I have so far:
(define (position loc count)
(cond [(empty? loc)empty]
[else (cons (list (first loc) count)
(position (rest loc) (add1 count)))]
))
So:
(position (string->list "**.*.***..") 0)
would produce:
(list
(list #\* 0) (list #\* 1) (list #\. 2) (list #\* 3) (list #\. 4) (list #\* 5)
(list #\* 6) (list #\* 7) (list #\. 8) (list #\. 9))
Basically I am trying to get
(list (list (list #\* 0) (list #\* 1))
(list (list #\* 3))
(list (list #\* 5)(list #\* 6) (list #\* 7)))
I thought about using foldr but not sure if that will work. Any help would be appreciated.
It's not exactly a foldr solution though, you need a function that modifies it's behaviour based on prior input in order to group the continuous star characters. Check out my use of a boolean to switch behaviour upon finding a match.
(define (combine-continuous char L)
(let loop ((L L) (acc '()) (continuing? #t))
(cond ((null? L) (list (reverse acc)))
((equal? (caar L) char)
(if continuing?
(loop (cdr L) (cons (car L) acc) #t)
(cons (reverse acc)
(loop (cdr L) (list (car L)) #t))))
(else (loop (cdr L) acc #f)))))
(combine-continuous #\* (position (string->list "**.*.***..") 0))
=->
;Value 19: (((#\* 0) (#\* 1)) ((#\* 3)) ((#\* 5) (#\* 6) (#\* 7)))
I need to write a scheme function that returns as a function which then takes another argument, eg a list and in turn return the desired result. In this example (c?r "arg") would return -- (car(cdr -- which then subsequently takes the list argument to return 2
> ((c?r "ar") '(1 2 3 4))
2
> ((c?r "ara") '((1 2) 3 4))
2
The problem I have is how can I return a function that accepts another arg in petite?
Here's how you might write such a function:
(define (c?r cmds)
(lambda (lst)
(let recur ((cmds (string->list cmds)))
(if (null? cmds)
lst
(case (car cmds)
((#\a) (car (recur (cdr cmds))))
((#\d) (cdr (recur (cdr cmds))))
(else (recur (cdr cmds))))))))
Note that I'm using d to signify cdr, not r (which makes no sense, to me). You can also write this more succinctly using string-fold-right (requires SRFI 13):
(define (c?r cmds)
(lambda (lst)
(string-fold-right (lambda (cmd x)
(case cmd
((#\a) (car x))
((#\d) (cdr x))
(else x)))
lst cmds)))
Just wanted to add my playing with this. Uses SRFI-1.
(import (rnrs)
(only (srfi :1) fold)) ;; require fold from SRFI-1
(define (c?r str)
(define ops (reverse (string->list str)))
(lambda (lst)
(fold (lambda (x acc)
((if (eq? x #\a) car cdr) ; choose car or cdr for application
acc))
lst
ops)))
Its very similar to Chris' version (more the previous fold-right) but I do the reverseso i can use fold in the returned procedure. I choose which of car or cdr to call by looking at the character.
EDIT
Here is an alternative version with much more preprocessing. It uses tail-ref and list-tail as shortcuts when there are runs of #\d's.
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (reverse
(if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs)))))
(lambda (lst)
(fold (lambda (fun lst)
(fun lst))
lst
funs))))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
This can be made even simpler in #!racket. we skip the reverse and just do (apply compose1 funs).
(define (c?r str)
(let loop ((druns 0) (ops (string->list str)) (funs '()))
(cond ((null? ops)
(let ((funs (if (zero? druns)
funs
(cons (lambda (x)
(list-tail x druns))
funs))))
(apply compose1 funs)))
((eq? (car ops) #\d) (loop (+ druns 1) (cdr ops) funs))
((= druns 0) (loop 0 (cdr ops) (cons car funs)))
(else (loop 0 (cdr ops) (cons (lambda (x)
(list-ref x druns))
funs))))))
Assuming a compose procedure:
(define (compose funs . args)
(if (null? funs)
(apply values args)
(compose (cdr funs) (apply (car funs) args))))
(compose (list cdr car) '(1 2 3 4))
=> 2
c?r can be defined in terms of compose like so:
(define (c?r funs)
(lambda (e)
(compose
(map
(lambda (f) (if (char=? f #\a) car cdr))
(reverse (string->list funs)))
e)))
then
((c?r "ar") '(1 2 3 4))
=> 2
((c?r "ara") '((1 2) 3 4))
=> 2
So I am trying to write a function that will calculate the root of a binary tree in scheme. The root is calculated by the following criteria: the value at the root is the maximum of the values at its two children, where each of those values is the minimum for its two children, etc. Alternating between maximizing the children and minimizing the children.
so (TREEMAX '((3 (2 5)) (7 (2 1))) would return 3, because 5 is the max of 2 and 5. 3 is the minimum of 3 and 5. 2 is the max of 2 and 1. 2 is the min of 7 and 2. And finally to get root 3 is the max of 3 and 2. The code I have so far is as follows:
(define TREEMAX
(lambda (a)
(cond ((list? (car a)) TREEMIN (car a))
((list? (cdr a)) TREEMIN (cdr a))
((> (car a) (cdr a)) (car a))
(#t (cdr b)))))
(define TREEMIN
(lambda (a)
(cond ((list? (car a)) TREEMAX (car a))
((list? (cdr a)) TREEMAX (cdr a))
((< (car a) (cdr a)) (car a))
(#t (cdr b)))))
But my code is not returning the right number. Where could I be going wrong?
If I understand your description correctly, this should do:
(define (root lst (res null) (maxmin #t))
(if (null? lst)
(apply (if maxmin max min) res)
(let ((c (car lst)))
(root (cdr lst)
(cons (if (list? c) (root c null (not maxmin)) c) res)
maxmin))))
then
> (root '((3 (2 5)) (7 (2 1))))
3
> (root '((3 (2 (1 5))) (7 ((2 7) 1))))
2
> (root '(1 2))
2
To see how it works, here's a version with a debugging printf:
(define (root lst (res null) (maxmin #t))
(if (null? lst)
(let* ((op (if maxmin max min)) (vl (apply op res)))
(printf "~a ~a = ~a\n" op res vl)
vl)
(let ((c (car lst)))
(root (cdr lst)
(cons (if (list? c) (root c null (not maxmin)) c) res)
maxmin))))
which outputs, for your example:
#<procedure:max> (5 2) = 5
#<procedure:min> (5 3) = 3
#<procedure:max> (1 2) = 2
#<procedure:min> (2 7) = 2
#<procedure:max> (2 3) = 3
When you apply the function car you use (car a) but when you apply the function TREEMAX you use TREEMAX (car a)?
The syntax of your code is wrong; you were unlucky that the errors are not flagged as syntax errors. Here is a fix:
(define TREEMAX
(lambda (a)
(cond ((list? (car a)) (TREEMIN (car a)))
((list? (cdr a)) (TREEMIN (cdr a)))
((> (car a) (cdr a)) (car a))
(else (cdr b))))
No idea if this solves your specific problem, but at least you'll be able to trust the computed value.
I'm trying to create a function to count all the elements in a list, including the elements of its sublists. initially, to get started, i came up with a basic function myList:
(define myLength
(lambda (L)
(cond
((null? L) 0)
(else (+ 1 (myLength (cdr L)))))))
However, it doesn't help me account for function calls like:
(numAtoms '()) "...should be 0"
(numAtoms '(())) "...should be 0"
(numAtoms '(1 1)) "...should be 2"
(numAtoms '(1 (1 1) 1)) "...should be 4"
(numAtoms '(1 (1 (1 1)) 1)) "...should be 5"
I'm trying to use basic functions like length, null?, and list?.
I think the trick here is to imagine how you can transform your input into the code that you'd want to use to compute the sum. Let's write each of your inputs in the fully expanded form, in terms of cons and '() and whatever other atoms appear in your data:
'() == '()
'(()) == (cons '() '())
'(1 1) == (cons 1 (cons 1 '()))
'(1 (1 1) 1) == (cons 1 (cons 1 (cons 1 '())) (cons 1 '()))
'(1 (1 (1 1)) 1) == ...
Now, look what would happen if you replaced each occurrence of cons with +, and each occurrence of '() with 0, and each occurrence of something that's not '() with 1. You'd have:
'() => 0 == 0
(cons '() '()) => (+ 0 0) == 0
(cons 1 (cons 1 '())) => (+ 1 (+ 1 0)) == 2
(cons 1 (cons 1 (cons 1 '())) (cons 1 '())) => (+ 1 (+ 1 (+ 1 0)) (+ 1 0)) == 4
... => ... == ...
Notice that those sums are exactly the values that you want! Based on this, it seems like you might not want to treat your input as a list so much as a tree built from cons cells. In general, you can map over a tree by specifying a function to apply to the recursive results of processing a pair, and a function to process the atoms of the tree:
(define (treeduce pair-fn atom-fn tree)
(if (pair? tree)
(pair-fn (treeduce pair-fn atom-fn (car tree))
(treeduce pair-fn atom-fn (cdr tree)))
(atom-fn tree)))
You could then implement that mapping of cons to + and everything else to 1 if it's a list and 0 if it's not by:
(define (non-null-atoms tree)
(treeduce +
(lambda (atom)
(if (not (null? atom))
1
0))
tree))
This yields the kinds of results you'd expect:
(non-null-atoms '()) ;=> 0
(non-null-atoms '(())) ;=> 0
(non-null-atoms '(1 1)) ;=> 2
(non-null-atoms '(1 (1 1) 1)) ;=> 4
(non-null-atoms '(1 (1 (1 1)) 1)) ;=> 5
Here is a recursive template you can use:
(define (num-atoms lst)
(cond ((pair? lst) (+ (num-atoms <??>)
(num-atoms <??>)))
((null? lst) <??>) ; not an atom
(else <??>))) ; an atom
This next example uses a helper that has the accumulated value (num) as an argument.
(define (num-atoms lst)
;; locally defined helper
(define (helper num lst)
(cond ((pair? lst) (helper (helper <??> <??>) <??>)) ; recurse with the sum of elements from car
((null? lst) <??>) ; return accumulated value
(else (helper <??> <??>)))) ; recurse with add1 to num
;; procedure starts here
(helper 0 lst))
Hope it helps
Make my-length work for any argument type, list or 'atom'; then the recursive algorithm becomes almost trivial:
(define (my-length l)
(cond ((null? l) 0)
((list? l) (+ (my-length (car l)) (my-length (cdr l))))
(else 1))) ; atom
> (my-length '(1 (1 (1 1)) 1)))
5