I am working on a finite state machine in Dr. Racket, and need some help extracting the next state in my transition function.
Right now, I am not checking to make sure the chars in the string match the alphabet, or that the final state is in the list of final states, or any of that until I can get the transition from state to state recursively.
Here is where I am at right now:
#lang racket
(require math/array)
(define in_string (list "a" "b" "b" "b"))
(define alphabet (list "a" "b"))
(define initial_state 0)
(define final_states (list 2))
(define delta_fn (list
(list 0 "a" 0)
(list 0 "b" 1)
(list 1 "a" 0)
(list 1 "b" 1)))
(define current_state initial_state)
(define (transition current_state in_string delta_fn)
(writeln current_state)
(writeln in_string)
(writeln delta_fn)
(cond
[(empty? in_string) (writeln current_state)]
[else
(let ([input (car in_string)])
(set! current_state (filter (lambda (v)
(match v
[(list (== current_state) (== input) _) #t]
[_ #f]))
delta_fn)))
(writeln current_state)]
;(transition current_state in_string delta_fn)]
)
)
So at the moment, if you run this script and the type: (transition current_state in_string delta_fn), you will get the following output:
> (transition current_state in_string delta_fn)
0
("a" "b" "b" "b")
((0 "a" 0) (0 "b" 1) (1 "a" 0) (1 "b" 1))
((0 "a" 0))
That last line: ((0 "a" 0)) is a result of the (writeln current_state) command after the lambda function runs to find its match in the delta_fn list. I thought I could just type (cdr (cdr current_state)) right there to get the third item in that output, but ((0 "a" 0)) is not a list and I can't operate on it like a list.
So my question is: what is ((0 "a" 0))? Why is current_state set to that instead of '(0 "a" 0)?
Any help would be greatly appreciate, please know that I am very new to functional programming in general, so use small words =P
Solution!
(define (transition current_state in_string delta_fn)
(cond
[(empty? in_string) (writeln current_state)]
[else
(let ([input (car in_string)])
(set! filtered_delta_fn (filter (lambda (v)
(match v
[(list (== current_state) (== input) _) #t]
[_ #f]))
delta_fn)))
(set! next_state (car (cdr (cdr (car filtered_delta_fn)))))
(transition next_state (cdr in_string) delta_fn)]
)
)
You are reusing the variable current_state. Don't do that!
First it was 0, the initial state.
Then you change it to hold a totally different value, the result of filter operation. Instead, use some temporary variable for that, so current_state is not changed yet.
Now, filter returns that value you ask about, ((0 "a" 0)), because of all the entries in the delta_fn it kept the one matching your criterion, the list (0 "a" 0). So the filtered list holds one matching entry in it.
To find your next state from it, simply call
(set! next_state (car (cdr (cdr (car filtered_delta_fn)))))
; (0 "a" 0)
; ("a" 0)
; (0)
; 0
where filtered_delta_fn will be the temporary variable mentioned above.
Then, the recursive call will now be
(transition next_state in_string delta_fn)
You could use current_state in place of next_state, but that's just messy. Much better to have all your variables meaningful, with proper values corresponding to their meaning. Otherwise, it is easy to quickly get lost in all the complex confusion.
Also, the use of set! is usually frowned upon. In Scheme we usually declare a new variable to be used henceforth, like
(let ((next_state (car (cdr ..... ))))
; recursive call .....
Related
I am trying to implement a dictionary using lists in Common Lisp. The program is supposed to take a list of words and create a word histogram with frequency of each unique word.
This is the program:
(defparameter *histo* '())
(defun scanList (list)
(loop for word in list
do (if (assoc word histo)
((setf pair (assoc word histo))
(remove pair histo)
(setf f (+ 1 (second pair)))
(setf pair ((car pair) f))
(append histo pair))
((setf pair (word '1)) (append histo pair)))))
The error I get is: (SETF PAIR (ASSOC WORD *HISTO*)) should be a lambda expression.
Where is the syntax or semantic error exactly ?
(defun scanList (list the fox jumped over the other fox))
(princ *histo*)
Use hash-table for creating the dictionary and then transform to an association-list (alist) to sort it by key or value.
(defun build-histo (l)
(let ((dict (make-hash-table :test 'equal)))
(loop for word in l
do (incf (gethash word dict))
finally (return dict))))
;; which was simplification (by #Renzo) of
;; (defun build-histo (l)
;; (let ((dict (make-hash-table :test 'equal)))
;; (loop for word in l
;; for count = (1+ (gethash word dict 0))
;; do (setf (gethash word dict) count)
;; finally (return dict))))
(defparameter *histo* (build-histo '("a" "b" "c" "a" "a" "b" "b" "b")))
(defun hash-table-to-alist (ht)
(maphash #'(lambda (k v) (cons k v)) ht))
;; which is the same like:
;; (defun hash-table-to-alist (ht)
;; (loop for k being each hash-key of ht
;; for v = (gethash k ht)
;; collect (cons k v)))
;; sort the alist ascending by value
(sort (hash-table-to-alist *histo*) #'< :key #'cdr)
;; => (("c" . 1) ("a" . 3) ("b" . 4))
;; sort the alist descending by value
(sort (hash-table-to-alist *histo*) #'> :key #'cdr)
;; => (("b" . 4) ("a" . 3) ("c" . 1))
;; sort the alist ascending by key
(sort (hash-table-to-alist *histo*) #'string< :key #'car)
;; => (("a" . 3) ("b" . 4) ("c" . 1))
;; sort the alist descending by key
(sort (hash-table-to-alist *histo*) #'string> :eky #'car)
;; => (("c" . 1) ("b" . 4) ("a" . 3))
The posted code has a whole lot of problems. The reported error is caused by superfluous parentheses. Parentheses can't be added arbitrarily to expressions in Lisps without causing problems. In this case, these are the offending expressions:
((setf pair (assoc word histo))
(remove pair histo)
(setf f (+ 1 (second pair)))
(setf pair ((car pair) f)
(append histo pair))
((setf pair (word '1)) (append histo pair))
In both of these expressions, the results of the calls to setf are placed in the function position of a list, so the code attempts to call that result as if it is a function, leading to the error.
There are other issues. It looks like OP code is trying to pack expressions into the arms of an if form; this is probably the origin of the extra parentheses noted above. But, if forms can only take a single expression in each arm. You can wrap multiple expressions in a progn form, or use a cond instead (which does allow multiple expressions in each arm). There are some typos: *histo* is mistyped as histo in most of the code; f and pair are not defined anyplace; (setf pair (word '1)) quotes the 1 unnecessarily (which will work, but is semantically wrong).
Altogether, the code looks rather convoluted. This can be made much simpler, still following the same basic idea:
(defparameter *histo* '())
(defun build-histogram (words)
(loop :for word :in words
:if (assoc word *histo*)
:do (incf (cdr (assoc word *histo*)))
:else
:do (push (cons word 1) *histo*)))
This code is almost self-explanatory. If a word has already been added to *histo*, increment its counter. Otherwise add a new entry with the counter initialized to 1. This code isn't ideal, since it uses a global variable to store the frequency counts. A better solution would construct a new list of frequency counts and return that:
(defun build-histogram (words)
(let ((hist '()))
(loop :for word :in words
:if (assoc word hist)
:do (incf (cdr (assoc word hist)))
:else
:do (push (cons word 1) hist))
hist))
Of course, there are all kinds of other ways you might go about solving this.
I observed a macro expansion I do not fully understand:
(defmacro test (cons-list)
`(list
,#(mapcar #'(lambda(elem)
elem)
cons-list)))
(defmacro test-2 ()
`(list ,#(list (cons "a" "b"))))
(defmacro test-3 (cons-list)
`(list ,#cons-list))
I'd expect both macros to expand in the same fashion, as I just use mapcar in a fancy way of creating the same list again and then use that list.
But the results observed in SBCL are:
(test (list (cons "a" "b"))) expands to (LIST LIST (CONS "a" "b"))
(test-2) expands to (LIST ("a" . "b"))
(test-3 (list (cons "a" "b"))) again expands to (LIST LIST (CONS "a" "b"))
Why don't these macro expansions behave the same?
Test-2 evaluates the form (list (cons "a" "b")), the other two do not.
Remember: the arguments to a macro are the forms read, unevaluated.
In order to get the same behaviour from test-2, you would have to quote the form: ,#'(list (cons "a" "b")).
EDIT: Here is a step-by-step expansion of test:
`(list
,#(mapcar #'(lambda (elem)
elem)
cons-list))
Removing the backquote syntactic sugar:
(list* 'list (mapcar #'(lambda (elem)
elem)
cons-list)
Argument substitution in your example:
(list* 'list (mapcar #'(lambda (elem)
elem)
'(list (cons "a" "b")))
Evaluate the mapcar form:
(list* 'list '(list (cons "a" "b")))
Evaluate the `list*' form:
'(list list (cons "a" "b"))
I've been tasked with creating a function that tells the placement in numerical form of a string within a list (from left to right), so that:
(position "a" '("a" "b" "c" "d" "e"))
returns 1
(position "b" '("a" "b" "c" "d" "e"))
returns 2 and
(position "z" '("a" "b" "c" "d" "e"))
returns #f
I've written it as such:
(define (position x L)
(if (pair? L)
(if (equal? x (car L))
1
(+ 1 (position x (cdr L)))
)
#f)
)
Unfortunately,
(position "z" '("a" "b" "c" "d" "e"))
Doesn't work at all since it's trying to add #f to a number. Is there any way out of this pickle?
Your answer is correct, but I'll suggest a different approach: by using a named let for implementing tail recursion we'll obtain a more efficient solution. Also notice how using cond (instead of nesting ifs) simplifies things:
(define (position x L)
(let loop ((L L) (acc 1))
(cond ((null? L) #f)
((equal? x (car L)) acc)
(else (loop (cdr L) (add1 acc))))))
Also, in the SRFI-1 library we can find the function list-index which almost returns what you want, we just have to add one to the result to convert it to a 1-based index:
(require srfi/1)
(define (position x L)
(cond ((list-index (curry equal? x) L) => add1)
(else #f)))
I fixed it by doing:
(define (position x L)
(if (pair? L)
(if (equal? x (car L))
1
(let ((p-cdr-L (position x (cdr L))))
(if p-cdr-L
(+ 1 p-cdr-L)
#f)))
#f))
I'm quite new to functional programming, especially Scheme as used below. I'm trying to make the following function that is recursive, tail recursive.
Basically, what the function does, is scores the alignment of two strings. When given two strings as input, it compares each "column" of characters and accumulates a score for that alignment, based on a scoring scheme that is implemented in a function called scorer that is called by the function in the code below.
I sort of have an idea of using a helper function to accumulate the score, but I'm not too sure how to do that, hence how would I go about making the function below tail-recursive?
(define (alignment-score string_one string_two)
(if (and (not (= (string-length string_one) 0))
(not (=(string-length string_two) 0)))
(+ (scorer (string-ref string_one 0)
(string-ref string_two 0))
(alignment-score-not-tail
(substring string_one 1 (string-length string_one))
(substring string_two 1 (string-length string_two))
)
)
0)
)
Just wanted to make an variant of Chris' answer that uses lists of chars:
(define (alignment-score s1 s2)
(let loop ((score 0)
(l1 (string->list s1))
(l2 (string->list s2)))
(if (or (null? l1) (null? l2))
score
(loop (+ score (scorer (car l1)
(car l2)))
(cdr l1)
(cdr l2)))))
No use stopping there. Since this now have become list iteration we can use higher order procedure. Typically we want a fold-left or foldl and SRFI-1 fold is an implementation of that that doesn't require the lists to be of the same length:
; (import (scheme) (only (srfi :1) fold)) ; r7rs
; (import (rnrs) (only (srfi :1) fold)) ; r6rs
; (require srfi/1) ; racket
(define (alignment-score s1 s2)
(fold (lambda (a b acc)
(+ acc (scorer a b)))
0
(string->list s1)
(string->list s2)))
If you accumulating and the order doesn't matter always choose a left fold since it's always tail recursive in Scheme.
Here's how it would look like with accumulator:
(define (alignment-score s1 s2)
(define min-length (min (string-length s1) (string-length s2)))
(let loop ((score 0)
(index 0))
(if (= index min-length)
score
(loop (+ score (scorer (string-ref s1 index)
(string-ref s2 index)))
(+ index 1)))))
In this case, score is the accumulator, which starts as 0. We also have an index (also starting as 0) that keeps track of which position in the string to grab. The base case, when we reach the end of either string, is to return the accumulated score so far.
I am having problem to print out all the possible paths. Currently I am only able to print out one path, and if (path-demo "J" "I"), the program will shown this error mcdr: expects argument of type <mutable-pair>; given #f
(define net
'(("A" "B")
("B" "A" "C")
("C" "B" "D")
("D" "C" "E" "F")
("F" "I" "D")
("I" "F")
("E" "D" "J")
("J" "E" "G")
("G" "J" "H")))
(define (path-demo start finish)
(for-each (lambda (x) (display x) (display " "))
(cons "Route:" (shortest-path start finish net))))
(define (shortest-path start end net)
(bfs end (list (list start)) net))
;; Breadth-first search
(define (bfs end queue net)
(display queue) (newline) (newline) ; entertainment
(if (null? queue)
'()
(let ((path (car queue)))
(let ((node (car path)))
(if (equal? node end) ;; Graham used CL eql
(reverse path)
(bfs end
(append (cdr queue)
(new-paths path node net))
net))))))
(define (new-paths path node net)
(map (lambda (n) (cons n path)) (cdr (assoc node net))))
;;
(path-demo "J" "I")
In your definition of net you have forgotten to list the nodes to which H is connected.
When the error occurs node and net have the following values:
node: H
net: ((A B) (B A C) (C B D) (D C E F) (F I D) (I F) (E D J)
(J E G) (G J H)))
Thus
(assoc node net))
will return #f because H has no associations in net.
And this leads to the error from cdr:
cdr: expects argument of type <pair>; given #f
It is likely that the following returns #f:
(cdr (assoc node net))
Regarding comment (for formatting):
(define (new-paths path node net)
(write node)
(newline)
(map (lambda (n) (cons n path)) (cdr (assoc node net))))