drscheme - finite state machine - scheme

thanks to people at this great site I managed to put together code that is nearly complete and working. I have one final question.
here is the code:
(define (chartest ch)
(lambda (x) (char=? x ch)))
(define fsm-trans
'((A (lambda (x) (string=? x "a") B), (B (lambda (x) (string=? x "a") C)))))
(define (find-next-state state ch trl)
(cond
[(empty? trl) false]
[(and (symbol=? state (first (first trl)))
((second (first trl)) ch))
(third (first trl))]
[else (find-next-state state ch (rest trl))]))
(define fsm-final '(C))
(define start-state 'A)
(define (run-fsm start trl final input)
(cond
[(empty? input)
(cond
[(member start final) true]
[else false])]
[else
(local ((define next (find-next-state start (first input) trl)))
(cond
[(boolean? next) false]
[else (run-fsm next trl final (rest input))]))]))
(run-fsm start-state fsm-trans fsm-final (string->list "ac"))
i have a problem with the transition function find-next-state. How can I define it in order to test the incoming characters and based on this either return true value when the fsm reaches final state or false value when it doesn't?
Thank you for your answer.
UPDATE:
Thank you for your answer and I am sorry that the code is confusing.
I have repaired the definition of transtitions which now looks like this:
(define fsm-trans
'((A (lambda (x) (string=? x "a") B)
(B (lambda (x) (string=? x "a") C)))))
But now I am trying to define the transition function. When I haven't had fixed transition character and I used char-alphabetic? and char-numeric?, these lines of code worked like a charm:
(define (find-next-state state ch trl)
(cond
[(empty? trl) false]
[(and (symbol=? state (first (first trl)))
((second (first trl)) ch))
(third (first trl))]
[else (find-next-state state ch (rest trl))]))
But what should I change to work with the new definition of states in fsm-trans?
When this code is entered in DrScheme, it shows up an error with line: ((second (first trl)) ch)).
Thank you for your further assistance!

It looks like the main problem in this code is a confusion over quotes, quasiquotes and unquotes. Specifically, '(foo (lambda (x) x) baz) is quoting the whole thing, so there is no function there, just a symbolic representation for one. Also, your use of , looks like you're confusing it as something that separates values in a list. Another problem is that the parens look mismatched. You probably want something like this instead, using a quasiquote:
(define fsm-trans
`((A ,(lambda (x) (string=? x "a") B))
(B ,(lambda (x) (string=? x "a") C))))
But given that you're unclear about these things, then it'll be much better to stick to simple quotes only, and use list when needed:
(define fsm-trans
(list (list 'A (lambda (x) (string=? x "a") B))
(list 'B (lambda (x) (string=? x "a") C))))
You probably have some more problems to get over, but doing that should get you in the right direction.

Related

scheme, sicp, solution 3.19, procedure with infinite loop works in case it is provided as argument

could someone help me with clarification to one of the possible solution to exercise 3.19. the procedure mystery is infinite loop in case list cycle is given as argument. nevertheless when we use procedure eq? to check if list contains the cycle, it works and provides true value.
(define (last-pair x)
(if (null? (cdr x))
x
(last-pair (cdr x))
)
)
(define (make-cycle x)
(set-cdr! (last-pair x) x)
)
(define (mystery x)
(define (loop x y)
(if (null? x)
y
(let ((temp (cdr x)))
(set-cdr! x y)
(loop temp x)
)
)
)
(loop x '())
)
(define t (list 1 2 3))
(define w (make-cycle t))
(eq? (mystery t) t)
it looks like magic. I would appreciate for any help.
mystery reverses an array "in-place" by repeatedly snipping off the cdr of each entry and replacing that with the cdr of the previous x.
If this list has no loop, then it will end up reversed by the time you get back to the original '(). If there is a loop, you'll have the original array's pointer.
This is definitely a tricky to understand issue. If you make a box-and-pointer diagram it will definitely help and you'll only need to draw 3 diagrams.
Automatically Generating Diagrams of Lists
In the process of doing SICP myself, I found myself wanting a way to visualize list mutation (and to skip the numerous "draw a list diagram of..." exercises). I wrote a small function for doing so and I thought you might find it helpful if I shared it.
These diagrams are an example of this function being run on x each time loop (within the mystery function) is ran.
The following code is what I used for generating these diagrams. I wrote this code as a Scheme novice, but it's very simple to use: the function (list->graphviz) accepts a parameter lst which is the list you'd like a diagram of, as well as an optional argument graph-name which gives the graph a special name.
(define* (list->graphviz lst #:optional graph-name)
"""Convert a list into a set of Graphviz instructions
`lst' is the list you'd like a diagram of
`graph-name` is an optional parameter indicating the name you'd like to give the graph."""
(define number 0)
(define result "")
(define ordinals '())
(define (result-append! str)
(set! result (string-append result str)))
(define* (nodename n #:optional cell)
(format #f "cons~a~a" n (if cell (string-append ":" cell) "")))
(define* (build-connector from to #:optional from-cell)
(format #f "\t~a -> ~a;~%" (nodename from from-cell) (nodename to)))
(define (build-shape elt)
(define (build-label cell)
(cond ((null? cell) "/");; "∅") ; null character
((pair? cell) "*");; "•") ; bullet dot character
(else (format #f "~a" cell))))
(set! number (+ number 1))
(format #f "\t~a [shape=record,label=\"<car> ~a | <cdr> ~a\"];~%"
(nodename number)
(build-label (car elt))
(build-label (cdr elt))))
(define* (search xs #:optional from-id from-cell)
(let ((existing (assq xs ordinals)))
(cond
;; if we're not dealing with a pair, don't bother making a shape
((not (pair? xs)) (result-append! "\tnothing [shape=polygon, label=\"not a pair\"]\n"))
((pair? existing)
(result-append! (build-connector from-id (cdr existing) from-cell)))
(else
(begin
(result-append! (build-shape xs))
(set! ordinals (assq-set! ordinals xs number))
(let ((parent-id number))
;; make a X->Y connector
(if (number? from-id)
(result-append! (build-connector from-id parent-id from-cell)))
;; recurse
(if (pair? (car xs)) (search (car xs) parent-id "car"))
(if (pair? (cdr xs)) (search (cdr xs) parent-id "cdr"))))))))
(search lst)
(string-append "digraph " graph-name " {\n" result "}\n"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; Here is where `mystery' begins ;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define t '(1 2 3))
(set-cdr! (cddr t) t)
(define (mystery x)
(define (loop x y graph-num)
(display (list->graphviz x (format #f "graph~a" graph-num)))
(if (null? x)
y
(let ((temp (cdr x)))
(set-cdr! x y)
(loop temp x (+ 1 graph-num)))))
(loop x '() 0))
(mystery t)
The code above code generates Graphviz graph description statements, which must then be processed by dot (Graphviz) to be rendered to a graphical format.
For example, you can run the code above and pipe it into dot:
$ scheme generate_box_ptr.scm | dot -o ptrs.ps -Tps
This command generates a postscript file which has the advantage of separating each list into it's own page if you've run list->graphviz more than once. dot can also output PNGs, PDFs and many other file formats as the manpage describes.

Scheme and Merge Sort?

I was assigned to write a merge sort in Scheme but I have some issues with it. I showed it my professor and he said there is one simple mistake. Can someone help me?
Plzz!
(define msort
(lamdba(1st)
(cond
((null?? 1st) 1st)
((null? (cdr 1st)) 1st)
(#t ((letrec ((half (quotient (lenght 1st) 2))
(merge (lamdba (a b result)
(cond ((null? a) (apped (reserve a) result))
((null? b) (append (reserve a) result))
((> (car a) (car b) (merge a (cdr b) (cons (car b) result))
(#t (merge (cdr a) b (cons (car a) result)))))))
(merge (msort (take 1st half)) (msort (drop 1st half)) '()))))))
One simple mistake? He probably referred to #1, but even after fixing that you have some identifiers and parenthesis to fix:
lambda, null?, length, append, and reverse is spelled incorrectly.
letrec result gets applied since you have excess parenthesis around it.
cond in merge where you compare elements are missing parenthesis two places.
It's obvious you need help with parenthesis matching so you should download a decent IDE to write code in. I use DrRacket for Scheme development (#!R5RS, #!R6RS and #!racket) and it idents (just press CTRL+i to get it reidented after pasting in code) and indicate where function names are written wrong when you hit RUN.
Making merge a global function in the beginning and perhaps move it to a letrec later (if you have to) might ease development. Eg. you could find errors by testing stuff like (merge '(3 2 1) '()).
This is no guarantee the program will work since I only address syntax here. You need to debug it! DrRacket has a debugger too!
I think it is useful to implement first a function that allow to merge two ordered lists:
(define (merge l1 l2)
(if (empty? l1)
l2
(if (empty? l2)
l1
(if (< (car l1) (car l2))
(cons (car l1) (merge (cdr l1) l2))
(cons (car l2) (merge l1 (cdr l2)))))))
Now assume we have a function (get ls pos) capable to return the element of ls in position pos:
(define (get ls pos)
(if (= pos 1)
(car ls)
(get (cdr ls) (- pos 1))))
Finally, we can implement mergesort function:
(define (mergesort l p r)
(if (= p r)
(cons (get l p) empty)
(merge (mergesort l p (floor (/ (+ p r) 2))) (mergesort l (+ (floor (/ (+ p r) 2)) 1) r))))

Scheme return pairs in a list

Hi I got the error mcar: contract violationexpected: mpair? given: () while running these code:
(define helpy
(lambda (y listz)
(map (lambda (z) (list y z))
listz)))
(define print
(lambda (listy)
(cond
((null? list) (newline))
(#t (helpy (car listy) (cdr listy))
(print (cdr listy))))))
My code is trying to return pairs in a list. For example, when I call
(print '(a b c)) it should return ((a b) (a c) (b c)).
I just fix and update my code, now it don't return error but I can only get pair ( (a b) (a c), when running these code:
(define helpy
(lambda (y listz)
(map (lambda (z) (list y z))
listz)))
(define print
(lambda (listy)
(cond
((null? listy) (newline))
(#t (helpy (car listy) (cdr listy)))
(print (cdr listy)))))
I think that I got something wrong with the recursion
There are a couple of problems with the code. First, by convention the "else" clause of a cond should start with an else, not a #t. Second, the null? test in print should receive listy, not list. And third, you're not doing anything with the result returned by helpy in print, you're just advancing print over the cdr of the current list without doing anything with the value returned by the recursive call. Try this instead:
(define print
(lambda (listy)
(cond
((null? listy) (newline))
(else
(displayln (helpy (car listy) (cdr listy)))
(print (cdr listy))))))
displayln is just an example, do something else with the returned result if necessary.
I try to implement like this:
#lang racket
(define data '(a b c d))
(define (one-list head line-list)
(if (null? line-list)
null
(cons
(cons head (car line-list))
(one-list head (rest line-list)))))
(letrec ([deal-data
(lambda (data)
(if (null? data)
'()
(append
(one-list (car data) (rest data))
(deal-data (rest data)))))])
(deal-data data))
run result:
'((a . b) (a . c) (a . d) (b . c) (b . d) (c . d))

Scheme recursion error

This recursive function seems to work properly, adding to the result list the exact letters I want it to, B and C, and then when it finishes, it correctly sees that the last element has been reached.
It then executes the base case, and an error occurs which I cannot explain. What is causing this error?
(define(preceding-R X Vector result)
(if (eq? '() (cdr (vector->list Vector)))
result
(helper X Vector result)))
(define (helper X Vector result)
(if(eqv? X (cadr (vector->list Vector))) ((set! result (cons result (car (vector->list Vector)))) (preceding-R X (list->vector (cdr (vector->list Vector))) result))
(preceding-R X (list->vector (cdr (vector->list Vector))) result)))
(preceding-R 'a #(b a c a) '()))
The error:
procedure application: expected procedure, given: #; arguments were: ((() . b) . c)
Here's some code that isn't "absolutely horrible":
(define preceding-R
(lambda (x vec)
(define helper
(lambda (ls)
(cond
((null? ls) '())
((null? (cdr ls)) '())
((eq? (cadr ls) x) (cons (car ls) (helper (cdr ls))))
(else (helper (cdr ls))))))
(helper (vector->list vec))))
> (preceding-R 'a #(b a c a))
(b c)
Eli Barzilay has a point; if I were grading the original code, I would probably award fewer than half credit because of the things he pointed out:
set! should be avoided in most circumstances, and is generally not permitted on homework problems involving basic Scheme code. Having to use set! is a usual tell that recursion isn't understood too well.
Since begin "throws away" the results of everything but the last expression, it means that the non-tail expressions had side-effects (like set!) and so begin usually doesn't show up in educational problems either.
Conversion back-and-forth over and over and over and over again is obviously a waste. One conversion will do, but you probably could've used lists instead of vectors to begin with. Lists are the most common data structure used in Scheme, especially since they work well with recursion.
Your code will error out on an empty list in your second line: (preceding-R 'a #()) => Error: Attempt to apply cdr on '()
If you do use set! to modify result, then there's no reason to pass result around. It's extra baggage.
Eli's last point was that you can write:
.
(define (helper X Vector result)
(preceding-R X (list->vector (cdr (vector->list Vector)))
(if (eq? X (cadr (vector->list Vector)))
(cons (car (vector->list Vector)) result)
result)))
saving some repeated code.
(define (preceding-R X Vector result)
(if (eq? '() (cdr (vector->list Vector)))
result
(helper X Vector result)))
(define (helper X Vector result)
(if (eqv? X (cadr (vector->list Vector)))
(begin
(set! result (cons (car (vector->list Vector)) result))
(preceding-R X (list->vector (cdr (vector->list Vector))) result))
(preceding-R X (list->vector (cdr (vector->list Vector))) result)))
(preceding-R 'a #(b a c a) '())
I've added begin call. If you want multiple expressions in if you can't just wrap them in (), it was interpreted as function call on void (returned by set!) with argument returned by recursive call to preceding-R.

how to define last in scheme?

how can I write a function to take the last element of the list?
find the last of a list:
(define (last l)
(cond ((null? (cdr l)) (car l))
(else (last (cdr l)))))
use map to map last to a list:
(map last '((a b) (c d) (e f)))
==> (b d f)
so a new function:
(define (last-list l)
(map last l)
)
(last-list '((a b) (c d) (e f)))
==> (b d f)
May not be the most efficient, but certainly one of the simplest:
(define (last lst)
(car (reverse lst)))
Examples:
(last '(1 2 3 4)) => 4
(last '((a b) (b c) (d e))) => (d e)
The code you've written - to take the last element of a list - is correctly returning the last element of the list. You have a list of lists. There is an outer list
(x y z)
where
x = (a b)
y = (c d)
z = (e f)
So you're getting the last element of the list, z, which is (e f)
Did you want your last function to do something different? If you want it to return the last element of the last nested list, you need to change your base case. Right now you return the car. Instead, you want to check if the car is a list and then call your nested-last function on that.
Make sense?
Your last function is good, but you have to think about what you want to do with it now.
You have a list of lists, and you want to take the last of all those.
So recurse down your list applying it each time:
(define (answer lst)
(cond ((null? (cdr l)) null)
(else (cons (last (car l)) (answer (cdr lst))))
Yet another possibility:
(define (last thelist)
(if
(null? (cdr thelist)) (car thelist)
(last (cdr thelist))))
(define (all-last lists) (map last lists))
Edit: just saw that you don't know map, and want a solution without it:
(define (all-last lists)
(if
(null? lists) `()
(cons (last (car lists)) (all-last (cdr lists)))))
As far as getting an empty list goes, I'd guess you're trying to use this map-like front-end with your original definition of last, whereas it's intended to work with the definition of last I gave above. Try the following definitions:
(define (last thelist) (if
(null? (cdr thelist)) (car thelist)
(last (cdr thelist))))
(define (all-last lists) (if
(null? lists) `()
(cons (last (car lists)) (all-last (cdr lists)))))
and running a quick test:
(all-last `((a b) (c d) (e f)))
The result should be:
(b d f)
(define last
(lambda (ls)
(list-ref ls (- (length ls) 1))))
I like short, sweet, fast, tail-recursive procedures.
Named let is my friend.
This solves the original problem and returns #f if the list has no last element.
(define (last L) (let f ((last #f) (L L)) (if (empty? L) last (f (car L) (cdr L)))))
The best way to get what you want:
(define (last lst)
(cond [(empty? lst) empty]
[(empty? (rest lst)) (first lst)]
[else (last (rest lst))]))

Resources