I have a file LIST that has a sequence of characters per line. Each line is labeled with a category, i.e. "C". Example:
C: w r t y i o p s d f g h j k l z b n m
V: a e i o u
E: n m ng
I want to print every combination of C, V and E (or maybe just C and V, C and E, etc.) using doseq, but generically as I won't know the nested collections at compile time.
I.e.
"CV" [x y] (str x y )
"CVE" [x y z] (str x y z)
"CVCV" [x y z a] (str x y z a)
My code word-generator.clj
(ns word-generator )
(use 'clojure.string)
(import 'java.io.File)
(use 'clojure.java.io)
(defn get-lines [fname]
(with-open [r (reader fname)]
(doall (line-seq r))))
(defn get-list [x lines]
(first (remove nil?
(for [num (range (count lines)) ]
(if (= (first(split (nth lines num) #"\s+")) x)
(rest(split (nth lines num) #"\s+")))))))
(def sounds(get-lines "LIST")) ;; get the list
(def C (get-list "C:" sounds)) ;; map consonants
(def V (get-list "V:" sounds)) ;; map vowels
(def E (get-list "E:" sounds)) ;; map end consonants
(def LI "CVE") ;; word structure
(defn word-runner[carry args depth]
(doseq [x C y V z E] (println (str x y z)))) ;; iterate and make the words
(defn runner[]
( (print "enter arg list: ")
(def INPUT (read-line))
(word-runner "" INPUT 0)))
How can I implement word-runner so that doseq does a nested loop over all sequences of characters found in the file - but without knowing the number of lines in the file at compile-time?
This is actually a problem of combinatorics, not so much looping. Use the cartesian-product function from the math.combinatorics library to solve your problem.
;; alternative implementation of "word-runner"
(defn print-cartesian-products [& seqs]
(doseq [combs (apply cartesian-product seqs)]
(println (apply str combs))))
Related
I'm learning (common) Lisp, and as exercise, I want to implement 'xond', a cond macro, that transform this silly example:
(xond (= n 1) (setq x 2) (= n 2) (setq x 1))
into a if-else chain:
(if (= n 1) (setq x 2) (if (= n 2) (setq x 1)))
Currently, I have this macro:
(defmacro xond (&rest x) (if x (list 'progn (list 'if (pop x) (pop x)))))
that just expand the first two items in x:
(macroexpand '(xond (= x 1) (setq y 2)))
produce
(PROGN (IF (= X 1) (SETQ Y 2))) ;
Now I want to process all items in x, so I add a loop to produce a if-serie (a step toward if-else-version):
(defmacro xond (&rest x)
(loop (if x
(list 'progn (list 'if (pop x) (pop x)))
(return t))))
but then macro seems to stop working:
(macroexpand '(xond (= x 1) (setq y 2)))
T ;
What I'm missing here?
Edition
verdammelt's answer put me in the right track, and coredump's made me change my approach to an iterative one.
Now I'll implement (xond test1 exp1 test2 exp2) as:
(block nil
test1 (return exp1)
test2 (return exp2)
)
which can be done by iteration.
I'm writing this for my minimal Lisp interpreter; I have only implemented the most basic functions.
This is what I wrote. I'm using la to accumulate the parts of the output.
(defmacro xond (&rest x)
(let ((la '()))
(loop
(if x (push (list 'if (pop x) (list 'return (pop x))) la)
(progn (push 'nil la)
(push 'block la)
(return la)
)))))
with
(macroexpand '(xond (= x 1) (setq y 2) (= X 2) (setq y 1)))
result:
(BLOCK NIL
(IF (= X 2) (RETURN (SETQ Y 1)))
(IF (= X 1) (RETURN (SETQ Y 2)))
) ;
Second edition
Add a label to block and change return to return-from, to avoid conflict with other return inside arguments. Also changed push for append to generate code in the same orden as the parameters.
(defmacro xond (&rest x)
(let ((label (gensym)) (la '()) (condition nil) (expresion nil))
(setq la (append la (list 'block label)))
(loop
(if x
(setq la (append la (list
(list 'if (pop x) (list 'return-from label (pop x))))))
(return la)))))
So
(macroexpand '(xond (= x 1) (setq y 2) (= X 2) (setq y 1)))
now gives
(BLOCK #:G3187 (IF (= X 1) (RETURN-FROM #:G3187 (SETQ Y 2))) (IF (= X 2) (RETURN-FROM #:G3187 (SETQ Y 1))))
Some remarks
You do not need a progn when you only expand into a single if
The use of pop might be confusing for the reader (and the programmer too) since it mutates a place, maybe you want to start with a less imperative approach
Also, in that case I don't think a loop approach is helpful, because you need to nest the expressions that come after in the body inside a previously built form, and even though it can be done, it is a bit more complex to do that simply a recursive function or a "recursive" macro.
Here I explain both approach, starting with "recursive" macro (the quote here is because the macro does not call itself, but expands as call to itself).
Macro expansion fixpoint
If I had to implement xond, I would write a macro that expands into other calls to xond, until macroexpansion reaches a base case where there are no more xond:
(defmacro xond (&rest body)
(if (rest body)
(destructuring-bind (test if-action . rest) body
`(if ,test ,if-action (xond ,#rest)))
(first body)))
For example, this expression:
(xond (= n 1) (setq x 2) (= n 2) (setq x 1))
First macroexpands into:
(if (= n 1)
(setq x 2)
(xond (= n 2) (setq x 1)))
And eventually reaches a fixpoint with:
(if (= n 1)
(setq x 2)
(if (= n 2)
(setq x 1)
nil))
Be careful, you cannot directly use xond inside the definition of xond, what happens is that the macro expands as a call to xond, which Lisp then expands again. If you are not careful, you may end up with an infinite macroexpansion, that's why you need a base case where the macro does not expand into xond.
Macro calling a recursive function
Alternatively, you can call a recursive function inside your macro, and expand all the inner forms at once.
With LABELS, you bind xond-expand to a recursive function. Here this is an actual recursive approach:
(labels ((xond-expand (body)
(if body
(list 'if
(pop body)
(pop body)
(xond-expand body))
nil)))
(xond-expand '((= n 1) (setq x 2) (= n 2) (setq x 1))))
; => (IF (= N 1)
; (SETQ X 2)
; (IF (= N 2)
; (SETQ X 1)
; NIL))
Your xond macro ends with (return t) so it evaluates to t rather than your accumulated if expressions.
You could use loop's collect clause to accumulate the code you wish to return. For example: (loop for x in '(1 2 3) collect (* 2 x)) would evaluate to (2 4 6).
How about
(ql:quickload :alexandria)
(defun as-last (l1 l2)
`(,#l1 ,l2))
(defmacro xond (&rest args)
(reduce #'as-last
(loop for (condition . branch) in (alexandria:plist-alist args)
collect `(if ,condition ,branch))
:from-end t))
(macroexpand-1 '(xond c1 b1 c2 b2 c3 b3))
;; (IF C1 B1 (IF C2 B2 (IF C3 B3))) ;
;; T
alexandria's plist-alist was used to pair the arguments,
the intrinsic destructuring in loop used to extract conditions and branches.
The helper function as-last stacks lists together in the kind of
(a b c) (d e f) => (a b c (d e f)).
(reduce ... :from-end t) right-folds the sequence of the collected (if condition branch) clauses stacking them into each other using #'as-last.
Without any dependencies
('though, does alexandria even count as a dependency? ;) )
(defun pairs (l &key (acc '()) (fill-with-nil-p nil))
(cond ((null l) (nreverse acc))
((null (cdr l)) (pairs (cdr l)
:acc (cons (if fill-with-nil-p
(list (car l) nil)
l)
acc)
:fill-with-nil-p fill-with-nil-p))
(t (pairs (cdr (cdr l))
:acc (cons (list (car l) (cadr l)) acc)
:fill-with-nil-p fill-with-nil-p))))
(defun as-last (l1 l2)
`(,#l1 ,l2))
(defmacro xond (&rest args)
(reduce #'as-last
(loop for (condition branch) in (pairs args)
collect `(if ,condition ,branch))
:from-end t))
(macroexpand-1 '(xond c1 b1 c2 b2 c3 b3))
;; (IF C1 B1 (IF C2 B2 (IF C3 B3))) ;
;; T
The helper function pairs makes out of (a b c d e f) => ((a b) (c d) (e f)).
(:fill-with-nil-p determines in case of odd number of list elements, whether the last element would be listed (last-el) or (last-el nil) - in the latter case filled with nil).
Let's suppose I have an array - which I will call *my-array* - that looks like this:
#2A((1 2 3)
(4 5 6)
(7 8 9))
and I wish to apply some function f on the subarray
#2A((5 6)
(8 9))
I'd love to be able to write
(f (subarray *my-array* '(1 2) '(1 2))
where subarray takes as arguments:
the original array
a 2-element list with starting point and ending point on the 1st dimension
another 2-element list with starting point and ending point on the 2nd dimension
etc.
I am looking for some way to pass the subarray as argument to function f by reference (or by pointer?) instead of by value.
(The dumb way to address this would be to write a function that creates (in this specific case) a 2*2 array and loops over i and j copying values from the original array. However, if you are dealing relatively large arrays, this would be quite costly.)
I found there exists a cl-slice package but I do not get whether it copies values or accesses data by reference.
Common Lisp has Displaced Arrays which are exactly what you are asking about (see array-displacement &c).
However, in your case, displaces arrays are no help because:
Multidimensional arrays store their components in row-major order; that is, internally a multidimensional array is stored as a one-dimensional array, with the multidimensional index sets ordered lexicographically, last index varying fastest.
This means that your subarray is not a contiguous section of your main array, and, thus, you cannot create another array displaced to it.
PS. If you cannot figure out how cl-slice works, you can use time to see how much memory it uses and make your inference from that.
PPS. It is, in fact, not too hard to whip up something like what you want:
(defmacro slice (array &rest ranges)
"Return an accessor into ARRAY randing in RANGES."
(let ((args (loop for r in ranges collect (gensym "SLICE-ARG-")))
(arr (gensym "SLICE-ARRAY-")))
`(let ((,arr ,array))
(lambda ,args
(aref ,arr
,#(loop for arg in args and (lo hi) in ranges
for range = (- hi lo)
collect
`(progn
(unless (<= 0 ,arg ,range)
(error "~S is out of range [0;~S]" ,arg ,range))
(+ ,lo ,arg))))))))
(defparameter *my-array*
#2A((1 2 3)
(4 5 6)
(7 8 9)))
(defparameter f (slice *my-array* (1 2) (1 2)))
(loop for i from 0 to 1 do
(loop for j from 0 to 1 do
(format t " ~S" (funcall f i j)))
(terpri))
5 6
8 9
As others pointed out, you cannot use displaced arrays for matrices (maybe you could with non-standard functions). But all you need is to change how you interact with the original array. Here are some possibilities.
Sequences of displaced arrays
(defun area (matrix tlx tly brx bry)
;; you may also want to check that all coordinates are valid
;; inside current matrix. You could generalize this function for
;; more dimensions.
(assert (<= tlx tly))
(assert (<= brx bry))
(loop
for y from tly upto bry
collect (make-array (1+ (- brx tlx))
:displaced-to matrix
:displaced-index-offset
(array-row-major-index matrix y tlx))))
(tl means top-left, br means bottom-right).
Then, assuming you define your matrix as follows:
(defparameter *matrix* #2A((1 2 3)
(4 5 6)
(7 8 9)))
... the sub-matrix is obtained as follows:
(area *matrix* 1 1 2 2)
=> (#(5 6) #(8 9))
... and accessed like this:
(aref (nth ROW *) COL)
Any changes to *matrix* is reflected in one of the two displaced arrays, and inversely.
But if you coerce the resulting list as a vector, then you'll have a vector of arrays. This is different from multi-dimensional arrays, but gives you constant time access for rows:
(aref (aref area ROW) COL)
Wrapper closure
Another way to provide a restricted view of the original matrix is to create an accessor function that works only for the ranges of interest:
(defun sub-matrix (matrix tlx tly brx bry)
;; again, you should do more checks
(assert (<= tlx tly))
(assert (<= brx bry))
(lambda (x y &optional (value nil valuep))
(incf x tlx)
(incf y tly)
(assert (<= tlx x brx))
(assert (<= tly y bry))
(if valuep
(setf (aref matrix y x) value)
(aref matrix y x))))
This returns a closure which takes 2 or 3 arguments. The first two arguments are x and y coordinates relative to the inner matrix. When given a third argument, the closure sets the value. Otherwise, it gets the value.
This can be made more generic. I was partly inspired by sds's answer but tried to do things a little differently; here I can generate either a setter or a getter function. I also add some checks before creating the function and during the execution of the created function:
(defun slice-accessor (array ranges mode)
(let* ((dimensions (array-dimensions array))
(max-length (length dimensions)))
(check-type array array)
(loop
with r = (copy-list ranges)
for range = (pop r)
for (lo hi) = range
for d in dimensions
for x from 0
for $index = (gensym x)
collect $index into $indices
when range
do (assert (<= 0 lo hi d))
and collect `(check-type ,$index (integer 0 ,(- hi lo))) into checks
and collect `(incf ,$index ,lo) into increments
finally (let ((body `(apply #'aref ,array ,#$indices ())))
(return
(compile nil
(ecase mode
(:read `(lambda ,$indices
,#checks
,#increments
,body))
(:write (let (($v (make-symbol "VALUE")))
`(lambda (,$v ,#$indices)
(check-type ,$v ,(array-element-type array))
,#checks
,#increments
(setf ,body ,$v)))))))))))
CLOS
Once you have the above, you can provide a nice interface through objects. The setter and getter functions are updated whenever we change the ranges or the array being sliced:
(defclass array-slice ()
((array :initarg :array :accessor reference-array)
(ranges :initarg :ranges :accessor slice-ranges :initform nil)
(%fast-getter :accessor %fast-getter)
(%fast-setter :accessor %fast-setter)))
(flet ((update-fast-calls (o)
(setf (%fast-setter o)
(slice-accessor (reference-array o) (slice-ranges o) :write)
(%fast-getter o)
(slice-accessor (reference-array o) (slice-ranges o) :read))))
(defmethod initialize-instance :after ((o array-slice) &rest k)
(declare (ignore k))
(update-fast-calls o))
(defmethod (setf reference-array) :after (new-array (o array-slice))
(declare (ignore new-array))
(update-fast-calls o))
(defmethod (setf slice-ranges) :after (new-ranges (o array-slice))
(declare (ignore new-ranges))
(update-fast-calls o)))
(defgeneric slice-aref (slice &rest indices)
(:method ((o array-slice) &rest indices)
(apply (%fast-getter o) indices)))
(defgeneric (setf slice-aref) (new-value slice &rest indices)
(:method (new-value (o array-slice) &rest indices)
(apply (%fast-setter o) new-value indices)))
Examples
(defparameter *slice*
(make-instance 'array-slice :array *matrix*))
;; no range by default
(slice-aref *slice* 0 0)
=> 1
;; update ranges
(setf (slice-ranges *slice*) '((1 2) (1 2)))
(slice-aref *slice* 0 0)
=> 5
(incf (slice-aref *slice* 0 0) 10)
=> 15
*matrix*
=> #2A((1 2 3) (4 15 6) (7 8 9))
;; change array
(setf (reference-array *slice*) (make-array '(3 3) :initial-element -1))
(slice-aref *slice* 0 0)
=> -1
I don't think it is possible to do exactly what you want to do. In memory, multidimensional arrays are implemented as a single flat array with some metadata which is used to convert from the multidimensional interface to the flat one. In your case *my-array* would look like this:
#(1 2 3 4 5 6 7 8 9)
If you had the subarray you desired as a reference to the original array, it would look like this:
#(5 6 _ 8 9)
Which is impossible since you are trying to skip the 7 of the original array. If all of the desired elements were part of a contiguous sub-sequence, you would be able to use the :displaced-to argument of make-array in order to copy the sub-sequence by reference, but unfortunately, that is not the case.
I am trying to get a link for each photoset. It should look like this:
[:p (link-to (str "/album?photosetid="photosetid) photoset-name)
In the following code I get a map of all photoset ids and names:
(def ids (map #(str "/album?photosetid=" %1) photoset-id))
(def names (map #(str %1) photoset-name))
After that i try to create the links:
(loop [x (count ids)]
(when (> x 0)
[:p (link-to (nth ids x "") name) (nth names x "")]
(recur (- x 1))
)
)
The problem is that I don't get any output.
Thanks for any help!
(map #(vector :p (link-to (str "/album?photosetid=" %1) %2)) ids names)
I am trying to write a macro in Clojure that allows for evaluation of a series of simple "def" expressions. I am a n00b when it comes to macros. The idea is that
(my-defs y1 1
y2 "taco")
should expand to
(do (def y1 1) (def y2 "taco"))
The following code accomplishes this for the special case of two defs
(defmacro my-defs
[& args]
`(do
(def ~(first args) ~(second args))
(def ~(nth args 2) ~(nth args 3) )))
which is nice, but I am having trouble generalizing this. I tried out a few naive things involving looping through bindings of the elements of (partition 2 args) but I always got garbage (I know this isn't very specific but the diversity and extent of the garbage seemed a bit too much to report here). How do I loop over these are and evaluate my defs?
P.S.
The macro my-defs is a toy. What i really want to accomplish in the end is a littel helper macro to instantiate a bunch of multimethod instances. Currently I have large chunks of code that look like
(defmethod f [A B] [x] "AB")
(defmethod f [A A] [x] "AA")
(defmethod f [C B] [x] "CB")
which is a little unsightly. It would be nice if I could do something like
(defmethods f
[A B] [x] "AB"
[A A] [x] "AA"
[C B] [x] "CB")
instead.
It looks to me like you're looking for the ~# macro expansion/unquote.
(defmacro defmethods [n & defs]
`(do ~#(map (fn [[a1 a2 a3]]
`(def ~n ~a1 ~a2 ~a3))
(partition 3 defs))))
how can I print a list of n, say 10, numbers on 10 lines? I just learned about loop and recur, but cannot seem to combine a side-effect (println i) with (recur (+ i 1)) in a loop form.
Just to be very clear: I'd like output like this:
1
2
3
4
5
6
7
8
9
10
when n is 10.
You can use doseq for this, which is meant to be used when iteration involves side effects,
(doseq [i (range 10)]
(println i))
You could use map as pointed but that will produce a sequence full of nils which is both not idiomatic and wastes resources also doseq is not lazy so no need to force it with doall.
I suggest dotimes for this kind of simple loop:
(dotimes [i 10]
(println (inc i)))
Note that dotimes is non-lazy, so it is good for things like println that cause side effects.
With loop/recur:
(loop [i 1]
(when (<= i 10)
(println i)
(recur (inc i))))
However, it's more idiomatic (read: more "Clojuristic") to map the function println over the numbers in 1..10. But because map returns a lazy sequence, you must force its evaluation with doall:
(doall (map println (range 1 (inc 10))))
And just to be comprehensive you can do it with map also:
(doseq (map #(println %) (range 10))
If you only want to print the output on the screen, you might also simply put a (println i) before entering your conditional:
(loop [i 0]
(println i)
(if (< i 10)
(recur (inc i))
(println "done!")))
And the output will be one number per line.