Recur on children in an object hierarchy in Clojure - clojure

I have the following problem:
(def relations1
'((child-of peter carl)
(child-of carl herb)
(peter x 0 y 0 age 6)
(carl x 1 y 1 age 36)
(herb x 2 y 2 age 66)))
If a parent moves then the child is moved by the same distance, so if the new relations state that herb and peter have moved, then i want to update the children that are not present in relation2 by the same offset, but those that are present I will leave them alone. So in the next phase:
(def relations2
'((herby2 x 3 y 2.5 age 66)
(pete2 x 0 y 0 age 6)))
I have first matched relations1 with those in relation2:
(def matches
'( ((herb x 2 y 2 age 66)
(herb2 x 3 y 2.5 age 66)),
((peter x 0 y 0 age 6)
(peter2 x 0 y 0 age 6))))
I want to go through the matched ones, update their own new positions (while keeping their prev names and age) and recursively check if they have any children to update their positions as well. I tried it but got pretty much stuck on how to recurse on the children too:
(def update-parents [matches, relations1]
(loop [rest matches
all relations1
result ()]
(if (empty? rest)
result
(let [[head & others] rest
r1 (first head)
r2 (second head)
exists (map first r2)
children (map second (filter #(and (= (first r1) (last %)) (= 'child-of (first %))) all))]
(if (some #(= (first r1) %) exists)
(recur others (concat (update r1 r2) (recur ???)); if it is already there, update position and its children's
; if it's not there, then ignore
)
So the end result should be this
(def result
'((herb x 3 y 2.5 age 66)
(peter x 0 y 0 age 6)
(carl x 2 y 1.5 age 36) ))
I have two main issues:
children returns a list of children, so i need to filter relations1 by those that are in this list
how do i recur on the children? do I need to use another loop?

You can remove things from a list (i.e., make a new list without those things) by putting the things-to-remove into a set and using (remove #(contains? the-set %) the-list) or, more idiomatically, (remove the-set the-list) because a set operates as a function. ("Filtering" works likewise but keeps the things the predicate agrees to.)
The loop...recur special form will recur only from tail position, which could be a challenge for the given problem. But if you don't require tail-call optimization, a function may simply call itself.
In any case, if you want to use recursion of any kind, you want a tree-shaped data structure in which every node is similar to the root. The "bag of facts" in relation1 will be hard to work with.
Check out clojure.walk and clojure.zip as canned solutions for tree data structures.
P.S. It might also help to work at a REPL, in a "bottom up" way, tackling the ingredients before the casserole as it were.

Related

Creating a sequence of all values in Clojure

I'm currently working on a kata code challenge and it comes with a few requirements:
The number u(0) = 1 is the first one in u.
For each x in u, then y = 2 * x + 1 and z = 3 * x + 1 must be in u too.
There are no other numbers in u.
I have constructed a few functions:
(defn test2 [x n orgN] ;;x is a counter, n is what I want returned as a list
(println n)
(println "this is x: " x)
(cons n (if (not= x (- orgN 1 ))
(do (test2 (+ x 1) (+ 1 (* n 2)) orgN)
(test2 (+ x 1) (+ 1 (* n 3)) orgN))
nil)
))
(defn test2helper [n]
(def x 1)
(test2 x x n)
)
(test2helper 5)
However this only returns (1 4 13 40) and misses a whole bunch of values in between. Cons is only constructing a list based on the last 3n+1 algorithm and not picking up any other values when I want instead a sequence of the two values generated from each n value repeated. My question is is there a way to construct a sequence of all the values instead of just 4 of them?
https://www.codewars.com/kata/twice-linear/train/clojure
This solution is pretty close to being correct. But remember that do is for performing side effects, not for producing values. Specifically, (do x y) returns y after performing the side effects in x. But test2 does not have any side effects: it just returns a list. What you are looking for is instead (concat x y), a function which concatenates two lists together into a larger list.
Although Alan Malloy's solution answers your question, it does not solve the problem you refer to, which requires that the sequence is generated in increasing order.
My approach would be to generate the sequence lazily, according to the following pattern:
(defn recurrence [f inits]
(map first (iterate f inits)))
For example, you can define the Fibonacci sequence like this:
(defn fibonacci []
(recurrence (fn [[a b]] [b (+ a b)]) [1 1]))
=> (take 10 (fibonacci))
(1 1 2 3 5 8 13 21 34 55)
The sequence you need is harder to generate. Good hunting!

How to generate all the permutations of elements in a list one at a time in Lisp?

I already have the code to generate all the permutations for a list of elements. However, I realized that if I want to manipulate the lists that are generated, I would need to traverse this list. This list can be potentially massive and therefore expensive to keep. I wanted to know if there was a way to generate the permutations by each call so that I can check if the list matches with what I need and if not I will generate the next permutation. (Each time the function will return a list one at a time.)
My code:
(defun allPermutations (list)
(cond
((null list) nil)
((null (cdr list)) (list list))
(t (loop for element in list
append (mapcar (lambda (l) (cons element l))
(allPermutations (remove element list)))))))
General principle
Suppose you have the following range function:
(defun range (start end &optional (step 1))
(loop for x from start below end by step collect x))
You can accept another parameter, a function, and call it for each element:
(defun range-generator (callback start end &optional (step 1))
(loop for x from start below end by step do (funcall callback x)))
This gives the caller control over the iteration process:
(block root
(range-generator (lambda (v)
(print v)
(when (>= v 10)
(return-from root)))
0 300))
0
1
2
3
4
5
6
7
8
9
10
See RETURN, BLOCK.
Permutations
If you want to avoid allocating too much memory, you can arrange for your code to allocate intermediate data-structures once and reuse them for each call to the callback. Here is an annotated example:
(defun permutations% (list callback)
(when list
(let* (;; Size of input list
(size (length list))
;; EMPTY is a sentinel value which is guaranteed to
;; never be equal to any element from LIST.
(empty (gensym "SENTINEL"))
;; Working vector containing elements from LIST, or
;; EMPTY. This vector is mutated to remember which
;; element from the input LIST was already added to the
;; permutation.
(items (make-array size :initial-contents list))
;; Working vector containing the current
;; permutation. It contains a FILL-POINTER so that we
;; can easily call VECTOR-PUSH and VECTOR-POP to
;; add/remove elements.
(permutation (make-array (length items) :fill-pointer 0)))
;; Define a local recursive function named POPULATE, which
;; accepts a COUNT argument. The count starts at SIZE and
;; decreases at each recursive invocation, allowing the
;; function to know when it should end.
(labels ((populate (count)
(if (plusp count)
;; Loop over ITEMS by index
(dotimes (item-index size)
(let ((item (svref items item-index)))
;; We found an ITEM which is not yet
;; present in PERMUTATION.
(unless (eq item empty)
;; Push that element
(vector-push item permutation)
;; Replace current value in ITEMS by EMPTY
(setf (svref items item-index) empty)
;; POPULATE will recursively populate
;; the remaining elements in
;; PERMUTATION and call CALLBACK. Once
;; it is done, it will return here.
(populate (1- count))
;; There are other items to process in
;; current loop. Reset the state to how
;; it was before calling POPULATE.
;; Replace the EMPTY value by the
;; original ITEM at current index.
(setf (svref items item-index) item)
;; Remove ITEM from PERMUTATION.
(vector-pop permutation))))
;; We filled PERMUTATION with SIZE elements.
;; Call CALLBACK with PERMUTATION. Note: the
;; callback function is always given the same
;; vector, but its content changes over
;; time. The value passed to CALLBACK is thus
;; valid only during the time we are
;; executing CALLBACK. If the caller needs to
;; keep a copy of the current permutation, it
;; should COPY-LIST the value.
(funcall callback permutation))))
;; Initiate recursive function with current SIZE.
(populate size)))))
The function accepts a list and a callback, which is a function accepting one parameter, the current permutation. Note that this parameter is valid only during the dynamic extent of the call, because once the call returns, the same data-structure that was passed to the callback is modified.
As explained above, you can call any function, in particular closure which refers to other variable in the lexical environment. Here, the anonymous lambda increment the count variable, which allows to count the number of permutations, without storing them in a list and getting the size of the list:
(time
(let ((count 0))
(permutations% '(a b c d e f g h i j k) (lambda (p) (incf count)))
count))
=> 39916800
Evaluation took:
6.455 seconds of real time
6.438200 seconds of total run time (6.437584 user, 0.000616 system)
99.74% CPU
17,506,444,509 processor cycles
0 bytes consed
In the above report, 0 bytes consed represents the approximate number of memory allocated (not counting stack allocation).
You can also offer a safer version of the function which copies each permutation before sending it to the callback function.
(defun permutations (list callback)
(permutations% list (lambda (permutation)
(funcall callback (coerce permutation 'list)))))
See also
See also the answer from Will Ness, which manages to handle the set of remaining elements with a list, thus avoiding the need to filter through EMPTY elements.
Here's a way (following the code structure by #coredump from their answer; runs about 4x faster on tio.run):
(defun permutations (list callback)
(if (null list)
(funcall callback #())
(let* ((all (cons 'head (copy-list list))) ; head sentinel FTW!
(perm (make-array (length list))))
(labels
((g (p i &aux (q (cdr p))) ; pick all items in arbitrary order:
(cond
((cdr q) ; two or more items left:
(loop while q do ; for each item in q:
(setf (svref perm i) (car q)) ; grab the item
(rplacd p (cdr q)) ; pluck it out
(g all (1+ i)) ; get the rest!
(rplacd p q) ; then, put it back
(pop p) ; and advance
(pop q))) ; the pointers
(T ; one last item left in q:
(setf (svref perm i) (car q)) ; grab the last item
(funcall callback perm))))) ; and call the callback
(g all 0)))))
Testing:
; [20]> (permutations '(1 2 3) #'(lambda (x) (princ x) (princ #\ )))
; #(1 2 3) #(1 3 2) #(2 1 3) #(2 3 1) #(3 1 2) #(3 2 1)
; [58]> (let ((acc (list))) (permutations '(1 2 3) #'(lambda (x)
; (push (coerce x 'list) acc))) (reverse acc))
; ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
; [59]> (let ((acc (list))) (permutations '() #'(lambda (x)
; (push (coerce x 'list) acc))) (reverse acc))
; (NIL)
This uses recursion to build the n nested loops computational structure for the n-long input list, at run time, with the fixed i = 0, 1, ..., n-1 in each nested loop being the position in the result-holding permutation array to put the picked item into. And when all the n positions in the array are filled, once we're inside the innermost loop (which isn't even a loop anymore as it has just one element left to process), the user-supplied callback is called with that permutation array as its argument. The array is reused for each new permutation.
Implements the "shrinking domains" paradigm as in this high-level pseudocode with list splicing and pattern matching:
perms [] = [[]]
perms xs = [[x, ...p]
FOR [as, [x, ...bs]] IN (splits xs) -- pluck x out
FOR p IN perms [...as, ...bs]] -- and recurse
(where splits of a list produces all possible pairs of its sublists which, appended together, reconstitute the list; in particular, splits [] = [ [[],[]] ] and splits [1] = [ [[],[1]] , [[1],[]] ]); or, in a simple imperative pseudocode,
for item1 in list:
domain2 = remove item1 from list by position
for item2 in domain2:
domain3 = remove item2 from domain2 by position
for item3 in domain3:
......
......
for item_n in domain_n:
(callback
(make-array n :initial-contents
(list item1 item2 ... item_n)))
but in the real code we do away with all the quadratic interim storage used by this pseudocode, completely, by surgically manipulating the list structure. About the only advantage of the linked lists is their O(1) node removal capability; we might as well use it!
update: special-casing the last two elements of a permutation as well (by unrolling the last loop into the corresponding two calls to the callback) gives about ~ 1.5x additional speedup.
(In case the TIO link ever rots, here's a pastebin with the working code, or a github gist.)
update: this technique is known as recursive-backtracking, creating the n nested loops backtracking computational structure by recursion.

ArityException Wrong number of args (0) passed to: core/max

If I run this code, I will get an error "ArityException Wrong number of args (0) passed to: core/max"
(apply max (filter #(zero? (mod % 7)) (range 1 3)))
However, if I run this code
(apply max (filter #(zero? (mod % 7)) (range 1 10)))
then I get the result 7.
Is there anyone who can help me to figure out this problem?
(filter #(zero? (mod % 7)) (range 1 3))
this, produces an empty sequence.
However, max must be called with at least one argument. When you apply an empty sequence to it, it's called with zero arguments, and this produces the arity exception.
You could do something like this:
(defn my [a b]
(let [result (filter #(zero? (mod % 7)) (range a b))]
(if (zero? (count result))
nil ; or 0 or.. whatever
(apply max result))))
apply and reduce
Because the question came up, here's a short explanation of the difference between apply and reduce.
They are two totally different concepts, however, in the following case both do the same job when combined with max.
let xs be any collection of numbers.
(apply max xs) equals (reduce max xs)
apply
Usually functions are called with a number of arguments, so one can call max like so: (max 3), or (max 5 9), or (max 4 1 3) ... As noticed before: just (max) would be an arity exception.
Apply however, lets someone call a function passing the arguments in the form of a collection. So in correspondence to the last example, the following is possible: (apply max [3]), or (apply max [5 9]), or (apply max [4 1 3]) ... Just (apply max []) or even (apply max) would lead to the same arity exception as above. This is useful in many cases.
reduce
Reduce in contrast is a bit trickier. Along with map and filter it's absolutely essential for functional programming languages like Clojure.
The main idea of reduce is to walk through a collection, in each step desired information from the current item is processed and added to a memo or accumulator.
Say, one wants to find out the sum of all numbers in a collection.
Let xs be [3 4 5 23 9 4].
(reduce + xs) would do the job.
more explicitly one could write: (reduce (fn [memo value] (+ memo value)) xs)
The function which is passed as the first argument to reduce expects two parameters: The first one is the memo, the second one the value of the current item in the collection. The function is now called for each item in the collection. The return value of the function is saved as the memo.
Note: that the first value of the collection is used as an initial value of the memo, hence the iteration starts with the second value of the collection. Here's what it is doing:
(+ 3 4) ; memo is 7 now
(+ 7 5) ; memo is 12 now
(+ 12 23) ; memo is 35 now
(+ 35 9) ; memo is 44 now
(+ 44 4) ; memo is 48 now
(There's also a way to specify the start value of the memo, see clojuredocs.org for more details)
This works equally with max. In each iteration the value of the current item is compared with the memo. Each time the highest value is saved to the memo: Hence the memo in this case represents the "maximum value until now".
So (reduce max [4 1 3 5 2]) is calculated like this:
(max 4 1) ; memo is 4
(max 4 3) ; memo is 4
(max 4 5) ; memo is 5
(max 5 2) ; memo is 5
so?
Which one to use now? It showed that there's not really a notable difference in the time that (reduce max (range 100000000)) and (apply max (range 100000000)) take. Anyways, the apply solution looks easier to me, but that's just my opinion.
There are no numbers divisible by 7 between 1 and 3, the result of filter in your first example returns an empty sequence, which means that the first example if calling (apply max []) which is the same as calling (max). max requires at least one parameter, hence the ArityException.
A couple of options to fix it:
(last (filter #(zero? (mod % 7)) (range 1 3))
or
(if-let [by-7 (seq (filter #(zero? (mod % 7)) (range 1 3)))]
(apply max by-7)
nil ;; or whatever value in case the collection is empty
)
According to the error message, the number of arguments that are passed to max is 0, and that is wrong. I guess it makes sense because it's impossible to compute the maximum for an empty list.
The reason why max gets no arguments is that there are no numbers divisible by 7 between 1 and 3.

find all subsets of an integer collection that sums to n

i'm trying to find a function that, given S a set of integer and I an integer, return all the subsets of S that sum to I
is there such a function somewhere in clojure-contrib or in another library ?
if no, could anyone please give me some hints to write it the clojure way?
Isn't this the subset sum problem, a classic NP-complete problem?
In which case, I'd just generate every possible distinct subset of S, and see which subsets sums to I.
I think it is the subset sum problem, as #MrBones suggests. Here's a brute force attempt using https://github.com/clojure/math.combinatorics (lein: [org.clojure/math.combinatorics "0.0.7"]):
(require '[clojure.math.combinatorics :as c])
(defn subset-sum [s n]
"Return all the subsets of s that sum to n."
(->> (c/subsets s)
(filter #(pos? (count %))) ; ignore empty set since (+) == 0
(filter #(= n (apply + %)))))
(def s #{1 2 45 -3 0 14 25 3 7 15})
(subset-sum s 13)
; ((1 -3 15) (2 -3 14) (0 1 -3 15) (0 2 -3 14) (1 2 3 7) (0 1 2 3 7))
(subset-sum s 0)
; ((0) (-3 3) (0 -3 3) (1 2 -3) (0 1 2 -3))
These "subsets" are just lists. Could convert back to sets, but I didn't bother.
You can generate the subsets of a set like this:
(defn subsets [s]
(if (seq s)
(let [f (first s), srs (subsets (disj s f))]
(concat srs (map #(conj % f) srs)))
(list #{})))
The idea is to choose an element from the set s: the first, f, will do. Then we recursively find the subsets of everything else, srs. srs comprises all the subsets without f. By adding f to each of them, we get all the subsets with f. And together, that's the lot. Finally, if we can't choose an element because there aren't any, the only subset is the empty one.
All that remains to do is to filter out from all the subsets the ones that sum to n. A function to test this is
(fn [s] (= n (reduce + s)))
It is not worth naming.
Putting this together, the function we want is
(defn subsets-summing-to [s n]
(filter
(fn [xs] (= n (reduce + xs)))
(subsets s)))
Notes
Since the answer is a sequence of sets, we can make it lazier by changing concat into lazy-cat. map is lazy anyway.
We may appear to be generating a lot of sets, but remember that they share storage: the space cost of keeping another set differing by a single element is (almost) constant.
The empty set sums to zero in Clojure arithmetic.

Rewrite a list with defun in Lisp

I want to write a function which outputs a list.
The function gets a list and outputs a new one. For example:
(0 0 1 2 2 1) -> (3 4 4 5 5 6)).
What it does is: the index+1 in the initial list is a value in the new list. And the that value is placed x times in the new list dependent on the value in the initial list.
(1 2) -> (1 2 2)
(0 3 0 3) -> (2 2 2 4 4 4)
So 3 is on the second position, the value is three so 2(2nd position) is placed 3 times in the new list.
I came up with this, which does not work
(defun change-list (list)
(setq newlist '(1 2 3))
(setq i 0)
(while (<= i (length list))
(if (= (nth i list) 0)
(concatenate 'list '0 'newlist)
(concatenate 'list '(i) 'newlist))
(+ i 1)
(remove 0 newlist)))
The problem is mainly the fact that it does not recognize new variables. It gave me these errors:
functions.lisp:27:26:
warning: Undefined function referenced: while
functions.lisp:31:2:
warning: Free reference to undeclared variable newlist assumed special.
warning: Free reference to undeclared variable i assumed special.
Is there someone who understands this?
We were able to solve it ourselves:
(defun change-list (a)
(loop for j from 1 to (length a) by 1 append
(loop for i from 1 to (nth (- j 1) a) by 1
collect j )))
It is part of a larger assignment, and we did not get much education on lisp, more like: do it in lisp.
Let's assume this is Common Lisp, I'll then list some problems in your code:
(defun change-list (list)
(setq newlist '(1 2 3))
SETQ does not declare variables, it just sets them.
(setq i 0)
(while (<= i (length list))
WHILE does not exist in Common Lisp.
(if (= (nth i list) 0)
(concatenate 'list '0 'newlist)
0 is not a list. Thus you can't concatenate it.
CONCATENATE does not have a side effect. What ever you do here is lost.
NEWLIST here is a symbol, not a list. Does not work.
(concatenate 'list '(i) 'newlist))
i is not a variable here. Putting it into a list will have no.
CONCATENATE does not have a side effect. What ever you do here is lost.
NEWLIST here is a symbol, not a list. Does not work.
(+ i 1)
The effect of the above is lost.
(remove 0 newlist)
The effect of the above is lost.
))
You can simplify your answer to this:
(defun change-list (list)
(loop for i in list and j from 1
append (loop repeat i collect j)))
Basically, just another way to do the same thing:
(defun change-list (x)
(let ((index 0))
(mapcon
#'(lambda (y)
(incf index)
(let ((z (car y)))
(unless (zerop z)
(make-list z :initial-element index)))) x)))
But may be useful for the purpose of learning / who knows what your professor expects.