Print values, not types (Racket) - racket

When I print in Racket, only the type is printed of structures, not the value. (I'm working in DrRacket, in the interactions area.)
For example, I have a tree structure:
#lang racket
(define-struct node [name left right])
An example could be:
(define SALLY (make-node 'sally BOBBY SUSIE))
(define BOBBY (make-node 'bobby NONE NONE))
(define SUSIE (make-node 'susie NONE NONE))
What I see:
> (print SALLY)
#<node>
What I want to see:
> (print SALLY)
(make-node 'sally (make-node 'bobby NONE NONE)
(make-node 'susie NONE NONE))
How can I see the value and not the type?

Use #:transparent keyword:
(define-struct node [name left right] #:transparent)
> (define-struct node [name left right] #:transparent)
> (define NONE '())
> (define BOBBY (make-node 'bobby NONE NONE))
> (define SUSIE (make-node 'susie NONE NONE))
> (define SALLY (make-node 'sally BOBBY SUSIE))
> (print SALLY)
(node 'sally (node 'bobby '() '()) (node 'susie '() '()))

NB: Today struct is preferred over define-struct so I've written the code with struct.
It doesn't really print the type but it's the default representation of the object. There are two options you can do:
1. Use #:transparent keyword.
(struct node [name left right] #:transparent)
(define root (node 'd
(node 'b (node 'a '() '())
(node 'c '() '()))
(node 'f (node 'e '() '())
(node 'g '() '()))))
root ; ==>
; (node 'd
; (node 'b (node 'a '() '())
; (node 'c '() '()))
; (node 'f (node 'e '() '())
; (node 'g '() '()))))
Notice how they look like the construction?
1. Add a writer for the object
(struct node [name left right]
#:methods gen:custom-write
[;; needs to be named write-proc
(define (write-proc x port mode)
((if (eq? mode #t) write display) (fancy-writer x 0) port))
;; helper used by write-proc
(define (fancy-writer x ident)
(if (null? x)
""
(let ([new-ident (+ 5 ident)])
(string-append (fancy-writer (node-left x) new-ident)
(string-append (make-string ident #\space)
(symbol->string (node-name x))
"\n")
(fancy-writer (node-right x) new-ident)))))])
root ; ==>
; a
; b
; c
; d
; e
; f
; g

Related

typed/racket + racket interoperability

How can I use typed Racket for some functions in my codebase, but use (untyped) Racket for others? When I define a function in Racket but import it into a typed Racket context, it seems to be changing the behavior of the function (functions described below).
As it is now, the files do typecheck, but don't pass my tests in p11typedtest.rkt -- however, my files do successfully pass my tests if I either (A) switch p11typed.rkt to regular Racket or (B) copy the pack function into p11typed.rkt and provide its type annotation.
;; p09.rkt
#lang racket
(provide pack)
;; packs consecutive duplicates within a list into sublists
(define (pack lst)
(for/foldr ([acc '()]) ([x lst])
(match acc
[(cons (cons y ys) zs) #:when (equal? x y)
(list* (list* x y ys) zs)]
[_ (list* (list x) acc)]
)))
;; p11typed.rkt
#lang typed/racket
(provide encode-runlen-mod)
;; (require (only-in (file "p09.rkt") pack))
(require/typed (only-in (file "p09.rkt") pack)
[pack (All (A) (-> (Listof A) (Listof (Listof A))))]
)
(define-type (Runof a) (List Index a))
(define-type (RunListof a) (Listof (U a (Runof a))))
;; encodes a list as a list of runs
(: encode-runlen-mod (All (A) (-> (Listof A) (RunListof A))))
(define (encode-runlen-mod lst)
;; uncomment to print the result of pack
;; (displayln (pack lst))
(for/list ([dups (pack lst)])
(match (length dups)
[1 (car dups)]
[n (list n (car dups))]
)))
; (: pack (All (A) (-> (Listof A) (Listof (Listof A)))))
; (define (pack lst)
; (for/foldr ([acc '()]) ([x lst])
; (match acc
; [(cons (cons y ys) zs) #:when (equal? x y)
; (list* (list* x y ys) zs)]
; [_ (list* (list x) acc)]
; )))
;; p11typedtest.rkt
#lang racket
(require (only-in (file "p11typed.rkt") encode-runlen-mod))
(define (test-output namespace expr v)
(let* ([val (eval expr namespace)]
[fail (not (equal? val v))])
(begin
(display (if fail "FAIL" "ok "))
(display " '(=? ")
(print expr)
(display " ")
(print v)
(display ")'")
(if fail
(begin
(display ", got ")
(print val)
(displayln " instead")
)
(displayln "")
)
(void))
))
(define-namespace-anchor a)
(define ns (namespace-anchor->namespace a))
(test-output ns '(encode-runlen-mod '(1 2 3 4)) '(1 2 3 4))
(test-output ns '(encode-runlen-mod '(1 1 1)) '((3 1)))
(test-output ns '(encode-runlen-mod '(1 2 2 3 4)) '(1 (2 2) 3 4))
(test-output ns '(encode-runlen-mod '(1 2 3 4 4 4)) '(1 2 3 (3 4)))
(test-output ns '(encode-runlen-mod '(1 2 3 (3 4))) '(1 2 3 (3 4)))
(test-output ns '(encode-runlen-mod '(A A A A B C C A A D E E))
'((4 A) B (2 C) (2 A) D (2 E)))
)

Racket List Questio

Does anyone know how to return a number of specific elements in a list?
Example: given
(list 'a 'a 'a 'a 'a 'b 'b 'b)
Returns the numbers of 'a: 5
numbers of 'b: 3
You count them. You make a procedure that takes a list and what you want to search for and you iterate that list while keeping a count and when you reach the end you return that value.
A skeleton for a simple recursive solution:
(define (count-element element lst)
(define (helper lst count)
(cond ((empty? lst) count)
((equal? element <first element>) <recurse whith cdr and increasing count>)
(else <recurse with cdr>)))
(helper lst 0))
Or you can use foldl
(define (count-element element lst)
(foldl (lambda (e count)
(if <e is the same as element>
<return 1 more than count>
<return count>))
0
lst))
There are probably 10 more ways I could do it, but the first is the most educational and the second the most common way I would do it.
Some tests:
(define test '(a a a a a b b b))
(count-element 'b '()) ; ==> 0
(count-element 'e test) ; ==> 0
(count-element 'a test) ; ==> 5
(count-element 'b test) ; ==> 3
I somewhat managed to find the answer, so here's the function definition:
(define (number-of s L)
(cond
[(empty? L) 0]
[else (cond [(eq? s (first L)) (+ 1 (number-of s (rest L)))]
[else (number-of s (rest L))])]))

Mysterious Racket error: define: unbound identifier; also, no #%app syntax transformer is bound in: define

This program produces an error:
define: unbound identifier;
also, no #%app syntax transformer is bound in: define
When pasted into the REPL (to be exact, the last line: (displayln (eval-clause clause state))), it works. When run in definition window, it fails. I don't know why.
#lang racket
(define *state* '((a false) (b true) (c true) (d false)))
(define *clause* '(a (not b) c))
(define (eval-clause clause state)
(for ([x state])
(eval `(define ,(first x) ,(second x))))
(eval (cons 'or (map eval clause))))
(displayln (eval-clause *clause* *state*))
This too:
(define (eval-clause clause state)
(eval `(let ,state ,(cons 'or clause))))
produces
let: unbound identifier;
also, no #%app syntax transformer is bound in: let
This was my attempt to translate the following Common Lisp program: Common Lisp wins here?
; (C) 2013 KIM Taegyoon
; 3-SAT problem
; https://groups.google.com/forum/#!topic/lisp-korea/sVajS0LEfoA
(defvar *state* '((a nil) (b t) (c t) (d nil)))
(defvar *clause* '(a (not b) c))
(defun eval-clause (clause state)
(dolist (x state)
(set (car x) (nth 1 x)))
(some #'identity (mapcar #'eval clause)))
(print (eval-clause *clause* *state*))
And in Paren:
(set *state* (quote ((a false) (b false) (c true) (d false))))
(set *clause* (quote (a (! b) c)))
(defn eval-clause (clause state)
(for i 0 (dec (length state)) 1
(set x (nth i state))
(eval (list set (nth 0 x) (nth 1 x))))
(eval (cons || clause)))
(eval-clause *clause* *state*)
eval is tricky in Racket. As per Racket Guide, 15.1.2, you need to hook into the current namespace as follows
(define-namespace-anchor anc)
(define ns (namespace-anchor->namespace anc))
and then add ns to every call to eval:
(define (eval-clause clause state)
(for ([x state])
(eval `(define ,(first x) ,(second x)) ns))
(eval (cons 'or (map (curryr eval ns) clause)) ns))
Note that this is not necessary in the REPL, as explained in the document referenced above.
However, it's probably a better idea to create a specific namespace for your definitions so that they don't get mixed up with your own module's definitions:
(define my-eval
(let ((ns (make-base-namespace)))
(lambda (expr) (eval expr ns))))
(define *state* '((a #f) (b #t) (c #t) (d #f)))
(define *clause* '(a (not b) c))
(define (eval-clause clause state)
(for ([x state])
(my-eval `(define ,(first x) ,(second x))))
(my-eval (cons 'or (map my-eval clause))))
(displayln (eval-clause *clause* *state*))
or, if you want to continue using true and false from racket/bool, define my-eval as follows;
(define my-eval
(let ((ns (make-base-namespace)))
(parameterize ((current-namespace ns))
(namespace-require 'racket/bool))
(lambda (expr) (eval expr ns))))
I would write the Common Lisp version slightly simpler:
(defun eval-clause (clause state)
(loop for (var value) in state
do (set var value))
(some #'eval clause))
The LOOP form is more descriptive (since we can get rid of CAR and NTH) and EVAL can be directly used in the SOME function.

Scheme function that see is the ends match [closed]

It's difficult to tell what is being asked here. This question is ambiguous, vague, incomplete, overly broad, or rhetorical and cannot be reasonably answered in its current form. For help clarifying this question so that it can be reopened, visit the help center.
Closed 10 years ago.
So here i have a couple of defined list that i would like to use:
(DEFINE list0 (LIST 'j 'k 'l 'm 'n 'o 'j) )
(DEFINE list1 (LIST 'a 'b 'c 'd 'e 'f 'g) )
(DEFINE list2 (LIST 's 't 'u 'v 'w 'x 'y 'z) )
(DEFINE list3 (LIST 'j 'k 'l 'm 'l 'k 'j) )
(DEFINE list4 (LIST 'n 'o 'p 'q 'q 'p 'o 'n) )
(DEFINE list5 '( (a b) c (d e d) c (a b) ) )
(DEFINE list6 '( (h i) (j k) l (m n) ) )
(DEFINE list7 (f (a b) c (d e d) (b a) f) )
what i would like to do is create a recursive function for a 'endsmatch' function that would do as such:
ENDSMATCH:
(endsmatch 1st) which should return #t if the first element in the list is the same as the last element in the list, and return
#f otherwise. That is,
(endsmatch '(s t u v w x y z) )
would/should return:
#f
(endsmatch (LIST 'j 'k 'l 'm 'n 'o 'j)
would/should return:
#t
and
Both (endsmatch '()) and (endsmatch '(a))
should return #t, etc.
Also is the function can read complex lists such as:
(endsmatch '((a b) c (d e d) c (a b)) )
which would then return:
#t
and:
(endsmatch '((a b) c (d e d) c (b a)) )
(endsmatch '((y z) y) )
should both return #f
How might this function be coded because i am new to scheme and would see what it may look like, Thank You in advance.
Try this, it's as simple as it gets:
(define (endsmatch lst)
(if (null? lst)
#t
(equal? (first lst) (last lst))))
If your Scheme interpreter doesn't include the procedures first and last, they're very simple to implement:
(define (first lst)
(car lst))
(define (last lst)
(cond ((null? lst) #f)
((null? (cdr lst)) (car lst))
(else (last (cdr lst)))))
I've come up with this solution, but it fails for the 2 last tests you describe:
(define (endsmatch lst)
(let loop ((lst lst) (first '()) (last '()))
(cond
((null? lst) (eq? first last))
((pair? (car lst)) (loop (car lst) first last)
(loop (cdr lst) first last))
((null? first) (loop (cdr lst) (car lst) (car lst)))
(else (loop (cdr lst) first (car lst))))))
; racket test code
(require rackunit)
(check-eq? (endsmatch '(s t u v w x y z)) #f)
(check-eq? (endsmatch (list 'j 'k 'l 'm 'n 'o 'j)) #t)
(check-eq? (endsmatch '()) #t)
(check-eq? (endsmatch '(a)) #t)
(check-eq? (endsmatch '((a b) c (d e d) c (b a))) #t)
; these fail
(check-eq? (endsmatch '((a b) c (d e d) c (b a))) #f)
(check-eq? (endsmatch '((y z) y)) #f)
and indeed you say both
"(endsmatch '((a b) c (d e d) c (b a)) ) which would then return: #t"
and
"(endsmatch '((a b) c (d e d) c (b a)) ) should return #f"
which is contradictory.

Running SICP Pattern Matching Rule Based Substitution Code

I have found the code from this lesson online (http://groups.csail.mit.edu/mac/ftpdir/6.001-fall91/ps4/matcher-from-lecture.scm), and I am having a heck of a time trying to debug it. The code looks pretty comparable to what Sussman has written:
;;; Scheme code from the Pattern Matcher lecture
;; Pattern Matching and Simplification
(define (match pattern expression dictionary)
(cond ((eq? dictionary 'failed) 'failed)
((atom? pattern)
(if (atom? expression)
(if (eq? pattern expression)
dictionary
'failed)
'failed))
((arbitrary-constant? pattern)
(if (constant? expression)
(extend-dictionary pattern expression dictionary)
'failed))
((arbitrary-variable? pattern)
(if (variable? expression)
(extend-dictionary pattern expression dictionary)
'failed))
((arbitrary-expression? pattern)
(extend-dictionary pattern expression dictionary))
((atom? expression) 'failed)
(else
(match (cdr pattern)
(cdr expression)
(match (car pattern)
(car expression)
dictionary)))))
(define (instantiate skeleton dictionary)
(cond ((atom? skeleton) skeleton)
((skeleton-evaluation? skeleton)
(evaluate (evaluation-expression skeleton)
dictionary))
(else (cons (instantiate (car skeleton) dictionary)
(instantiate (cdr skeleton) dictionary)))))
(define (simplifier the-rules)
(define (simplify-exp exp)
(try-rules (if (compound? exp)
(simplify-parts exp)
exp)))
(define (simplify-parts exp)
(if (null? exp)
'()
(cons (simplify-exp (car exp))
(simplify-parts (cdr exp)))))
(define (try-rules exp)
(define (scan rules)
(if (null? rules)
exp
(let ((dictionary (match (pattern (car rules))
exp
(make-empty-dictionary))))
(if (eq? dictionary 'failed)
(scan (cdr rules))
(simplify-exp (instantiate (skeleton (car rules))
dictionary))))))
(scan the-rules))
simplify-exp)
;; Dictionaries
(define (make-empty-dictionary) '())
(define (extend-dictionary pat dat dictionary)
(let ((vname (variable-name pat)))
(let ((v (assq vname dictionary)))
(cond ((null? v)
(cons (list vname dat) dictionary))
((eq? (cadr v) dat) dictionary)
(else 'failed)))))
(define (lookup var dictionary)
(let ((v (assq var dictionary)))
(if (null? v)
var
(cadr v))))
;; Expressions
(define (compound? exp) (pair? exp))
(define (constant? exp) (number? exp))
(define (variable? exp) (atom? exp))
;; Rules
(define (pattern rule) (car rule))
(define (skeleton rule) (cadr rule))
;; Patterns
(define (arbitrary-constant? pattern)
(if (pair? pattern) (eq? (car pattern) '?c) false))
(define (arbitrary-expression? pattern)
(if (pair? pattern) (eq? (car pattern) '? ) false))
(define (arbitrary-variable? pattern)
(if (pair? pattern) (eq? (car pattern) '?v) false))
(define (variable-name pattern) (cadr pattern))
;; Skeletons & Evaluations
(define (skeleton-evaluation? skeleton)
(if (pair? skeleton) (eq? (car skeleton) ':) false))
(define (evaluation-expression evaluation) (cadr evaluation))
;; Evaluate (dangerous magic)
(define (evaluate form dictionary)
(if (atom? form)
(lookup form dictionary)
(apply (eval (lookup (car form) dictionary)
user-initial-environment)
(mapcar (lambda (v) (lookup v dictionary))
(cdr form)))))
;;
;; A couple sample rule databases...
;;
;; Algebraic simplification
(define algebra-rules
'(
( ((? op) (?c c1) (?c c2)) (: (op c1 c2)) )
( ((? op) (? e ) (?c c )) ((: op) (: c) (: e)) )
( (+ 0 (? e)) (: e) )
( (* 1 (? e)) (: e) )
( (* 0 (? e)) 0 )
( (* (?c c1) (* (?c c2) (? e ))) (* (: (* c1 c2)) (: e)) )
( (* (? e1) (* (?c c ) (? e2))) (* (: c ) (* (: e1) (: e2))) )
( (* (* (? e1) (? e2)) (? e3)) (* (: e1) (* (: e2) (: e3))) )
( (+ (?c c1) (+ (?c c2) (? e ))) (+ (: (+ c1 c2)) (: e)) )
( (+ (? e1) (+ (?c c ) (? e2))) (+ (: c ) (+ (: e1) (: e2))) )
( (+ (+ (? e1) (? e2)) (? e3)) (+ (: e1) (+ (: e2) (: e3))) )
( (+ (* (?c c1) (? e)) (* (?c c2) (? e))) (* (: (+ c1 c2)) (: e)) )
( (* (? e1) (+ (? e2) (? e3))) (+ (* (: e1) (: e2))
(* (: e1) (: e3))) )
))
(define algsimp (simplifier algebra-rules))
;; Symbolic Differentiation
(define deriv-rules
'(
( (dd (?c c) (? v)) 0 )
( (dd (?v v) (? v)) 1 )
( (dd (?v u) (? v)) 0 )
( (dd (+ (? x1) (? x2)) (? v)) (+ (dd (: x1) (: v))
(dd (: x2) (: v))) )
( (dd (* (? x1) (? x2)) (? v)) (+ (* (: x1) (dd (: x2) (: v)))
(* (dd (: x1) (: v)) (: x2))) )
( (dd (** (? x) (?c n)) (? v)) (* (* (: n) (+ (: x) (: (- n 1))))
(dd (: x) (: v))) )
))
(define dsimp (simplifier deriv-rules))
(define scheme-rules
'(( (square (?c n)) (: (* n n)) )
( (fact 0) 1 )
( (fact (?c n)) (* (: n) (fact (: (- n 1)))) )
( (fib 0) 0 )
( (fib 1) 1 )
( (fib (?c n)) (+ (fib (: (- n 1)))
(fib (: (- n 2)))) )
( ((? op) (?c e1) (?c e2)) (: (op e1 e2)) ) ))
(define scheme-evaluator (simplifier scheme-rules))
I'm running it in DrRacket with the R5RS, and the first problem I ran into was that atom? was an undefined identifier. So, I found that I could add the following:
(define (atom? x) ; atom? is not in a pair or null (empty)
(and (not (pair? x))
(not (null? x))))
I then tried to figure out how to actually run this beast, so I watched the video again and saw him use the following:
(dsimp '(dd (+ x y) x))
As stated by Sussman, I should get back (+ 1 0). Instead, using R5RS I seem to be breaking in the extend-dictionary procedure at the line:
((eq? (cadr v) dat) dictionary)
The specific error it's returning is: mcdr: expects argument of type mutable-pair; given #f
When using neil/sicp I'm breaking in the evaluate procedure at the line:
(apply (eval (lookup (car form) dictionary)
user-initial-environment)
The specific error it's returning is: unbound identifier in module in: user-initial-environment
So, with all of that being said, I'd appreciate some help, or the a good nudge in the right direction. Thanks!
Your code is from 1991. Since R5RS came out in 1998, the code must be written for R4RS (or older).
One of the differences between R4RS and later Schemes is that the empty list was interpreted as false in the R4RS and as true in R5RS.
Example:
(if '() 1 2)
gives 1 in R5RS but 2 in R4RS.
Procedures such as assq could therefore return '() instead of false.
This is why you need to change the definition of extend-directory to:
(define (extend-dictionary pat dat dictionary)
(let ((vname (variable-name pat)))
(let ((v (assq vname dictionary)))
(cond ((not v)
(cons (list vname dat) dictionary))
((eq? (cadr v) dat) dictionary)
(else 'failed)))))
Also back in those days map was called mapcar. Simply replace mapcar with map.
The error you saw in DrRacket was:
mcdr: expects argument of type <mutable-pair>; given '()
This means that cdr got an empty list. Since an empty list has
no cdr this gives an error message. Now DrRacket writes mcdr
instead of cdr, but ignore that for now.
Best advice: Go through one function at a time and test it with
a few expressions in the REPL. This is easier than figuring
everything out at once.
Finally begin your program with:
(define user-initial-environment (scheme-report-environment 5))
Another change from R4RS (or MIT Scheme in 1991?).
Addendum:
This code http://pages.cs.brandeis.edu/~mairson/Courses/cs21b/sym-diff.scm almost runs.
Prefix it in DrRacket with:
#lang r5rs
(define false #f)
(define user-initial-environment (scheme-report-environment 5))
(define mapcar map)
And in extend-directory change the (null? v) to (not v).
That at least works for simple expressions.
Here is the code that works for me with mit-scheme (Release 9.1.1).
You also may use this code. It runs on Racket.
For running "eval" without errors, the following needed to be added
(define ns (make-base-namespace))
(apply (eval '+ ns) '(1 2 3))