This problem takes many forms. For example, given the input '(1 2 3 4 5 6), we might want to swap the values between even and odd pairs. The output would be '(2 1 4 3 6 5).
In Haskell, this is rather easy:
helper [] = []
helper [x] = [x]
helper (x : y : ys) = y : x : helper ys
I wrote some Clojure code to accomplish the same task, but I feel that there is probably a cleaner way. Any suggestions on how to improve this?
(defn helper [[x y & ys]]
(cond
(nil? x) (list)
(nil? y) (list x)
:else (lazy-seq (cons y (cons x (helper ys))))))
Ideally the list would be consumed and produced lazily. Thanks.
(for [[a b] (partition 2 '(1 2 3 4 5 6))
i [b a]]
i)
OR something resembling the haskell version:
(defn helper
([] (list))
([x] (list x))
([x y & r] (concat [y x] (apply helper r))))
(apply helper '(1 2 3 4 5 6))
Avoiding intermediate object creation (vectors / seqs to be concatenated) and in direct correspondence to the Haskell original while handling nil items in the input (which the approach from the question text doesn't):
(defn helper [[x & [y & zs :as ys] :as xs]]
(if xs
(lazy-seq
(if ys
(cons y (cons x (helper zs)))
(list x)))))
Normally I'd use something like tom's answer though, only with mapcat rather than flatten:
(defn helper [xs]
(mapcat reverse (partition-all 2 xs)))
You need to use partition-all rather than partition to avoid dropping the final element from lists of odd length.
This is one lazy way to do it:
user=> (mapcat reverse (partition 2 '(1 2 3 4 5 6)))
(2 1 4 3 6 5)
Related
I'd like to find out concise, functional and tail-recursive (if possible) way of implementing the below specified function:
(define (make-domain digits dimension)
;; Implementation)
;; Usage
(make-domain '(0 1) 0) => (())
(make-domain '(0 1) 1) => ((0) (1))
(make-domain '(0 1) 2) => ((0 0) (0 1) (1 0) (1 1))
(make-domain '(0 1) 3) => ((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))
I'd prefer Scheme implementation with as few helper or library functions as possible, but SML or Haskell will do as well. I'm trying to find a tail-recursive solution possibly using mutual or nested recursion, but with no luck at the moment.
Thank you very much!
That one, in Haskell, is at least “functional” and concise (I think):
makeDomain :: [α] -> Int -> [[α]]
makeDomain xs 0 = [[]]
makeDomain xs n = let mdn1 = makeDomain xs (n-1)
fn x = map (x:) mdn1
in concat (map fn xs)
Trying it:
λ>
λ> makeDomain [0,1] 2
[[0,0],[0,1],[1,0],[1,1]]
λ>
λ> makeDomain [0,1] 3
[[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]
λ>
As mentioned in the comments, going tail-recursive might be a not so good idea, in Haskell at least.
Addendum re: memory efficiency:
You did not list performance concerns in your requirements (was it because you think tail-recursive functions tend to perform better ?).
The above version of makeDomain, as hinted in the comments by amalloy suffers from exponential memory consumption, at least for some compiler versions / optimization levels. This is because the compiler can see makeDomain xs (n-1) as a loop-invariant value to be kept around.
So this is one of these situations where you have to pick a trade-off between elegance and efficiency. The problem has been discussed recently in this related SO question in the context of the very similar replicateM library function; drawing on the answer by K. A. Buhr, one can come up with a version of makeDomain that runs in constant memory, leveraging the Haskell list comprehension construct.
makeDomain1 :: [α] -> Int -> [[α]]
makeDomain1 xs n =
map reverse (helper xs n)
where
helper xs 0 = [[]]
helper xs n = [ x:ys | ys <- helper xs (n-1), x <- xs ]
Testing: running with an OS-enforced memory hard limit of 1200 MB.
λ>
λ> import Control.Monad (replicateM)
λ> replicateM 3 [0,1]
[[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]
λ>
λ> makeDomain1 [0,1] 3
[[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]
λ>
λ> length $ replicateM 30 [0,1]
<interactive>: internal error: Unable to commit 1048576 bytes of memory
...
λ>
λ> length $ makeDomain [0,1] 30
<interactive>: internal error: Unable to commit 1048576 bytes of memory
...
λ>
λ> length $ makeDomain1 [0,1] 30
1073741824
λ>
Using GHC v8.6.5 with -O2 option, that last version never takes more than 150 MB memory, and runs at a speed of about 30 nsec per output list on a vanilla Intel x86-64 PC. This is perfectly reasonable.
Your answer can be made tail-recursive by the usual trick of using an accumulator. The following is Racket not Scheme, but perhaps only because it uses append* which can be defined, I think, as
(define (append* . args)
(apply append args))
Here is a tail-recursive version, therefore:
(define (make-domain digits dimension)
(let mdl ([d dimension] [r '(())])
(if (zero? d)
r
(mdl (- d 1)
(append* (map (λ (d)
(map (λ (sd)
(cons d sd))
r))
digits))))))
Here is my constructive take on solving the above described problem.
The solution is functional, concise, recursive (but not tail-recursive) implementation in Scheme.
The idea is that the domain has an inductive (recursive) definition: each combination in the domain (first map) is a pair of a digit that is taken one in one from the initial digits dictionary and all combination for a smaller by one dimension (second map)
(define (make-domain digits dimension)
"Builds all combinations of digits for a dimension"
;; There is an empty combination for a dimension 0
(if [zero? dimension] '(())
;; Combine all combinations
(apply append
;; For each digit from digits
(map (lambda (d)
;; Prepend the digit to each combination
;; for a smaller by one dimension
(map (lambda (sd) (cons d sd))
(make-domain digits (1- dimension))))
digits))))
For completeness, here is the Haskell solution translated to Standard ML:
fun curry f x y = f (x, y)
fun concatMap f xs = List.concat (List.map f xs)
fun makeDomain _ 0 = [[]]
| makeDomain ys n =
let val res = makeDomain ys (n-1)
in concatMap (fn x => map (curry op:: x) res) ys
end
One could apply the usual trick of an accumulator to avoid the n stack frames that tfb demonstrates. But as amalloy points out, this is hardly the bottleneck of this function with its memory use an exponential factor of n. In the Standard ML variant, the excessive list concatenation will cost more.
So depending on what you intend to do with this list, you may want to consider, in Standard ML, generating its elements and process them one at a time (like lazy streams allow you to); for example, rather than generate a long list and filter it, you could generate the filtered list. Here's an example: Translation of Pythagorean Triplets from Haskell to Standard ML.
Trying to convert Haskell function to Clojure. But facing difficulties. Not sure what's happening.
Here's recursive Haskell function.
mapWidth :: [[Char]] -> Int
mapWidth [] = 0
mapWidth (x:xs)
| length xs == 0 = length x
| length x /= length (xs!!0) = -1
| otherwise = mapWidth(xs)
Here's what I've tried so far :
(defn mapWidth [data_list]
(def data 0)
([[x & xs](seq data_list)](if (= (count x) 0)
(data 0)
(data -1))))
([[x & xs](seq data_list)](if not(= (count xs) length (xs!!0))
(data 0)
(data -1)
mapWidth(xs)))
Any help is appreciated. I'm pretty new to both the languages.
as far as i can see, this function returns length of an element, if all elements have the equal length. In this case it could look like this:
(defn map-len [[x & [y :as xs]]]
(cond (empty? xs) (count x)
(not= (count x) (count y)) -1
:else (recur xs)))
which is almost the exact rewrite of haskell variant (replacing straight recursive call with recur)
(map-len [[1 2] [3 4] [5 6]])
;;=> 2
(map-len [[1 2] [3 4 5] [5 6]])
;;=> -1
bot since clojure is about operations on sequences, you can do it in a more idiomatic way (as for me, it is):
(defn map-len2 [data]
(cond (empty? data) 0
(apply = (map count data)) (count (first data))
:else -1))
(defn map-len3 [[x & xs]]
(let [c (count x)]
(if (every? #(= c (count %)) xs)
c
-1)))
The Problem
I need to create a function that, when given a finite sequence of potentially infinite sequences, it produces the sequence that is their "cartesian product".
i.e. given the sequence
'((1 2) (3 4))
the function produces (some ordering of):
'((1 3) (1 4) (2 3) (2 4)
Importantly, for every p in the list of cartesian products ps, there must be some natural number n such that (= p (last (take n ps))). Or, informally, you only need to iterate through the sequence a finite amount to reach any element in it.
This condition becomes important when dealing with infinite lists.
Solution in Haskell
In Haskell, this is how I would have done it:
interleave :: [a] -> [a] -> [a]
interleave [] ys = ys
interleave (x:xs) ys = x : interleave ys xs
combine :: [[a]] -> [[a]]
combine = foldr prod [[]]
where
prod xs css = foldr1 interleave [ [x:cs | cs <- css] | x <- xs]
And calling it you get the following:
combine [[0..] [0..]] = [[0,0,0],[1,0,0],[,1,0],[2,0,0],[0,0,1],[1,1,0],...
Solution in Clojure
And so I attempted to replicate this in Clojure, like so, (It's pretty much a direct translation):
(defn interleave
"Returns a lazy sequence of the interleavings of sequences `xs` and `ys`
(both potentially infinite), leaving no elements discarded."
[xs ys]
(lazy-seq
(if-let [[x & xs*] (seq xs)]
(cons x (interleave ys xs*))
ys)))
(defn interleave*
"Converts a sequence of potentially infinite sequences into its lazy
interleaving."
[xss]
(lazy-seq
(when-let [[xs & xss*] (seq xss)]
(interleave xs (interleave* xss*)))))
(defn combine
"Takes a finite sequence of potentially infinite sequences, and combines
them to produce a possibly infinite sequence of their cartesian product."
[xss]
(if-let [[xs & xss*] (seq xss)]
(interleave*
(for [x xs]
(for [cs (combine xss*)]
(lazy-seq (cons x cs)))))
'(()) ))
But when I run:
(take 1 (combine [(range) (range)]))
I get:
StackOverflowError cfg.util/combine/iter--3464--3468/fn--3469/fn--3470/iter--3471--3475/fn--3476
So, how do I make it lazy enough, so as to avoid the stack overflow? Really, I don't understand how Clojure's lazy sequence model works which is the main problem.
I think your solution may be algorithmically intractable, reconstructing the sub-sequences time and again, much as the simple Fibonacci function:
(defn fib [n]
(case n
(0N 1N) n
(+ (fib (- n 1)) (fib (- n 2)))))
... recomputes its precedents.
In any event, the search for [100 10] in the cartesian product of (range) and (range):
(first (filter #{[100 10]} (combine [(range) (range)])))
... does not return in a reasonable time.
I can offer you a faster though far less elegant solution.
First, a couple of utilities:
Something from #amalloy to compute the Cartesian product of finite sequences:
(defn cart [colls]
(if (empty? colls)
'(())
(for [x (first colls)
more (cart (rest colls))]
(cons x more))))
A function adapted from the Clojure Cookbook to map the values of a map:
(defn map-vals [f m] (zipmap (keys m) (map f (vals m))))
Now for the function we want, which I've called enum-cart, as it enumerates the Cartesian product even of infinite sequences:
(defn enum-cart [colls]
(let [ind-colls (into (sorted-map) (map-indexed (fn [n s] [n (seq s)]) colls))
entries ((fn tins [ss] (let [ss (select-keys ss (map key (filter val ss)))]
(lazy-seq
(if (seq ss)
(concat
(map-vals first ss)
(tins (map-vals next ss)))))))
ind-colls)
seens (reductions
(fn [a [n x]] (update-in a [n] conj x))
(vec (repeat (count colls) []))
entries)]
(mapcat
(fn [sv [n x]] (cart (assoc sv n [x])))
seens entries)))
The idea is to generate an indexed sequence of entries, going round the non-exhausted sequences. From this we generate a companion sequence of what we have already seen from each sequence. We pairwise combine these two, generating the free cartesian product of the new element with what we have of the other sequences. The answer is the concatenation of these free products.
For example
(enum-cart [(range 3) (range 10 15)])
... produces
((0 10)
(1 10)
(0 11)
(1 11)
(2 10)
(2 11)
(0 12)
(1 12)
(2 12)
(0 13)
(1 13)
(2 13)
(0 14)
(1 14)
(2 14))
And
(first (filter #{[100 10]} (enum-cart [(range) (range)])))
;(100 10)
... returns more or less instantly.
Notes
Is this better done in Knuth or elsewhere? I don't have access to
it.
The last non-exhausted sequence need not be kept, as there is nothing
else to use it.
So, I figured it out. And the issue is a subtle, but frustrating one. The problem stems from the destructuring I perform, in basically every function: I use this sort of idiom: [x & xs*] (seq xs), however, this realizes the first element of xs*, as well as realizing x. This behaviour is similar to what you would see if you were to use first and next to get the head and tail of the list respectively.
Using first/rest instead of destructuring in this way fixed the stack overflow:
(defn interleave
"Returns a lazy sequence of the interleavings of sequences `xs` and `ys`
(both potentially infinite), leaving no elements discarded."
[xs ys]
(lazy-seq
(if-let [xs* (seq xs)]
(cons (first xs*) (interleave ys (rest xs*)))
ys)))
(defn interleave*
"Converts a sequence of potentially infinite sequences into its lazy
interleaving."
[xss]
(lazy-seq
(when-let [xss* (seq xss)]
(interleave (first xss*)
(interleave* (rest xss*))))))
(defn combine
"Takes a finite sequence of potentially infinite sequences, and combines
them to produce a possibly infinite sequence of their cartesian product."
[xss]
(if-let [xss* (seq xss)]
(interleave*
(for [x (first xss*)]
(for [cs (combine (rest xss*))]
(lazy-seq (cons x cs)))))
'(()) ))
And running it, we get:
(= (take 5 (combine [(range) (range) (range)]))
'((0 0 0) (1 0 0) (0 1 0) (2 0 0) (0 0 1)))
I'm new to Common Lisp. In Haskell, you can do a little something like this:
Prelude> takeWhile (<= 10) [k | k <- [1..]]
[1,2,3,4,5,6,7,8,9,10]
Is this possible in Lisp? Not necessarily with an infinite list, but with any list.
You could use LOOP:
(setq *l1* (loop for x from 1 to 100 collect x))
(loop for x in *l1* while (<= x 10) collect x)
If you really need it as a separate function:
(defun take-while (pred list)
(loop for x in list
while (funcall pred x)
collect x))
And here we are:
T1> (take-while (lambda (x) (<= x 10)) *l1*)
(1 2 3 4 5 6 7 8 9 10)
But if we compare:
(loop for x in *l1* while (<= x 10) collect x)
(take-while (lambda (x) (<= x 10)) *l1*)
I think I would just stick with loop.
For infinite sequences, you could take a look at Series:
T1> (setq *print-length* 20)
20
T1> (setq *l1* (scan-range :from 1))
#Z(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 ...)
T1> (until-if (lambda (x) (> x 10)) *l1*)
#Z(1 2 3 4 5 6 7 8 9 10)
This should do...
(defun take-while (list test)
(and list (funcall test (car list))
(cons (car list) (take-while (cdr list) test))))
(take-while '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15) (lambda (x) (< x 10)))
--> (1 2 3 4 5 6 7 8 9)
However this "natural" implementation is not tail-recursive and could crash for big lists.
An explicit push-nreverse approach (a common pattern) could be
(defun take-while (list test)
(do ((res nil))
((or (null list) (not (funcall test (car list))))
(nreverse res))
(push (car list) res)
(setf list (cdr list))))
A recursive (but tail-recursive, therefore probably ok with most CL implementations) could IMO be the following:
(defun take-while (list test)
(labels ((rec (res x)
(if (and x (funcall test (car x)))
(rec (cons (car x) res) (cdr x))
(nreverse res))))
(rec nil list)))
Note that however it's not guaranteed that a common lisp implementation will handle tail-call optimizations.
The CL-LAZY library implements lazy calling for Common Lisp and provides a take-while function that is laziness aware. You can install it with Quicklisp and try it out.
Some languages provide a Haskell-style list API as 3rd party libraries, with or without support for infinite streams.
Some examples:
Clojure's sequences: take-while
Scala has something
Remember that takeWhile is relatively easy to implement over a sequence, and is given in Haskell as:
takeWhile _ [] = []
takeWhile p (x:xs)
| p x = x : takeWhile p xs
| otherwise = []
You can have a lazy evaluation in common lisp using closures (from Paul Graham's On Lisp):
(defun lazy-right-fold (comb &optional base)
"Lazy right fold on lists."
(labels ((rec (lst)
(if (null lst)
base
(funcall comb
(car lst)
#'(lambda () (rec (cdr lst)))))))
#'rec))
Then, take-while becomes:
(defun take-while (pred lst)
(lazy-right-fold #'(lambda (x f) (
(if (test x)
(cons x (funcall f))
(funcall f)))
nil))
I am going over this haskell lecture on count down game, i don't know any haskell but i am intrested in the problem, i am trying to port his code to clojure.
this is the part i got stuck must be something i don't get in haskell,
split :: [a] -> [([a],[a])]
split [] = [([],[])]
split (x:xs) = ([],x:xs) : [(x:ls,rs) | (ls,rs) [([a],[a])]
nesplit = filter ne . split
ne :: ([a],[b]) -> Bool
ne (xs,ys) = not (null xs || null ys)
exprs :: [Int] -> [Expr]
exprs [] = []
exprs [n] = [Val n]
exprs ns = [e | (ls,rs)
I have my own split given 1 2 3 4 it spits out,
(((1) (2 3 4)) ((1 2) (3 4)) ((1 2 3) (4)))
(defn split [v]
(if (= (count v) 1)
(list (first v))
(map #(list (take % v) (drop % v)) (range 1 (count v)))))
(defn exprs [v]
(if (= (count v) 1)
v
(map #(concat (exprs (first %)) (exprs (second %))) v)))
(exprs (split [1 2 3 4]))
that gives me,
java.lang.IllegalArgumentException: Don't know how to create ISeq from: java.lang.Integer
Can anyone tell me what am i missing from the haskell code?
His full code listing is available here.
This is closely following the Haskell implementation as far as my limited Haskell fu allows me to do....
(defn split
[s]
(map #(split-at % s) (range 1 (count s))))
(defn ne
[s]
(every? (complement empty?) s))
(defn nesplit
[s]
(filter ne (split s)))
(declare combine)
(defn exprs
[s]
(when-let [s (seq s)]
(if (next s)
(for [[ls rs] (nesplit s)
l (exprs ls)
r (exprs rs)
e (combine l r)]
e)
s)))
Haven't tested it though.
As for your error message: I think the problem is, that you don't call split recursively in exprs. Then you get 1 were a sequence is expected...
Random other note: count is linear in time for sequences. Since we just need to know, whether we have more than one element, we can check the value of (next s) against nil.
the exception results from exprs being called recursively and eventually being invoked with a list of integers. your code only handles a list of lists or a list of length one.
(exprs '(2 3 4))
leads to the else branch of the if statement which expands out to:
(map #(concat (exprs (first %)) (exprs (second %))) '(2 3 4))))
which comes out to:
(concat (exprs (first 2)) (exprs (second 2)))
(concat (exprs (first 3)) (exprs (second 3)))
(concat (exprs (first 4)) (exprs (second 4)))
and (first 2) throws:
java.lang.IllegalArgumentException: Don't know how to create ISeq from: java.lang.Integer