I've got a nested plist structure, for example:
(:title "A title"
:repeat (:row #(:a :b :c)
:column #(:c :a :b))
:spec (:data my-data
:late t))
and I need to set :data to a different value. The challange is that this key may appear anywhere in the tree, possibly even deeper in the tree than this example. It will only appear once. I know about the access library, but can't use it. I can find the key easy enough using a recursive search:
(defun find-in-tree (item tree &key (test #'eql))
(labels ((find-in-tree-aux (tree)
(cond ((funcall test item tree)
(return-from find-in-tree tree))
((consp tree)
(find-in-tree-aux (car tree))
(find-in-tree-aux (cdr tree))))))
(find-in-tree-aux tree)))
But I can't quite work out if there's any way to get the place when it's nested in the tree. Ideally something like:
(setf (find-place-in-tree :data tree) 'foo)
is what I'm after.
Any ideas?
I could not work out your recursive searcher so I wrote a simpler one, which also solves the 'item is present but value is nil' in the usual way:
(defun find-in-tree (item tree &key (test #'eql))
;; really just use iterate here
(labels ((fit-loop (tail)
(cond
((null tail)
;; not there
(return-from find-in-tree (values nil nil)))
((null (rest tail))
;; not a plist
(error "botched plist"))
(t
(destructuring-bind (this val . more) tail
(cond
((funcall test this item)
;; gotit
(return-from find-in-tree (values val t)))
((consp val)
;; Search in the value if it's a list
(fit-loop val)
(fit-loop more))
(t
;; just keep down this list
(fit-loop more))))))))
(fit-loop tree)))
Given that the setf function is essentially trivial if you don't want it to add entries (which it can not always do anyway):
(defun (setf find-in-tree) (new item tree &key (test #'eql))
;; really just use iterate here
(labels ((fit-loop (tail)
(cond
((null tail)
(error "not in tree"))
((null (rest tail))
(error "botched plist"))
(t
(destructuring-bind (this val . more) tail
(cond
((funcall test this item)
(return-from find-in-tree
(car (setf (cdr tail) (cons new more)))))
((consp val)
(fit-loop val)
(fit-loop more))
(t
(fit-loop more))))))))
(fit-loop tree)))
This is not exactly a setf-able tree.
But the construction of a setf-like in-place mutation macro for nested plists - even for the case that the key of a nested plist occurs in more than one places.
The plist-setf constructs paths to the desired key within the nested plist. And replaces the current value to the new-value.
Within a path, a symbol should not occur twice. Otherwise there will be severe errors.
(defun plistp (l)
"Is `l` a plist?"
(loop for (k v) on l by #'cddr
always (symbolp k)))
(defun get-plist-paths (plist key &optional (acc '()))
"Which paths are in a nested plist for reaching key?"
(loop for (k v) on plist by #'cddr
nconcing (if (eq key k)
(list (reverse (cons key acc)))
(if (plistp v)
(get-plist-paths v key (cons k acc))
nil))))
(defun staple (plist plist-path)
"Given a plist-path, generate code to getf to this path."
(let ((res (list 'getf plist (car plist-path))))
(loop for s in (cdr plist-path)
do (setf res (cons 'getf (cons res (list s))))
finally (return res))))
(defun construct-call (plist plist-path new-value)
"Add to the generated code a `(setf ... new-value)."
`(setf ,(staple plist plist-path) ,new-value))
(defun construct-entire-call (plist-symbol plist key new-value)
"Generate the entire code for the macro."
(let ((plist-paths (get-plist-paths plist key)))
(cons 'progn
(loop for pp in plist-paths
collect (construct-call plist-symbol pp new-value)))))
(defmacro %plist-setf (plist key new-value)
"A macro to make the input of construct-entire-call more uniform."
`(construct-entire-call ',plist ,plist ,key ,new-value))
(defmacro plist-setf (plist key new-value)
"Automated setf of a key in a nested plist to set the location to the new-value."
(eval `(%plist-setf ,plist ,key ,new-value)))
;; the `eval` is needed to have an extra evaluation step here.
;; I am happy if someone can suggest a better alternative.
;; Or if someone can falsify its correctness here.
Some of the functions can be "explained" by some examples:
(defparameter *pl* (list :points 5 :a (list :b 1 :c (list :d 0 :e 1) :f 2)))
(defparameter *pl1* (list :points 5 :a (list :b 1 :c (list :d 0 :e 1) :f 2 :e 3 :g (list :h 1 :e 1))))
(get-plist-path *pl1* :e)
;; => ((:A :C :E) (:A :E) (:A :G :E))
(construct-entire-call '*pl1* *pl1* :e 3)
;; (PROGN
;; (SETF (GETF (GETF (GETF *PL1* :A) :C) :E) 3)
;; (SETF (GETF (GETF *PL1* :A) :E) 3)
;; (SETF (GETF (GETF (GETF *PL1* :A) :G) :E) 3))
(%plist-setf *pl1* :e 3)
;; (PROGN
;; (SETF (GETF (GETF (GETF *PL1* :A) :C) :E) 3)
;; (SETF (GETF (GETF *PL1* :A) :E) 3)
;; (SETF (GETF (GETF (GETF *PL1* :A) :G) :E) 3))
Usage:
(defparameter *pl1* (list :points 5 :a (list :b 1 :c (list :d 0 :e 1) :f 2 :e 3 :g (list :h 1 :e 1))))
(macroexpand-1 '(plist-setf *pl1* :e 3))
;; (PROGN
;; (SETF (GETF (GETF (GETF *PL1* :A) :C) :E) 3)
;; (SETF (GETF (GETF *PL1* :A) :E) 3)
;; (SETF (GETF (GETF (GETF *PL1* :A) :G) :E) 3)) ;
;; T
*pl1*
;; => (:POINTS 5 :A (:B 1 :C (:D 0 :E 1) :F 2 :E 3 :G (:H 1 :E 1)))
;; after
(plist-setf *pl1* :e 3)
*pl1*
;; => (:POINTS 5 :A (:B 1 :C (:D 0 :E 3) :F 2 :E 3 :G (:H 1 :E 3)))
Or also:
(defparameter *pl* (list :points 5 :a (list :b 1 :c (list :d 0 :e 1) :f 2)))
(macroexpand-1 '(plist-setf *pl* :e 3))
;; (PROGN (SETF (GETF (GETF (GETF *PL* :A) :C) :E) 3)) ;
;; T
*pl*
;; => (:POINTS 5 :A (:B 1 :C (:D 0 :E 1) :F 2))
(plist-setf *pl* :e 3)
*pl*
;; => (:POINTS 5 :A (:B 1 :C (:D 0 :E 3) :F 2))
Related
I was trying to implement a function that deletes all common elements in two lists using Scheme.
Here is the function I wrote.
#| delete elem from lis|#
(define (delete ele lis)
(cond
((null? ele) lis)
((null? lis) '())
((equal? ele (car lis)) (cdr lis))
(else (cons (car lis) (delete ele (cdr lis))))
)
)
#|delete element from l1 which is in l2 |#
(define (remove l1 l2)
(if(null? l2) l1
(if(null? l1) '()
(remove (delete (car l2) l1) (cdr l2)) )))
(define (remove-common l1 l2)
(list (remove l1 l2) (remove l2 l1)))
The function works well for some inputs, but some didn't work well. How can I fix my code to remove all the common elements in two lists?
(remove-common '(1 2) '(2 4)) #| output : ((1) (4))|#
(remove-common '(1 3) '(2 4)) #| output :((1 3) (2 4)) |#
I expected
(remove-common '(1 2 3) '(1 2 2 3 4))
to yield (() 4), removing the 1s, 2s, and 3s from each list because those are common to both. But the actual result is (() (2 4)).
I'm using R5RS for Scheme.
You're almost there. As #Shawn says, the problem is with the function delete. What you're trying to write here is a filter function.
For this there are two cases:
Keep value. For (filter x xs), cons x onto the front of (filter xs)
Lose value. Just move to (filter xs)
Your delete function correctly handles case 1, but not case 2.
The delete function should be:
#| delete elem from lis|#
(define (delete ele lis)
(cond
((null? ele) lis)
((null? lis) '())
((equal? ele (car lis)) (delete ele (cdr lis))) ; amendment
(else (cons (car lis) (delete ele (cdr lis))))
)
)
> (remove-common '(1 2 3) '(1 2 2 3 4))
(() (4))
I do the following code to retrieve only the keys of a plist:
(loop :for (key nil) :on config :by #'cddr
:collect key))
Running this produces:
CONFIG-TEST> (loop :for (key nil) :on '(:foo 1 :bar 2) :by #'cddr
:collect key)
(:FOO :BAR)
Is there a more 'functional' way to do this than using LOOP?
Not really...
CL-USER 35 > (let ((? nil))
(mapcon (lambda (l)
(when (setf ? (not ?))
(list (first l))))
'(:foo 1 :bar 2)))
(:FOO :BAR)
or maybe:
(defun mapncar (fn list &key (start 0) (n 1))
(loop for l = (nthcdr start list) then (nthcdr n l)
while l
collect (funcall fn (first l))))
CL-USER 61 > (mapncar #'identity '(a 1 b 2 c 3) :n 2)
(A B C)
CL-USER 62 > (mapncar #'identity '(a 1 b 2 c 3) :start 1 :n 2)
(1 2 3)
Using the SERIES package, scan-plist returns two series, one for the keys, the other for values:
(scan-plist '(:a 3 :b 2))
=> #Z(:A :B)
#Z(3 2)
You can rely on this to collect the first series as a list:
(collect 'list (scan-plist '(:a 3 :b 2)))
More generally, you may want to process the values in some way, so you would use mapping. For example, here is a plist-alist made with SERIES:
(defun plist-alist (plist)
(collect 'list
(mapping (((k v) (scan-plist plist))) (cons k v))))
What stylistic direction would do take us?
CL-USER> (do ((result (list) (cons (car plist) result))
(plist '(:foo 1 :bar 2) (cddr plist)))
((null plist) (reverse result)))
(:FOO :BAR)
By the way, I'd write the loop with less syntax, will this bite me?
CL-USER> (loop for key in '(:foo 1 :bar 2) by 'cddr
collecting key)
(:FOO :BAR)
If you are sure that none of the values are of type symbol, you could filter for symbols:
(remove-if-not #'symbolp '(:a 1 :b 2)) ;;=> (:A :B)
Much less efficient, but universersal:
filter for symbolp and getf-ability
(Only keys of a plist are getf-able from the plist, thus this is the check whether it is a key or not. However, a check, whether an element in a plist is symbolp is cheaper and removes most of the non-key values,
thus saving time and cost).
(defun get-plist-keys (plist)
(remove-if-not #'(lambda (x) (and (symbolp x) (getf plist x))) plist))
(get-plist-keys '(:a 1 :b 2 :c :d))
;; => (:A :B :C)
(ql:quickload :alexandria)
(mapcar #'car (alexandria:plist-alist '(:a 1 :b 2)))
;; => (:A :B)
To remove dependency of alexandria, define yourself plist-alist:
(defun plist-alist (l &optional (acc '()))
(cond ((null l) (nreverse acc))
(t (plist-alist (cddr l) (cons (cons (car l) (cadr l)) acc)))))
However, dependency on :alexandria should not be counted as dependency.
directly
Actyally, one could change plist-alist definition to obtain only the keys:
(defun plist-keys (l &optional (acc '()))
(cond ((null l) (nreverse acc))
(t (plist-keys (cddr l) (cons (car l) acc)))))
And likewise the values:
(defun plist-vals (l &optional (acc '()))
(cond ((null l) (nreverse acc))
(t (plist-vals (cddr l) (cons (cadr l) acc)))))
With the Serapeum library, which I consider as a second must-have just after Alexandria: use plist-keys :)
(serapeum:plist-keys '(:a 1 :b 2))
;; (:A :B)
https://github.com/ruricolist/serapeum/blob/master/REFERENCE.md#plist-keys-plist
Here's its implementation:
(defun plist-keys (plist)
"Return the keys of a plist."
(collecting*
(doplist (k v plist)
(collect k))))
It also has plist-values.
This situation is quite tricky to reproduce. First I create a clj file containing:
(ns myns)
(defn myfn [x] x)
Then I create a second clj file containing:
(ns myns2
(:require [myns :as m]
[clojure.repl :as repl]))
(comment
(second (iterate repl/source-fn 'm/myfn))
(take 2 (iterate repl/source-fn 'm/myfn))
)
Then I start a REPL and load the second file in that. Finally I evaluate both comments by sending them to the REPL. The first expression will yield "(defn myfn [x] x)" as expected. However the second expression yields '(m/myfn nil). What is going on here?
Note that fully qualifying 'm/myfn as 'myns/myfn restores matching behavior. Also I understand that iterating source-fn is kinda wacky, but it's the simplest way I know to reproduce the behavior.
I don't understand your results. Running from a file via lein test, I am getting different results:
(newline)
(def iii (iterate inc 0))
(spyx (nth iii 0))
(spyx (nth iii 1))
(spyx (nth iii 2))
(defn foo [x] 42)
(def bar (repl/source-fn 'foo))
(newline)
(spyx bar)
(newline)
(spyx (take 1 (iterate repl/source-fn 'foo)))
(spyx (take 2 (iterate repl/source-fn 'foo)))
(newline)
(spyx (first (iterate repl/source-fn 'foo)))
(spyx (second (iterate repl/source-fn 'foo)))
with results:
(nth iii 0) => 0
(nth iii 1) => 1
(nth iii 2) => 2
bar => "(defn foo [x] 42)"
(take 1 (iterate repl/source-fn (quote foo))) => (foo)
(take 2 (iterate repl/source-fn (quote foo))) => (foo "(defn foo [x] 42)")
(first (iterate repl/source-fn (quote foo))) => foo
(second (iterate repl/source-fn (quote foo))) => "(defn foo [x] 42)"
(defun filter-numbers-rec (inlist)
"This function filters out non-numbers from its input list and returns
the result, a list of numbers"
(cond
((not (listp inlist))
(princ "Argument must be a list")
(terpri)
())
((null inlist)
())
((not (numberp (car inlist)))
(filter-numbers-rec (cdr inlist)))
(t
(cons (car inlist)
(filter-numbers-rec (cdr inlist))))))
Well, the description of what the function does is that you want to remove each thing from the the list if it is not a number, so a good candidate here is remove-if-not, which you would use as follows:
(remove-if-not 'numberp '(1 a 2 b 3 c #\x (y 4)))
;=> (1 2 3)
If, for some reason, you want to write this in a way that (might) not use recursion, you could use do:
(do ((list '(1 a 2 b 3 c #\x (y 4)) (rest list))
(result '()))
((endp list) (nreverse result))
(when (numberp (car list))
(push (car list) result)))
;=> (1 2 3)
If you don't like the wordiness of do, you can use loop:
(loop :for x :in '(1 a 2 b 3 c #\x (y 4))
:when (numberp x)
:collect x)
;=> (1 2 3)
In a project I'm working on I came across an interesting problem that I'm curious about other solutions for. I'm in the middle of reading "The Little Schemer" so I'm trying out some recursion techniques. I'm wondering if there is another way to do this with recursion and also interested if there is an approach without using recursion.
The problem is to take a sequence and partition it into a seq of seqs by taking every nth element. For example this vector:
[ :a :b :c :d :e :f :g :h :i ]
when partitioned with n=3 would produce the seq
((:a :d :g) (:b :e :h) (:c :f :i))
and with n=4:
((:a :e :i) (:b :f) (:c :g) (:d :h))
and so on. I solved this using two functions. The first creates the inner seqs and the other pulls them together. Here are my functions:
(defn subseq-by-nth
"Creates a subsequence of coll formed by starting with the kth element and selecting every nth element."
[coll k n]
(cond (empty? coll) nil
(< (count coll) n) (seq (list (first coll)))
:else (cons (nth coll k) (subseq-by-nth (drop (+ n k) coll) 0 n))))
(defn partition-by-nth
""
([coll n]
(partition-by-nth coll n n))
([coll n i]
(cond (empty? coll) nil
(= 0 i) nil
:else (cons (subseq-by-nth coll 0 n) (partition-by-nth (rest coll) n (dec i))))))
I'm not completely happy with the partition-by-nth function having multiple arity simply for the recursion, but couldn't see another way.
This seems to work just fine with all the test cases. Is this a decent approach? Is it too complicated? Is there a way to do this without recursion or maybe in a single recursive function?
Thanks for the suggestions. I'm new to both Clojure and Lisp, so am picking up the different techniques as I go.
I expect there is a simpler recursive definition which is more in the spirit of The Little Schemer, but the following function using take-nth is quite a bit more compact, since you said you were interested in alternative approaches:
(defn chop [coll n]
(for [i (range n)]
(take-nth n (drop i coll))))
which satisfies your examples:
(chop [:a :b :c :d :e :f :g :h :i ] 3)
;= ((:a :d :g) (:b :e :h) (:c :f :i))
(chop [:a :b :c :d :e :f :g :h :i ] 4)
;= ((:a :e :i) (:b :f) (:c :g) (:d :h))
In Clojure, the built in libraries will get you surprisingly far; when that fails, use an explicitly recursive solution. This version is also lazy; you'd probably want to use lazy-seq or loop...recur in any "longhand" (explicitly recursive) version to handle large datasets without blowing the stack.
I have to offer this Common Lisp loop:
(defun partition-by-nth (list n)
(loop :with result := (make-array n :initial-element '())
:for i :upfrom 0
:and e :in list
:do (push e (aref result (mod i n)))
:finally (return (map 'list #'nreverse result))))
Edited because the original answer totally missed the point.
When I first saw this question I thought clojure.core function partition applied (see
ClojureDocs page).
As Dave pointed out partition only works on the elements in the original order. The take-nth solution is clearly better. Just for the sake of interest a combination of map with multiple sequences derived from partition kind-of works.
(defn ugly-solution [coll n]
(apply map list (partition n n (repeat nil) coll)))
(ugly-solution [:a :b :c :d :e :f :g :h :i] 3)
;;=> ((:a :d :g) (:b :e :h) (:c :f :i))
(ugly-solution [:a :b :c :d :e :f :g :h :i] 4)
;;=> ((:a :e :i) (:b :f nil) (:c :g nil) (:d :h nil))