How to diff/substract two lists in Clojure - algorithm

Example:
1 1 1 3 3 4 4 5 5 6 L1
1 3 3 4 5 L2
1 1 4 5 6 Res
Constraints:
The diff/subtract is defined as the "set" of elements from L1 minus (∖) L2
L2 is always a subset (⊆) of L1
The elements in L1 and L2 can have duplicates
The elements are primitives (int, string) and all of the same type
(clojure.set/difference) doesn't help here because of (3).

(defn diff [s1 s2]
(mapcat
(fn [[x n]] (repeat n x))
(apply merge-with - (map frequencies [s1 s2]))))
For example, given
(def L1 [1 1 1 3 3 4 4 5 5 6])
(def L2 [1 3 3 4 5 ])
then
(diff L1 L2)
;(1 1 4 5 6)

Here is one way to do it.
Steps:
1.Find the frequencies for each list
2.Diff the frequencies
3.Repeat each element for the remaining value of frequency.
(defn myminus [s1 s2]
(let [g1 (frequencies s1)
g2 (frequencies s2)
m (merge-with - g1 g2)
r (mapcat #(repeat (second %) (first %)) m)]
r))

If inputs are in order, as they appear to be, then you can do this lazily
(defn sdiff
[[x & rx :as xs] [y & ry :as ys]]
(lazy-seq
(cond
(empty? xs) nil
(empty? ys) xs
:else (case (compare x y)
-1 (cons x (sdiff rx ys))
0 (sdiff rx ry)
+1 (sdiff xs ry)))))
Given example:
(def L1 [1 1 1 3 3 4 4 5 5 6])
(def L2 [1 3 3 4 5])
(sdiff L1 L2) ;=> (1 1 4 5 6)
Lazy-sequence of numbers that are not Fibonacci numbers. (Notice we don't require constraint #2 -- the repeated 1's in the Fibonacci numbers do not cause a problem.)
(defn fibs [] (map first (iterate (fn [[c n]] [n (+ c n)]) [0 1])))
(take 20 (sdiff (range) (fibs)))
;=> (4 6 7 9 10 11 12 14 15 16 17 18 19 20 22 23 24 25 26 27)

Since L2 is always a subset of L1 you can group-by on both lists and just emit the key as many times as the difference is between the counts of each grouping.
(def L1 (list 1 1 1 3 3 4 4 5 5 6))
(def L2 (list 1 3 3 4 5 ))
(defn diff [l1 l2]
(let [a (group-by identity l1)
b (group-by identity l2)]
(mapcat #(repeat
(-
(count (second %))
(count (get b (key %))))
(key %)) a)))
(diff L1 L2)
;;(1 1 4 5 6)

(defn diff-subtract
"The diff-subtract is defined as the sum of elements from L1 minus L2"
[list1 list2]
(let [l1 (into {} (map #(vector (first %) %) (partition-by identity (sort list1))))
l2 (into {} (map #(vector (first %) %) (partition-by identity (sort list2))))]
(-> (map
#(repeat (- (count (l1 %)) (count (l2 %))) %)
(range 1 (inc (apply max (map first l1)))))
flatten)))
(diff-subtract [1 1 1 3 3 4 4 5 5 6] [1 3 3 4 5]) => (1 1 4 5 6)

Related

Is there a way of summing two vectors with different lengths in Scheme?

Am a beginner to Scheme a dialect of Lisp, am trying to implement a function sum-vector that takes two vectors of numbers as arguments and returns a vector with the sum of the corresponding elements of the input vectors.
I have tried the following code but i can't figure out how to sum two vectors with different lengths.
Here is my current code
#lang scheme
(define sum-vector
(lambda (vec-1 vec-2)
(let* ((len (vector-length vec-1))
(result (make-vector len)))
(do ((index 0 (+ index 1)))
((= index len) result)
(vector-set! result index
(+ (vector-ref vec-1 index)
(vector-ref vec-2 index)))))))
(sum-vector (vector 4 6 8 3) (vector 5 6 7))
When i run the above code it works perfectly for vectors with same lengths e.g (sum-vector (vector 4 6 8) (vector 5 6 7)) returns #(9 12 15) I want it to work similarly for different lengths e.g (sum-vector (vector 4 6 8 3) (vector 5 6 7)) should return #(9 11 15 3) but i can't figure out the logic for doing that.
One possible solution is to append zeros to each vector to make their lengths equal and then use vector-map:
(define (zero-vector len)
(make-vector len 0))
(define (append-zeros vec max-len)
(vector-append vec (zero-vector (- max-len (vector-length vec)))))
(define (sum-vector v1 v2)
(let ((max-len (max (vector-length v1)
(vector-length v2))))
(vector-map +
(append-zeros v1 max-len)
(append-zeros v2 max-len))))
Tests:
> (sum-vector (vector 1 2 3) (vector 1 2 3 4 5 6))
'#(2 4 6 4 5 6)
> (sum-vector (vector) (vector 1 2 3 4 5 6 7 8))
'#(1 2 3 4 5 6 7 8)
Another, Racket-specific way.
Racket has something called comprehensions, which allow for easy iteration over containers. In particular, for/vector returns a vector of the results:
> (define v1 (vector 4 6 8 3))
> (define v2 (vector 5 6 7))
> (for/vector ([e1 v1] [e2 v2]) (+ e1 e2))
'#(9 12 15)
Note that the resulting vector is the length of the shortest container being iterated over. You can tell it to produce a vector of a given length, though:
> (for/vector #:length (vector-length v1) ([e1 v1] [e2 v2]) (+ e1 e2))
'#(9 12 15 0)
It fills in the extra elements with 0. Combine that with vector-copy!, which copies a range of elements from one vector to another at given offsets to copy the extra elements from the larger vector to the smaller (Or do nothing if they're the same length), and you get:
(define (sum-vector v1 v2)
(let ([sum-helper
(lambda (short long)
(let ([result (for/vector #:length (vector-length long)
([e1 short] [e2 long])
(+ e1 e2))])
(vector-copy! result (vector-length short)
long (vector-length short) (vector-length long))
result))])
(if (< (vector-length v1) (vector-length v2))
(sum-helper v1 v2)
(sum-helper v2 v1))))
Examples:
> (sum-vector (vector 4 6 8 3) (vector 5 6 7))
'#(9 12 15 3)
> (sum-vector (vector 1 2 3) (vector 1 2 3 4 5 6))
'#(2 4 6 4 5 6)
> (sum-vector (vector) (vector 1 2 3 4 5 6 7 8))
'#(1 2 3 4 5 6 7 8)

Racket: sliding window over a vector

What are some good ways to perform a sliding window over a finite sequence in Racket, such as finding the highest sum of any sub-sequence of 4 numbers?
(define example #(3 1 4 5 10 23 1 50 0 12 40 12 43 20))
First find prefix sums:
#lang racket
(define example #(3 1 4 5 10 23 1 50 0 12 40 12 43 20))
(define-values (sums sum)
(for/fold ([sums '()] [sum 0]) ([x example])
(values (cons sum sums) (+ sum x))))
(list->vector (cons sum sums))
Result:
'#(224 204 161 149 109 97 97 47 46 23 13 8 4 3 0)
Then ... profit.
Where profit could be this:
#lang racket
(define example #(3 1 4 5 10 23 1 50 0 12 40 12 43 20))
(define (prefix-sums xs)
(define-values (sums sum)
(for/fold ([sums '()] [sum 0]) ([x xs])
(values (cons sum sums) (+ sum x))))
(list->vector (reverse (cons sum sums))))
(define (sum4 xs i)
(- (vector-ref xs (+ i 4))
(vector-ref xs i)))
(define (sum4s xs)
(for/list ([i (- (vector-length xs) 4)])
(sum4 (prefix-sums xs) i)))
(apply max (sum4s example))
For a more generic approach, here's a sequence constructor that returns a sliding window of len elements from a vector, len values at a time, which can then be used with for comprehensions:
(define (in-vector-window v len)
(make-do-sequence
(lambda ()
(values
(lambda (i) (vector->values v i (+ i len)))
add1
0
(lambda (i) (<= (+ i len) (vector-length v)))
#f
#f))))
And some example usages:
> (for/list ([(a b c d) (in-vector-window example 4)]) (list a b c d))
'((3 1 4 5) (1 4 5 10) (4 5 10 23) (5 10 23 1) (10 23 1 50) (23 1 50 0) (1 50 0 12) (50 0 12 40) (0 12 40 12) (12 40 12 43) (40 12 43 20))
> (define sums (for/list ([(a b c d) (in-vector-window example 4)]) (+ a b c d)))
> (foldl max (car sums) (cdr sums))
115

Kadane's Algorithm in Scheme (Racket)

I understand the logic behind how Kadane's Algorithm (maximum sum of all sequential sub-arrays in an array) works in "pseudo-code," and I'm sure I could implement it as a function in C or C++. However, I'm trying to implement it using lists in Scheme (Racket; the file extension is .rkt), which I have no experience with.
The end result I'm looking for is...
Input: (maxsum `(1 4 -2 1))
Output: 5
So far I've developed two helper functions I may be able to use within the maxsum function.
(1) size: returns the number of elements in a list.
(define size
(lambda (list)
(cond
[(not (list? list)) 0]
[(null? list) 0]
[else (+ 1 (size (cdr list)))]
)
)
)
(2) sum: returns the sum of all elements in a list.
(define sum
(lambda (list)
(cond
[(not (list? list)) 0]
[(null? list) 0]
[else (+ (car list) (sum (cdr list)))]
)
)
)
How would I go about defining/designing the maxsum function?
Here is a version patterned after the Phyton code on wikipedia:
(define (maxsum lst)
(define (aux lst max-ending-here max-so-far)
(if (null? lst)
max-so-far
(let ((new-max-ending-here (max 0 (+ (car lst) max-ending-here))))
(aux (cdr lst) new-max-ending-here (max max-so-far new-max-ending-here)))))
(aux lst 0 0))
(maxsum '(1 4 -2 1)) ; => 5
(maxsum '(-2 1 -3 4 -1 2 1 -5 4)) ; => 6
It is tail recursive, so it will be compiled into an efficient iterative program.
Almost literal translation of [Python code][1] to Racket:
(define (max_subarray A)
(define-values (max_ending_here max_so_far) (values 0 0))
(for ((x (in-list A)))
(set! max_ending_here (max 0 (+ max_ending_here x)))
(set! max_so_far (max max_so_far max_ending_here)))
max_so_far)
Testing:
(max_subarray `(1 4 -2 1))
(max_subarray '(-2 1 -3 4 -1 2 1 -5 4))
Output:
5
6
Please note that recursive functions are generally preferred over iterative ones in Racket and use of "set!" is discouraged here.
Following uses higher functions like apply and map for different steps:
(define (maxsum lst)
(define subarrays
(for*/list ((start (length lst))
(len (range 1 (- (add1(length lst)) start))))
(take (drop lst start) len)))
(define sumlist (map (λ (x) (apply + x)) subarrays))
(apply max sumlist))
Following is more verbose form:
(define (maxsum lst)
(define subarrays
(for*/list ((start (length lst))
(len (range 1 (- (add1(length lst)) start))))
(take (drop lst start) len)))
(displayln "\n----- SUBARRAYS ---------")
(displayln subarrays)
(define sumlist (map (λ (x) (apply + x)) subarrays))
(displayln "----- SUMS OF SUBARRAYS ---------")
(displayln sumlist)
(display "MAX SUM:")
(apply max sumlist))
Testing:
(maxsum `(1 4 -2 1))
(maxsum '(-2 1 -3 4 -1 2 1 -5 4))
Output:
----- SUBARRAYS ---------
((1) (1 4) (1 4 -2) (1 4 -2 1) (4) (4 -2) (4 -2 1) (-2) (-2 1) (1))
----- SUMS OF SUBARRAYS ---------
(1 5 3 4 4 2 3 -2 -1 1)
MAX SUM:5
----- SUBARRAYS ---------
((-2) (-2 1) (-2 1 -3) (-2 1 -3 4) (-2 1 -3 4 -1) (-2 1 -3 4 -1 2) (-2 1 -3 4 -1 2 1) (-2 1 -3 4 -1 2 1 -5) (-2 1 -3 4 -1 2 1 -5 4) (1) (1 -3) (1 -3 4) (1 -3 4 -1) (1 -3 4 -1 2) (1 -3 4 -1 2 1) (1 -3 4 -1 2 1 -5) (1 -3 4 -1 2 1 -5 4) (-3) (-3 4) (-3 4 -1) (-3 4 -1 2) (-3 4 -1 2 1) (-3 4 -1 2 1 -5) (-3 4 -1 2 1 -5 4) (4) (4 -1) (4 -1 2) (4 -1 2 1) (4 -1 2 1 -5) (4 -1 2 1 -5 4) (-1) (-1 2) (-1 2 1) (-1 2 1 -5) (-1 2 1 -5 4) (2) (2 1) (2 1 -5) (2 1 -5 4) (1) (1 -5) (1 -5 4) (-5) (-5 4) (4))
----- SUMS OF SUBARRAYS ---------
(-2 -1 -4 0 -1 1 2 -3 1 1 -2 2 1 3 4 -1 3 -3 1 0 2 3 -2 2 4 3 5 6 1 5 -1 1 2 -3 1 2 3 -2 2 1 -4 0 -5 -1 4)
MAX SUM:6

How do I partition a sequence into increasing sub sequences in Clojure?

I have a sequence of integers and I would like to partition them into increasing segments and I want to have as little as possible segments. So I want to have
(segmentize [1 2 3 4 3 8 9 1 7] <=)
;=> [[1 2 3 4][3 8 9][1 7]]
I have implemented segmentize as follows:
(defn segmentize [col lte]
(loop [col col s [] res []]
(cond (empty? col) (conj res s)
(empty? s) (recur (rest col) (conj s (first col)) res)
(lte (last s) (first col)) (recur (rest col) (conj s (first col)) res)
:else (recur col [] (conj res s)))))
But I was wondering if there is already some handy clojure function that does exactly this, or if there is a more idiomatic way to do this.
You can build this with partition-by
(defn segmentize [cmp coll]
(let [switch (reductions = true (map cmp coll (rest coll)))]
(map (partial map first) (partition-by second (map list coll switch)))))
(segmentize <= [1 2 3 4 3 8 9 1 7])
;=> ((1 2 3 4) (3 8 9) (1 7))
The first two maps of the last line may be changed to mapv if you really want vectors rather than lazy sequences.
Another lazy implementation. Basically find out how many consecutive pairs of numbers return true for the "lte" function (take-while + segment) and then split the original collection by that number. Repeat with the reminder collection:
(defn segmentize
[coll lte]
(lazy-seq
(when-let [s (seq coll)]
(let [pairs-in-segment (take-while (fn [[a b]] (lte a b)) (partition 2 1 s))
[segment reminder] (split-at (inc (count pairs-in-segment)) s)]
(cons segment
(segmentize reminder lte))))))
This is a special case of some of the sequence-handling functions in org.flatland/useful, specifically flatland.useful.seq/partition-between:
(partition-between (partial apply >) xs)
If you require a from-scratch implementation with no external dependencies, I'd prefer dAni's answer.
Here is my version of segmentize (I called in split-when):
(defn split-when [f s]
(reduce (fn [acc [a b]]
(if (f b a)
(conj acc [b])
(update-in acc [(dec (count acc))] conj b)))
[[(first s)]]
(partition 2 1 s)))
(split-when < [1 2 3 4 3 8 9 1 7])
;; [[1 2 3 4] [3 8 9] [1 7]]
Because everybody loves lazy sequences:
(defn segmentize [coll cmp]
(if-let [c (seq coll)]
(lazy-seq
(let [[seg rem] (reduce (fn [[head tail] x]
(if (cmp (last head) x)
[(conj head x) (next tail)]
(reduced [head tail])))
[(vec (take 1 c)) (drop 1 c)]
(drop 1 c))]
(cons seg (segmentize rem cmp))))))
The code to compute each segment could probably be made a little less verbose using loop/recur, but I tend to find reduce more readable most of the time.

Project for the game 'Oware'

I have a project about the game "Oware", we are supposed to write the game in the program Dr.Racket.
These are the rules for the game, they explain it pretty well, illustrating with pictures: http://www.awale.info/jugar-a-lawale/les-regles-de-lawale/?lang=en
Im kinda stuck on the first exercise, i have the method, but its not giving the numbers in the right order.
The first function we have to write is called "distribute" which should re-put x grains in the holes, giving the result in a form of a list consisting of the number of grains rest and the new numbers for the holes.
This is whats expected:
(distribute 5 '(2 3 1 5 5 2)) -> (0 (3 4 2 6 6 2))
(distribute 5 '(2 3 1)) -> (2 (3 4 2))
What I wrote:
(define distribue
(lambda (n l)
(if (or (= n 0) (null? l))
(list l n)
(cons (+ (car l) 1) (distribue (- n 1) (cdr l))))))
What it gives:
(distribue 5 '(2 3 1 5 5 2)) -> (3 4 2 6 6 (2) 0)
(distribue 5 '(2 3 1)) -> (3 4 2 () 2)
I was trying to change the list cons append, but never got the expected form of answer
How about
(define (distribue n l)
(define (iterator n p q)
(if (or (= n 0) (null? q))
(list n (append p q))
(iterator (- n 1) (append p (list (+ 1 (car q)))) (cdr q))))
(iterator n '() l))
where
(distribue 5 '(2 3 1 5 5 2))
(distribue 5 '(2 3 1))
returns
'(0 (3 4 2 6 6 2))
'(2 (3 4 2))
as required.

Resources