I'm a newbie working through HTDP2 (Felleisen et al.) on my own but have gotten stuck on question #380 of chapter IV -Intertwined Data. The problem is within the context of creating a DSL but I am first reacquainted with a general FSM Simulator and provided with the following code:
; An FSM is a [List-of 1Transition]
; A 1Transition is a list of two items:
; (cons FSM-State (cons FSM-State '()))
; An FSM-State is a String that specifies a color
; data examples
(define fsm-traffic
'(("red" "green") ("green" "yellow") ("yellow" "red")))
; FSM FSM-State -> FSM-State
; matches the keys pressed by a player with the given FSM
(define (simulate state0 transitions)
(big-bang state0 ; FSM-State
[to-draw
(lambda (current)
(overlay (text current 12 "black")
(square 100 "solid" current)))]
[on-key
(lambda (current key-event)
(find transitions current))]))
; [X Y] [List-of [List X Y]] X -> Y
; finds the matching Y for the given X in alist
(define (find alist x)
(local ((define fm (assoc x alist)))
(if (cons? fm) (second fm) (error "not found"))))
The problem is then stated as follows:
Reformulate the data definition for 1Transition so that it is possible to restrict transitions to certain keystrokes. Try to formulate the change so that find continues to work without change. What else do you need to change to get the complete program to work? Which part of the design recipe provides the answer(s)? See exercise 229 for the original exercise statement.
Exercise 229 introduces a structure type definition to keep track of the states and the transitions but since the problem statement asks me to stay within the provided find function I am hard pressed to come up with a similar structure type of definition. Instead I came up with the following Data Definition:
; An FSM is a [List-of Transition]
; A Transition is a two-item list of the following form:
; (cons FSM-State (cons (cons KeyEvent (cons FSM-State '()))'()))
; data example
(define fsm-traffic (list (list "red" (list "r" "green"))
(list "green" (list "g" "yellow"))
(list "yellow" (list "y" "red"))))
Hence calling (find fsm-traffic "green") I get (list "g" "yellow") I have thus modified the on-key clause as follows:
(lambda (current key-event)
(if (string=? key-event (first (first (rest (first transitions)))))
(second (find transitions current))
(error "invalid input")))
Now if I start the program with (simulate "red" fsm-traffic) State0 is rendered and if I press "r" it goes to "green" FSM-State but then it won't accept "g" to go to the following state and so on.
If I begin the world-program with (simulate "yellow" fsm-traffic) then FSM-State "yellow" is rendered but it will not transition to any other state (the error clause is activated); similarly with "green" as the starting state.
My hunch is that since I defined fsm-traffic with the "red" state first it accepts its input to transition to "green" but since the same is not happening with the other states big-bang is not "juggling" the transitions parameter right. But I just don't know how to fix that. I also don't know if I've gone wrong since the start with my data definition.
Thank you in advance for helping me out.
P.D. please let me know if I have followed the rules on posting on stackoverflow (this is my first post :).
You identified the source of the problem is correctly. You defined fsm-traffic with the "red" state and the "r" transition first, and the on-key handler only looks at the first. It does this in the if question:
(string=? key-event (first (first (rest (first transitions)))))
; ^ ^
; | this makes it only look at `"red"`
; this makes it only look at `"r"` within that
This if question seems complicated. Just like we would do if it was a function with a signature and purpose, we can design the inputs, output, and purpose of this expression.
Inputs: What should it depend on?
Which keys are valid depends on the transitions table, but it also depends on the current state. This is the reason why only "r" is valid on the "red" state, but "g" is valid on the "green" state. So its inputs are:
current : FSM-State
key-event : KeyEvent
transitions : FSM
Your existing expression ignores current.
Output and purpose
It is an if question, so it should output a Boolean. The purpose of this boolean is to determine whether the key is valid on the current state.
It should be true when there is any transition in the table for both the current state and the key-event.
This purpose statement with "any" and "both" sounds complicated enough that it deserves to be its own function. Using the inputs, output, and purpose we just made:
;; FSM-State KeyEvent FSM -> Boolean
;; Determines whether there is any transition in the FSM table for both the current
;; state and the key event.
(define (transition-for-state-and-key? state key table)
....)
Your current expression for the body this doesn't include the state,
(string=? key (first (first (rest (first table)))))
But the actual body should depend on both state and key.
Just like this depends on both, the find function should also depend on both state and key.
;; FSM-State KeyEvent FSM -> FSM-State
;; Finds the matching transition-state from the given state with the given key in the table.
(define (find-transition-state state key table)
....)
And note the relationship between transition-for-state-and-key? and find-transition-state. The transition-for-state-and-key? function should return true exactly when find-transition-state won't error.
This should be enough for you to continue.
Related
I need some help understanding completion-at-point.
I have this minimal example, where I want to:
activate when I type "#"
search/complete on candidates car ...
... but return cdr, so result at point is, for example "#doe" (though I may need to extend this later to drop the "#" in some cases, like with LaTeX).
The actual use case is to insert a citation key in a document, but search on author, title, etc. The intention is for this to be used with solutions like corfu and company-capf.
In that code, which is a front-end to bibtex-completion like helm-bibtex and ivy-bibtex, I have a core bibtex-actions-read function based on completing-read-multiple for minibuffer completion.
With this capf, I want to use the same cached data to complete against for at-point completion.
With this test example, I get 1 and 2, which is what I want on the UI end.
(defun test-capf ()
"My capf."
(when (looking-back "#[a-zA-Z]*")
(list
(save-excursion
(backward-word)
(point))
(point)
(lambda (str pred action)
(let ((candidates '(("a title doe" . "doe")
("different title jones" . "jones")
("nothing smith" . "smith"))))
(complete-with-action action candidates str pred))))))
But how do I adapt it to this to add 3? That is, if I type "#not", corfu or company should display "nothing smith", and if I select that item, it should return "#smith" at-point.
Note: my package pretty much depends on completion-styles like orderless, so order is of course not significant.
Do I need to use an :exit-function here?
For completeness, here's the current actual function, which now says "no matches" when I try to use it.
(defun bibtex-actions-complete-key-at-point ()
"Complete citation key at point.
When inserting '#' in a buffer the capf UI will present user with
a list of entries, from which they can narrow against a string
which includes title, author, etc., and then select one. This
function will then return the key 'key', resulting in '#key' at
point."
;; FIX current function only returns "no match"
;; TODO this regex needs to adapt for mode/citation syntax
(when (looking-back "#[a-zA-Z]+" 5)
(let* ((candidates (bibtex-actions--get-candidates))
(begin (save-excursion (backward-word) (point)))
(end (point)))
(list begin end candidates :exclusive 'no
;; I believe I need an exit-function so I can insert the key instead
;; of the candidate string.
:exit-function
(lambda (chosen status)
(when (eq status 'finished)
(cdr (assoc chosen candidates))))))))
Any other tips or suggestions?
This Q&A is related, but I can't figure out how to adapt it.
Why not just keep the completion candidates in your completion table, not conses?
There are some useful wrappers in minibuffer.el around completion tables. In this case you could use completion-table-dynamic, as a wrapper to use a function as the COLLECTION argument to complete-with-action.
I think the more efficient way would just collect the cdrs of your current candidates and allow the C implementations of all-completions to find matches
(complete-with-action action (mapcar #'cdr candidates) str pred)
Or, calling a function to return current candidates
(completion-table-dynamic
(lambda (_str)
(mapcar #'cdr (my-current-candidates))))
Or, filtering in elisp
(let ((candidates '((...)))
(beg '...)
(end '...))
;; ...
(list beg end
(completion-table-dynamic
(lambda (str)
(cl-loop for (a . b) in candidates
if (string-prefix-p str a)
collect b)))))
The solution was an exit-function, with body like this:
(delete-char (- (length str)))
(insert (cdr (assoc str candidates)))))
In Emacs f90 mode, there are two useful functions f90-beginning-of-block and f90-end-of-block, (bound to keys C-M-p and C-M-n,repsectively), which I often use to jump between beginning and end of code blocks (such as function/subroutine/module).
However I found there is weakness in these two functions. For example:
module a
contains
function f()
write(*,*)
end function
end module a
When placing the cursor at the beginning of module and press C-M-n, the cursor will jump to the end function line, rather than the end module a line. The correct behavior appears only after I modify the end function line to the end function f , i.e., adding back the function name. Since there are many existing codes that often omit function names at the end function, I am wondering whether there is an easy improvement to f90-end-of-block, so that it can correctly handle the above case.
The original interactive Lisp function f90-end-of-block is defined as:
(defun f90-end-of-block (&optional num)
"Move point forward to the end of the current code block.
With optional argument NUM, go forward that many balanced blocks.
If NUM is negative, go backward to the start of a block. Checks
for consistency of block types and labels (if present), and
completes outermost block if `f90-smart-end' is non-nil.
Interactively, pushes mark before moving point."
(interactive "p")
;; Can move some distance.
(if (called-interactively-p 'any) (push-mark (point) t))
(and num (< num 0) (f90-beginning-of-block (- num)))
(let ((f90-smart-end (if f90-smart-end 'no-blink)) ; for final match-end
(case-fold-search t)
(count (or num 1))
start-list start-this start-type start-label end-type end-label)
(end-of-line) ; probably want this
(while (and (> count 0) (re-search-forward f90-blocks-re nil 'move))
(beginning-of-line)
(skip-chars-forward " \t0-9")
(cond ((or (f90-in-string) (f90-in-comment)))
((setq start-this
(or
(f90-looking-at-do)
(f90-looking-at-select-case)
(f90-looking-at-type-like)
(f90-looking-at-associate)
(f90-looking-at-critical)
(f90-looking-at-program-block-start)
(f90-looking-at-if-then)
(f90-looking-at-where-or-forall)))
(setq start-list (cons start-this start-list) ; not add-to-list!
count (1+ count)))
((looking-at (concat "end[ \t]*" f90-blocks-re
"[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?"))
(setq end-type (match-string 1)
end-label (match-string 2)
count (1- count))
;; Check any internal blocks.
(when start-list
(setq start-this (car start-list)
start-list (cdr start-list)
start-type (car start-this)
start-label (cadr start-this))
(or (f90-equal-symbols start-type end-type)
(error "End type `%s' does not match start type `%s'"
end-type start-type))
(or (f90-equal-symbols start-label end-label)
(error "End label `%s' does not match start label `%s'"
end-label start-label)))))
(end-of-line))
(if (> count 0) (error "Missing block end"))
;; Check outermost block.
(when f90-smart-end
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t0-9")
(f90-match-end)))))
A quick hack is to modify the line that checks the label matching from yielding error message to just yielding a warning message:
(or (f90-equal-symbols start-label end-label)
(message "Start label `%s' does not match end label `%s'"
There is a SO user who posted this solution as an answer, but deleted the answer before I can verify the solution. The reason she/he deleted the answer may be because I commented on the answer saying that another function f90-beginning-of-subprogram can handle the case with mismatched labels. But later I found I still need the additional functionalities provided by f90-beginning-of-block, which are not provided by f90-beginning-of-subprogram.
I am trying to create a function games-won that consumes a list of Games, results, and a string, name, and produces the number of games in results that name won.
For example:
(define-struct game (winner loser high low))
(check-expect (games-won (list (make-game "Lori" "Troy" 52 34)
(make-game "Mary" "Lori" 30 20)) "Lori") 1)
Below is what I have so far:
(define (won? game name)
(equal? (game-winner game) name))
(define (wonlst results)
(filter won? results))
(define (lst-length lst)
(cond
[(empty? lst) 0]
[(cons? lst) (+ 1 (length (rest lst)))]))
(define (games-won results)
(cond
[(cons? (wonlst results)) (lst-length (wonlst results))]
[else 0]))
Can anyone help correct the errors in my code and maybe tell me how to use local and put the functions all together?
Here are the fixes:
As the test suggests, games-won should accept two arguments: a results list and a name. So we add a parameter - name - to games-won.
You don't need a custom lst-length function, you can just use length. Also, games-won doesn't need to worry about returning 0 in the else case. The base case is taken care of by the list-abstractions.
Note that won? takes in two inputs, but the predicate function in a filter only accepts one input. So we remove name from won?. Once we put won? in a local, it can just use name from the surrounding function's context.
We put a local in games-won and put the two helpers - won? and won-lst - in the local.
You should use string=? instead of equal?for since we know that name and winner field of game is always a String.
(define-struct game (winner loser high low))
; games-won : [List-of Game] String -> Number
(define (games-won results name)
(local (; won? : Game -> Boolean
(define (won? game)
(string=? (game-winner game) name))
; wonlst : [List-of Game] -> [List-of Game]
(define (wonlst results)
(filter won? results)))
(length (wonlst results))))
(define my-games1 (list (make-game "Lori" "Troy" 52 34)
(make-game "Mary" "Lori" 30 20)))
(check-expect (games-won my-games1 "Lori") 1)
We can just put everything in one function along with a lambda like the following:
(define (games-won results name)
(length (filter (λ (game) (string=? (game-winner game) name)) results)))
How to use local
A local expression has the following shape:
(local [definition ...] body-expression)
Within the square brackets, you can put as many definitions (i.e. defines, define-structs) as you want, and in the body of the local — body-expression — you can put any expression that may or may not use the definitions within the square brackets. The definitions are only available in the body.
From HtDP, here's how we compute with locals:
We rename the locally defined constants and functions to use names that aren’t used elsewhere in the program.
We lift the definitions in the local expression to the top level and evaluate the body of the local expression next.
I am working on problem to get the occurence of Prime in a list in lisp.
Input:
Write a function (OccurencesOfPrimes < list >) which counts the number of primes in a (possibly nested) list.
Output: Example: (OccurencesOfPrimes (((1)(2))(5)(3)((8)3)) returns 4.
I am using the below code but getting the error like:
(
defun OccurencesOfPrimes (list)
(loop for i from 2 to 100
do ( setq isPrime t)
(loop for j from 2 to i
never (zerop (mod i j))
(setq isPrime f)
(break)
)
)
(if (setq isPrime t)
(append list i)
)
)
)
LOOP: illegal syntax near (SETQ ISPRIME F) in
(LOOP FOR J FROM 2 TO I NEVER (ZEROP (MOD I J)) (SETQ ISPRIME F) (BREAK)
)
Any help.
It is important to keep the format consistent with the expected conventions of the language. It helps when reading the code (in particular with other programmers), and can help you see errors.
Also, you should use an editor which, at the minimum, keep tracks of parentheses. In Emacs, when you put the cursor in the first opening parenthesis, the matching parenthesis is highlighted. You can spot that you have one additional parenthesis that serves no purpose.
(
defun OccurencesOfPrimes (list)
(loop for i from 2 to 100
do ( setq isPrime t)
(loop for j from 2 to i
never (zerop (mod i j))
(setq isPrime f)
(break)
)
)
(if (setq isPrime t)
(append list i)
)
) ;; <- end of defun
) ;; <- closes nothing
In Lisp, parentheses are for the computer, whereas indentation is for humans. Tools can automatically indent the code according to the structure (the parenthesis), and any discrepancy between what indentation you expect and the one being computed is a hint that your code is badly formed. If you look at the indentation of your expressions, you can see how deep you are in the form, and that alone helps you understand the code.
Symbol names are dash-separated, not camlCased.
Your code, with remarks:
(defun occurences-of-primes (list)
;; You argument is likely to be a LIST, given its name and the way
;; you call APPEND below. But you never iterate over the list. This
;; is suspicious.
(loop
for i from 2 to 100
do
(setq is-prime t) ;; setting an undeclared variable
(loop
for j from 2 to i
never (zerop (mod i j))
;; the following two forms are not expected here according
;; to LOOP's grammar; setting IS-PRIME to F, but F is not
;; an existing variable. If you want to set to false, use
;; NIL instead.
(setq is-prime f)
;; BREAK enters the debugger, maybe you wanted to use
;; LOOP-FINISH instead, but the NEVER clause above should
;; already be enough to exit the loop as soon as its
;; sub-expression evaluates to NIL.
(break)))
;; The return value of (SETQ X V) is V, so here your test would
;; always succeed.
(if (setq is-prime t)
;; Append RETURNS a new list, without modifying its
;; arguments. In particular, LIST is not modified. Note that "I"
;; is unknown at this point, because the bindings effective
;; inside the LOOP are not visible in this scope. Besides, "I"
;; is a number, not a list.
(append list i)))
Original question
Write one function which counts all the occurrences of a prime number in a (possibly nested) list.
Even though the homework questions says "write one function", it does not say that you should write one big function that compute everything at once. You could write one such big function, but if you split your problem into sub-problems, you will end with different auxiliary functions, which:
are simpler to understand (they do one thing)
can be reused to build other functions
The sub-problems are, for example: how to determine if a number is a prime? how to iterate over a tree (a.k.a. a possibly nested list)? how to count
the occurrences?
The basic idea is to write an "is-prime" function, iterate over the tree and call "is-prime" on each element; if the element is prime and was never seen before, add 1 to a counter, local to your function.
You can also flatten the input tree, to obtain a list, then sort the resulting
list; you iterate over the list while keeping track of the last
value seen: if the value is the same as the previous one, you
already know if the number is prime; if the previous number differs, then
you have to test if the number is prime first.
You could also abstract things a little more, and define a higher-order tree-walker function, which calls a function on each leaf of the tree. And write another higher-order function which "memoizes" calls: it wraps around a
function F so that if you call F with the same arguments as before,
it returns the result that was stored instead of recomputing it.
Example
I'll combine the above ideas because if you give that answer to a teacher you are likely to have to carefully explain what each part does (and if you can, great for you); this is not necessarily the "best" answer, but it covers a lot of things.
(defun tree-walk-leaves (tree function)
(typecase tree
(null nil)
(cons
(tree-walk-leaves (car tree) function)
(tree-walk-leaves (cdr tree) function))
(t (funcall function tree))))
(defun flatten (tree &optional keep-order-p)
(let ((flat nil))
(tree-walk-leaves tree (lambda (leaf) (push leaf flat)))
(if keep-order-p
(nreverse flat)
flat)))
(defun prime-p (n)
(or (= n 2)
(and (> n 2)
(oddp n)
(loop
for d from 3 upto (isqrt n) by 2
never (zerop (mod n d))))))
(defun count-occurences-of-prime (tree)
(count-if #'prime-p (remove-duplicates (flatten tree))))
(count-occurences-of-prime '(((1)(2))(5)(3)((8)3)))
=> 4
If, instead, you don't want to remove duplicates but count the multiple times a prime number occurs, you can do:
(count-if (memoize #'prime-p) (flatten tree))
... where memoize is:
(defun memoize (function &key (test #'equalp) (key #'identity))
(let ((hash (make-hash-table :test test)))
(lambda (&rest args)
(let ((args (funcall key args)))
(multiple-value-bind (result exists-p) (gethash args hash)
(values-list
(if exists-p
result
(setf (gethash args hash)
(multiple-value-list (apply function args))))))))))
(memoize is useless if there are no duplicates)
I am trying to create a macro for while loop in DrRacket. Here is what I wrote:
(require mzlib/defmacro)
(define-macro my-while
(lambda (condition body)
(list 'local (list (list 'define (list 'while-loop)
(list 'if condition
(list body (list 'while-loop))
'(void))))
'(while-loop))))
(define x 0)
(my-while (< x 10)
(begin
(display x)
(newline)
(set! x (+ x 1))))
The output of this program is:
0
1
2
3
4
5
6
7
8
9
error: procedure application: expected procedure, given: #<void>; arguments were: #<void>
Can someone help me with this? Why wouldn't this macro just terminate and return void. It seems that when the condition is not true, the system tries to apply the void as an argument to some procedure.
Ouch:
Using this style of while loop encourages excessive use of imperative programming.
Using define-macro creates unhygienic macros, which is a nightmare in Scheme.
While I don't encourage writing an imperative-style loop macro, for your reference, here's a non-define-macro version of the same macro:
(define-syntax-rule (my-while condition body ...)
(let loop ()
(when condition
body ...
(loop))))
It uses syntax-rules, which creates hygienic macros, and is much, much easier to read than what you have.
Now, for the actual answer for your question, first, let's write your original macro out in a more readable way:
(define-macro my-while
(lambda (condition body)
`(local ((define (while-loop)
(if ,condition
(,body (while-loop))
(void))))
(while-loop))))
Once you write it out this way, you can see where the real problem is: in the (,body (while-loop)) line, which should instead have been (begin ,body (while-loop)).
Why use a macro when a plain old function will do?
;; fun-while : (-> Boolean) (-> Any) -> Void
(define (fun-while condition body)
(when (condition)
(body)
(fun-while condition body))
Of course, this requires you to pass in repeatable actions that can be called (this is why condition and body are surrounded with parens in the body of fun-while), so you do need a macro if you want prettier syntax. But once you have a function that has the desired behavior, putting some sugar on top is trivial for this case:
(define-syntax-rule (my-while condition body ...)
(fun-while (lambda () condition)
(lambda () body ...)))
Now, as has been said, this encourages imperative style, which is frowned upon. Instead of mutation, try making the state explicit instead:
;; pure-while : forall State.
;; (State -> Boolean) ; the "condition" that inspects the state
;; (State -> State) ; the "body" that moves from one state to the next
;; -> ; curried
;; State ; the current state
;; -> State ; produces the ending state
(define ((pure-while condition make-next) current-state)
(if (condition current-state)
(pure-while condition make-next (make-next current-state))
current-state))
You'll notice that the first two arguments are now functions from State to something, and the result of applying to 2 arguments is also a function from State -> State. This is a recurring pattern that, as a Haskeller, I'd call the "State Monad". Discussion of putting sugar on top of this concept is a little beyond the scope of this conversation, though, so I'll just stop there.
Another version of while uses a do loop:
(define-syntax while
(syntax-rules ()
((while pred? stmt ...)
(do () ((not pred?))
stmt ...))))
Because it's been a while:
a while macro for Racket 6.0
#lang racket
(define-syntax while
(syntax-rules ()
((_ pred? stmt ...)
(do () ((not pred?))
stmt ...))))