In practice 3.51 of the SICP, it defines a procedure "show", and use stream-map to create a stream:
(add-to-load-path ".")
(load "stream.scm")
(define (show x)
(display-line x)
x)
(define x0 (stream-enumerate-interval 0 3))
(display-stream x0) ;succ, no error
(stream-map show x0) ;all element printed, but interpreter report error at last
The other staff about streams in stream.scm:
#!/usr/bin/guile
!#
(define (stream-null? s)
(null? s))
(define (stream-ref s n)
(if (= n 0)
(stream-car s)
(stream-ref (stream-cdr s) (- n 1))))
(define (stream-map proc s)
(if (stream-null? s)
the-empty-stream
(cons-stream (proc (car s))
(stream-map proc (stream-cdr s)))))
(define (stream-for-each proc s)
(if (stream-null? s)
'done
(begin
(proc (stream-car s))
(stream-for-each proc (stream-cdr s)))))
(define (display-stream s)
(stream-for-each display-line s))
(define (display-line x)
(display x))
(define (stream-car stream) (car stream))
(define (stream-cdr stream) (force (cdr stream)))
(define (stream-enumerate-interval low high)
(if (> low high)
the-empty-stream
(cons-stream
low
(stream-enumerate-interval (+ low 1) high))))
(define (stream-filter pred stream)
(cond
((stream-null? stream) the-empty-stream)
((pred (stream-car stream))
(cons-stream (stream-car stream)
(stream-filter pred (stream-cdr stream))))
(else
(stream-filter pred (stream-cdr stream)))))
(define-syntax cons-stream
(syntax-rules ()
((_ a b) (cons a (delay b)))))
(define the-empty-stream '())
(define (stream-enumerate-interval low high)
(if (> low high)
the-empty-stream
(cons-stream low
(stream-enumerate-interval (+ low 1) high))))
The error is like this:
0123Backtrace:
8 (apply-smob/1 #<catch-closure 557e16ae8c20>)
In ice-9/boot-9.scm:
705:2 7 (call-with-prompt ("prompt") #<procedure 557e16aef6a0 …> …)
In ice-9/eval.scm:
619:8 6 (_ #(#(#<directory (guile-user) 557e16b9e140>)))
In ice-9/boot-9.scm:
2312:4 5 (save-module-excursion #<procedure 557e16b24330 at ice-…>)
3822:12 4 (_)
In stream.scm:
25:8 3 (stream-map #<procedure show (x)> (0 . #<promise (1 . …>))
25:8 2 (stream-map #<procedure show (x)> (1 . #<promise (2 . …>))
25:8 1 (stream-map #<procedure show (x)> (2 . #<promise (3 . …>))
In unknown file:
0 (_ 3 ())
I've no idea why display-stream succeed, but stream-map "show" is fail.
The code is the same as the sample in SICP. The scheme interpreter is 'guile'.
Any ideas? THX
The error disappeared when I moved
(define-syntax cons-stream
(syntax-rules ()
((_ a b) (cons a (delay b)))))
to the top of the file.
Apparently, in Guile it must be defined above its first use point in the file.
You didn't see the error with stream-enumerate-interval because it is defined twice - the last time below the definition of cons-stream.
Tested in https://ideone.com which uses "guile 2.0.13".
Related
Essentially, I am trying to write a scheme method which will use the map function to cube every item in a list. so it would go from '(1 2 3 4) to '(1 8 27 64). Here is my current code:
(define (cube-all lst)
(map (lambda (x) (* (* x x) x)) lst)
)
This is the error message:
SchemeError: unknown identifier: map
Current Eval Stack:
-------------------------
0: map
1: (cube-all (quote (1 2 3 4)))
2: (println (cube-all (quote (1 2 3 4))))
Is this due to improper syntax? Or do I have to do something else with map?
Edit: println is another function which just displays the answer
If you are constrained to using the 'scheme' mentioned in a comment then you can't use map.
But ... you can write map:
(define (reverse l)
(define (reverse-loop lt into)
(if (null? lt)
into
(reverse-loop (cdr lt) (cons (car lt) into))))
(reverse-loop l '()))
(define (map f l)
(define (map-loop lt into)
(if (null? lt)
(reverse into)
(map-loop (cdr lt) (cons (f (car lt)) into))))
(map-loop l '()))
(define (cube-all lst)
(map (lambda (x) (* (* x x) x)) lst))
(cube-all '(1 2 3))
I am writing a program in scheme that takes in regular scheme notation ex: (* 5 6) and returns the notation that you would use in any other language ex: (5 * 6)
I have my recursive step down but I am having trouble breaking out into my base case.
(define (infix lis)
(if (null? lis) '()
(if (null? (cdr lis)) '(lis)
(list (infix (cadr lis)) (car lis) (infix(caddr lis))))))
(infix '(* 5 6))
the error happens at the (if (null? lis)) '(lis)
the error message is:
mcdr: contract violation
expected: mpair?
given: 5
>
why is it giving me an error and how can I fix this?
Right now your infix function is assuming that its input is always a list. The input is not always a list: sometimes it is a number.
A PrefixMathExpr is one of:
- Number
- (list BinaryOperation PrefixMathExpr PrefixMathExpr)
If this is the structure of your data, the code should follow that structure. The data definition has a one-of, so the code should have a conditional.
;; infix : PrefixMathExpr -> InfixMathExpr
(define (infix p)
(cond
[(number? p) ???]
[(list? p) ???]))
Each conditional branch can use the sub-parts from that case of the data definition. Here, the list branch can use (car p), (cadr p), and (caddr p).
;; infix : PrefixMathExpr -> InfixMathExpr
(define (infix p)
(cond
[(number? p) ???]
[(list? p) (.... (car p) (cadr p) (caddr p) ....)]))
Some of these sub-parts are complex data definitions, in this case self-references to PrefixMathExpr. Those self-references naturally turn into recursive calls:
;; infix : PrefixMathExpr -> InfixMathExpr
(define (infix p)
(cond
[(number? p) ???]
[(list? p) (.... (car p) (infix (cadr p)) (infix (caddr p)) ....)]))
Then fill in the holes.
;; infix : PrefixMathExpr -> InfixMathExpr
(define (infix p)
(cond
[(number? p) p]
[(list? p) (list (infix (cadr p)) (car p) (infix (caddr p)))]))
This process for basing the structure of the program on the structure of the data comes from How to Design Programs.
Mistake
(infix '(* 5 6))
; =
(list (infix (cadr '(* 5 6))) (car '(* 5 6)) (infix (caddr '(* 5 6))))
; =
(list (infix 5) '* (infix (caddr 6)))
; = ^^^^^^^^^
; |
; |
; v
(if ...
...
(if (null? (cdr 5)) ; <-- fails here
...
...))
Solution
First, you need to define the structure of the data you're manipulating:
; OpExp is one of:
; - Number
; - (cons Op [List-of OpExp])
; Op = '+ | '* | ...
In english: it's either a number or an operator followed by a list of other op-expressions.
We define some examples:
(define ex1 7)
(define ex2 '(* 1 2))
(define ex3 `(+ ,ex2 ,ex1))
(define ex4 '(* 1 2 3 (+ 4 3 2) (+ 9 8 7)))
Now we follow the structure of OpExp to make a "template":
(define (infix opexp)
(if (number? opexp)
...
(... (car opexp) ... (cdr opexp) ...)))
Two cases:
The first case: what to do when we just get a number?
The second case: first extract the componenet:
(car opexp) is the operator
(cdr opexp) is a list of operands of type OpExp
Refining the template:
(define (infix opexp)
(if (number? opexp)
opexp
(... (car opexp) ... (map infix (cdr opexp)) ...)))
Since we have a a list of op-exps, we need to map a recursive call on all of them. All we need to do is make the operator infix at the top-level.
We use a helper that intertwines the list with the operator:
; inserts `o` between every element in `l`
(define (insert-infix o l)
(cond ((or (null? l) (null? (cdr l))) l) ; no insertion for <= 1 elem lst
(else (cons (car l) (cons o (insert-infix o (cdr l)))))))
and finally use the helper to get the final version:
; converts OpExp into infix style
(define (infix opexp)
(if (number? opexp)
opexp
(insert-infix (car opexp) (map infix (cdr opexp)))))
We define respective results for our examples:
(define res1 7)
(define res2 '(1 * 2))
(define res3 `(,res2 + ,res1))
(define res4 '(1 * 2 * 3 * (4 + 3 + 2) * (9 + 8 + 7)))
And a call of infix on ex1 ... exN should result in res1 ... resN
I'm trying to implement an accumulator for an infinite stream. I've written the following code but it's running into an infinite loop and failing to terminate
(define (stream-first stream) (car stream))
(define (stream-second stream) (car ((cdr stream))))
(define (stream-third stream) (car ((cdr ((cdr stream))))))
(define (stream-next stream) ((cdr stream)))
(define (stream-foldl func accum stream)
(cond
[(empty? stream) accum]
[else (stream-foldl func (func (stream-first stream) accum) (stream-next stream))] ))
I've written up a few tests to demonstrate what I'm trying to implement
(define (natural-nums)
(define (natural-nums-iter n)
(thunk
(cons n (natural-nums-iter (+ n 1)))))
((natural-nums-iter 0)))
(define x (stream-foldl cons empty (natural-nums)))
(check-equal? (stream-first x) empty)
(check-equal? (stream-second x) (list 0))
(check-equal? (stream-third x) (list 1 0))
(define y (stream-foldl (curry + 1) 10 (naturals)))
(check-equal? (stream-first y) 10)
(check-equal? (stream-second y) 11)
(check-equal? (stream-third y) 13)
Here's a trace of my stream-foldl function
>(stream-foldl
#<procedure:cons>
'()
'(0 . #<procedure:...9/saccum.rkt:25:0>))
()>(stream-foldl
#<procedure:cons>
'(0)
'(1 . #<procedure:...9/saccum.rkt:25:0>))
(0)>(stream-foldl
#<procedure:cons>
'(1 0)
'(2 . #<procedure:...9/saccum.rkt:25:0>))
(1 0)>....
I believe I'm failing to properly set a base case, thus never terminating from the recursion call
Fold is supposed to look at every element in the stream, then produce a result based on those elements. With an infinite stream, it is no surprise that the fold does not terminate (how would you be able to look at every single element in an infinite stream?).
What you can do:
Produce a finite stream out of the infinite stream. stream-take can be used for that. Example implementation of stream-take:
;; Returns a stream containing the first n elements of stream s.
(define (stream-take n s)
(cond ((zero? n) empty-stream)
((empty? s) (error "Stream is shorter than n")
(else
(delay (stream-first s)
(stream-take (- n 1) (stream-rest s)))))))
; Note: 'delay' is the same as the 'thunk' in your code.
Then, fold the finite stream either using your implementation of fold, or stream-fold.
I have got these functions
(define force!
(lambda (thunk)
(thunk)))
(define stream-head
(lambda (s n)
(if (zero? n)
'()
(cons (car s)
(stream-head (force! (cdr s))
(1- n))))))
(define make-stream
(lambda (seed next)
(letrec ([produce (lambda (current)
(cons current
(lambda ()
(produce (next current)))))])
(produce seed))))
(define make-traced-stream
(lambda (seed next)
(letrec ([produce (trace-lambda produce (current)
(cons current
(lambda ()
(produce (next current)))))])
(produce seed))))
(define stream-of-even-natural-numbers
(make-traced-stream 0
(lambda (n)
(+ n 2))))
(define stream-of-odd-natural-numbers
(make-traced-stream 1
(lambda (n)
(+ n 2))))
And I need to make a function that merges the last two, so that if I run
(stream-head (merge-streams stream-of-even-natural-numbers stream-of-odd-natural-numbers) 10)
I must get the output (0 1 2 3 4 5 6 7 8 9).. how is this done?
The best idea I had, which is wrong, have been:
(define merge-streams
(lambda (x y)
(cons (car x)
(merge-streams y (cdr x)))))
Here is a suggestion:
(define (merge-streams s1 s2)
(cond
[(empty-stream? s1) s2)] ; nothing to merge from s1
[(empty-stream? s2) s1)] ; nothing to merge from s2
[else (let ([h1 (stream-car s1)]
[h2 (stream-car s2)])
(cons h1
(lambda ()
(cons h2
(stream-merge (stream-rest s1)
(stream-rest s2))))))]))
It uses some helper functions that must be defined first.
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