I have a construct like this
(loop :for c :in list-of-char-codes
:if (gethash c hash-of-frequencies)
:do (incf (gethash c hash-of-frequencies) 0))
Is there a reasonable way to avoid the redundant (gethash c hash-of-frequencies), e.g., for example, using an anaphoric macro?
Are you trying to coung only those char that are already in hash-of-frequencies?
(loop :for c :in list-of-char-codes
:for freq = (gethash c hash-of-frequencies)
:when freq
:do (setf (gethash c hash-of-frequencies) (1+ freq)))
Or maybe you want to count all chars?
(loop :for c :in list-of-char-codes
:do (incf (gethash c hash-of-frequencies 0)))
You can also generally avoid repetition by using #= and ##, like this:
(loop :for c :in list-of-char-codes
:for freq = #1=(gethash c hash-of-frequencies)
:when freq
:do (setf #1# (1+ freq)))
This is doing code insertion at read time.
For completeness w.r.t. other fine answers, you could also do this:
(defun foo (list-of-char-codes hash-of-frequencies)
(macrolet ((hash (c) `(gethash ,c hash-of-frequencies)))
(loop :for c :in list-of-char-codes
:for freq = (hash c)
:when freq
:do (setf (hash c) (1+ freq)))))
Note that if you often access/modify the same hash table, it might be a good idea to define a global macro to hide implementation details.
Also, you could even use symbol-macrolet, but I consider this bad style, because the following injects c, makes the binding implicit, and will break when renaming variable c (you asked about anaphoric macros, though):
;; AVOID DOING THAT, PLEASE
(defun foo (list-of-char-codes hash-of-frequencies)
(symbol-macrolet ((hash (gethash c hash-of-frequencies)))
(loop :for c :in list-of-char-codes
:for freq = hash
:when freq
:do (setf hash (1+ freq)))))
Related
I'm learning lisp and and implemented a nested array parses, so that:
"[1,[2,[3,[4,[5,6,7]]]],8,9]" -> '(1 (2 (3 (4 (5 6 7)))) 8 9)
Online Code snippet here
This was my first implementation of parse-line
(defun parse-line (string)
(loop
:for i = 0 :then (1+ j)
:for stack = (list nil)
:as j = (position-if (lambda (c) (member c '(#\[ #\] #\,))) string :start i)
:as n = (parse-integer string :start i :end j :junk-allowed t)
:when n :do (push n (car stack))
:while j
:do (cond
((eql #\[ (aref string j)) (push nil stack))
((eql #\] (aref string j)) (push (nreverse (pop stack)) (car stack))))
:finally (return (car (pop stack))))
))
But it crashes on the stack pop.
;test-case
(print (equal '(1 (2 (3 (4 (5 6 7)))) 8 9) (parse-line "[1,[2,[3,[4,[5,6,7]]]],8,9]")))
The value
NIL
is not of type
CONS
I then brute-forced my way into a solution declaring stack with let outside the loop macro
(defun parse-line (string)
(let ((stack (list nil)))
(loop
:for i = 0 :then (1+ j)
:as j = (position-if (lambda (c) (member c '(#\[ #\] #\,))) string :start i)
:as n = (parse-integer string :start i :end j :junk-allowed t)
:when n :do (push n (car stack))
:while j
:do (cond
((eql #\[ (aref string j)) (push nil stack))
((eql #\] (aref string j)) (push (nreverse (pop stack)) (car stack))))
:finally (return (car (pop stack))))
))
But I can't see why the second implementation works.
I also can't see why I need to initialize stack with (list nil). I thought that initializing stack to nil and removing the final car should be equivalent but it crashes with the same error at the same place, ie:
(defun parse-line (string)
(let (stack)
(loop
:for i = 0 :then (1+ j)
:as j = (position-if (lambda (c) (member c '(#\[ #\] #\,))) string :start i)
:as n = (parse-integer string :start i :end j :junk-allowed t)
:when n :do (push n (car stack))
:while j
:do (cond
((eql #\[ (aref string j)) (push nil stack))
((eql #\] (aref string j)) (push (nreverse (pop stack)) (car stack))))
:finally (return (pop stack)))
))
Look at these two lines in your first implementation:
:for i = 0 :then (1+ j)
:for sack = (list nil)
There is a typo (sack -> stack), but even then it doesn't work, because with each new value of i, you will create a brand new stack, losing all previous values. Add some debug print to see, what's going on:
i:0 j:0 n:NIL stack:(NIL NIL)
i:1 j:2 n:1 stack:((1))
i:3 j:3 n:NIL stack:(NIL NIL)
i:4 j:5 n:2 stack:((2))
i:6 j:6 n:NIL stack:(NIL NIL)
i:7 j:8 n:3 stack:((3))
...
If you don't want to use let to initialize stack, you can use keyword :with:
(defun parse-line (string)
(loop
:with stack = (list nil)
:for i = 0 :then (1+ j)
:as j = (position-if (lambda (c) (member c '(#\[ #\] #\,))) string :start i)
:as n = (parse-integer string :start i :end j :junk-allowed t)
:when n :do (push n (car stack))
:while j
:do (cond
((eql #\[ (aref string j)) (push nil stack))
((eql #\] (aref string j)) (push (nreverse (pop stack)) (car stack))))
:finally (return (car (pop stack)))))
You can use a similar debug print to see, why your code crashes with stack initialized to nil. This error can be reproduced with:
> (let ((stack '((9 8 (2 (3 (4 (5 6 7)))) 1))))
(push (nreverse (pop stack)) (car stack)))
Error: NIL (of type NULL) is not of type CONS.
You can find some explanation for this behaviour here: Why I can't (push 3 '()) in Common Lisp's REPL?
I would recommend using a Lisp compiler and using its warnings. SBCL gives this warning on your first form:
; in: DEFUN PARSE-LINE
; (PUSH N (CAR STACK))
;
; caught WARNING:
; undefined variable: COMMON-LISP-USER::STACK
;
; compilation unit finished
; Undefined variable:
; STACK
; caught 1 WARNING condition
That would lead you to investigate why that is: why is STACK undefined?
I am starting to use log4cl and am facing a weird issue when using it inside an iterate loop. While working does show the name of the method it is empty for not-working.
Do I miss something obvious here? Or is there a bug in the combination of iterate and log4cl?
(ql:quickload "iterate")
(ql:quickload "log4cl")
(defpackage :minimal
(:use #:cl #:iterate))
(in-package :minimal)
(defclass test ()
((a :documentation "test-a"
:initform (make-array '(3 3)
:element-type 'integer
:initial-element 0)
:initarg :a)))
(defvar *a* (make-instance 'test))
(defmethod not-working ((test test))
(with-slots (a) test
(iter
(for i below 3)
(iter
(for j below 3)
(unless (= 10 (aref a i j))
(log:info "R: ~D C: ~D" i j))))))
(defmethod working ((test test))
(with-slots (a) test
(loop
for i below 3
do (loop
for j below 3
unless (= 10 (aref a i j))
do (log:info "I: ~D J: ~D" i j)))))
(not-working *a*)
(working *a*)
EDIT
I see the issue only on sbcl. Using cclthe method name is displayed correctly. Furthermore, omitting the (are...) statement inside unless leads to a working version:
(defmethod also-working ((test test))
(with-slots (a) test
(iter
(for i below 3)
(iter
(for j below 3)
(unless (= 10 j)
(log:info "R: ~D C: ~D" i j))))))
i wrote this function but i have been told i can't use the loop inside of it, i have no idea how to modify it in order to remove the loop.
any suggestion?
(defun function (P VariableValues)
(let* ((M (mono P))
(VariableNames (variables P))
(VariableDict (loop for x in VariableNames for y in VariableValues collect (cons x y)))
(Valorizzati (mapcar (lambda (x) (applica-valori VariableDict x)) M))
)
(if Valorizzati
(+ (car Valorizzati) (recursive-sum (cdr Valorizzati)))
0)))
You can use mapcar for that:
(mapcar #'cons '(a b c) '(1 2 3))
;; ==> ((a . 1) (b . 2) (c . 3))
I have created a function that is supposed to have lexical variables of type ARRAY:
(defun give-rank-vec (dir-1 dir-2 file-1 file-2)
(let* ((cm-size (array-dimension (Swc (make-ff-array dir-1 file-1)
(make-ff-array dir-2 file-2))
0))
(rank-dump-vec (make-array `(,cm-size)))
(Swc' (Swc (make-ff-array dir-1 file-1)
(make-ff-array dir-2 file-2)))
(Sbc' (Sbc (make-ff-array dir-1 file-1)
(make-ff-array dir-2 file-2))))
(dotimes (j cm-size)
(setf (svref rank-dump-vec j)
(/ (get-element Sbc' j j)
(get-element Swc' j j))))
rank-dump-vec))
(defun Sbc (cmatrix1 cmatrix2)
(add-matrices (Si cmatrix1)
(Si cmatrix2)))
(defun add-matrices (A B)
(let ((C (make-array (array-dimensions A))))
(dotimes (i (array-dimension A 0))
(dotimes (j (array-dimension A 1))
(setf (aref C i j) (+ (aref A i j) (aref B i j)))))
C))
However when I SLIME this function I get the error:
The value
(SBC (MAKE-FF-ARRAY DIR-1 FILE-1)
(MAKE-FF-ARRAY DIR-2 FILE-2))
is not of type
ARRAY.
[Condition of type TYPE-ERROR]
Swc works fine, in that seems to return an array- however Sbc doesn't- I tested Sbc with small and huge (wc 13000 65000 627677) flat files and it returned an array when called in SLIME, however it isn't working in this case. The let* expression seems to be written right- I'm not sure what I'm doing wrong here.
The single quote character ' is a terminating macro character in Common Lisp. See the Figure 2-7 in the Hyperspec.
If you want to use this character in a symbol you have to quote it with a backslash or a pair of vertical bars:
CL-USER 65 > '(quote-at-the-end-\' |QUOTE-AT-THE-END-'| quote-at-the-end-|'|)
(QUOTE-AT-THE-END-\' QUOTE-AT-THE-END-\' QUOTE-AT-THE-END-\')
I'm writing a small interpreter for a C-like language in Scheme (R5RS) and trying to convert something like:
for (i = 0; i < 100; i++)
{
if (isprime(i)) continue;
else /* do something with i */
}
to valid Scheme (the isprime function is just an example and not important).
However, after trying for some time, I have not been able to find an efficient/simple way to add the equivalent of a continue statement to a do loop in Scheme. What would be even better would be a "for" macro which allows "continue" and "break" to be used.
I'm considering switching to Common Lisp. Would this sort of thing be any easier in CL?
We can write FOR as a macro. The Common Lisp version:
(defmacro for ((var start end) &body body)
(let ((block-name (gensym "BLOCK")))
`(loop for ,var from ,start below ,end
do (block ,block-name
(flet ((continue ()
(return-from ,block-name)))
,#body)))))
CL-USER 2 > (for (i 10 20)
(if (evenp i) (continue))
(print i))
11
13
15
17
19
CL's tagbody is a convenient target:
(let (i)
(tagbody
(setf i 0)
body
(if (isprime i)
(go increment))
(do-something-with i)
increment
(setf i (1+ i))
(if (< i 100)
(go body))))
I'd go for continuations like in this pseudo-scheme example.
Just store the current point of execution in a continuation and call it when appropriate.
(call/cc (lambda break ; jump outside the for
(for 0 100 (lambda i
(call/cc (lambda continue ; jump to the next iteration
(if (isprime i)
(continue)
(break))))))))
I know this is 8 years late, but I thought it might help someone.
Using the iterate construct in Common Lisp, you could use the next-iteration clause:
(iter (for i from 0 to 100)
(if (isprime i)
(next-iteration)
(do-something-else)))
The straightforward Scheme way to achieve this is just to restructure your code:
for (i = 0; i < 100; i++)
{
if (isprime(i)) continue;
if (is_bad(i)) break;
else /* do something with i */
}
is
(let loop ((i 0))
(cond
((isprime i) ;; continue the loop
(loop (+ i 1)))
((is_bad i)
#f) ;; break from the loop
(else ;; do something with i
....... ;; and then continue the loop
(loop (+ i 1)))))
If your loop body is tangled and you want to (continue) or (break) from deep inside its nested structure, either have your compiler restructure it in the above way, or you could set up exit points with call/cc as e.g.
(call/cc (lambda (break)
(let loop ((i 0))
(call/cc (lambda (continue)
;; your loop logic here,
;; potentially using
;; (continue A) ;; A is ignored
;; or
;; (break B) ;; B is immediately returned as
;; ;; the overall loop's result
))
;; (continue _) continues here:
(loop (+ i 1)))))
Racket has delimited continuations which should be more efficient.
To implement this particular code sample in Scheme, you don't need continue, break or call/cc:
(let loop ((i 0))
(when (< i 100)
(if (prime? i)
(loop (add1 i)))
(do-something-else)))
I think Vijay's answer can be extended in a way that works (sorry for answering my own question, but can't figure out how to format code in a comment):
(let loop ((i 0))
(define (next)
(loop (+ i 1)))
(call/cc
(lambda (break)
(if (< i 100)
(begin
(if (isprime i)
(next)
(begin
(if (isbad i)
(break break))
(do-something)
(next))))))))
It's not a macro, but doubtlessly leads to one that's general enough. I'd be interested to see any improvements. I'm pretty new to Scheme.
You can use throw and catch as well (elisp):
(let ((j 0))
(while (< j 10)
(catch 'continue
(setq j (1+ j))
(if (= j 3) (throw 'continue t))
(prin1 j))))
1245678910nil