This function comes from some code to calculate convolutions of finite sequences.
window n k = [ drop (i-k) $ take i $ [1..n] | i <- [1..(n+k)-1] ]
*Main> window 4 6
[[1],[1,2],[1,2,3],[1,2,3,4],[1,2,3,4],[1,2,3,4],[2,3,4],[3,4],[4]]
It's sliding window of length k over a sequence of length n, where k can be larger than n.
The code calls take and drop on the source list roughly n+k times, so it seems to have at least quadratic complexity.
Clearly, it can be written without a list comprehension:
window n k = map (\i -> (drop (i-k) . take i) [1..n]) [1..(n+k)-1]
Is there a better way to do this?
Edit:
Full set of examples, as requested.
Prelude> window 4 4
[[1],[1,2],[1,2,3],[1,2,3,4],[2,3,4],[3,4],[4]]
Prelude> window 4 6
[[1],[1,2],[1,2,3],[1,2,3,4],[1,2,3,4],[1,2,3,4],[2,3,4],[3,4],[4]]
Prelude> window 6 4
[[1],[1,2],[1,2,3],[1,2,3,4],[2,3,4,5],[3,4,5,6],[4,5,6],[5,6],[6]]
Computing the convolution of [1..4] and [1..5] works like this:
Prelude> let a = window 4 5
Prelude> let b = window 5 4
Prelude> map sum $ zipWith (zipWith (*)) a (map reverse b)
[1,4,10,20,30,34,31,20]
So you want to have a window of length k sliding over the given sequence (its length n is then not important).
It starts with just its last cell over the head of the sequence, then it moves along notch-by-notch until it covers the sequence's last element by its head cell.
This is then just map (take k) (tails sequence) with take k (inits sequence) in the front:
window :: Int -> [a] -> [[a]]
window k = (++) <$> take k . inits <*> map (take k) . tails
Observe:
> window 4 [1..6]
[[],[1],[1,2],[1,2,3],[1,2,3,4],[2,3,4,5],[3,4,5,6],[4,5,6],[5,6],[6],[]]
> window 6 [1..4]
[[],[1],[1,2],[1,2,3],[1,2,3,4],[1,2,3,4],[2,3,4],[3,4],[4],[]]
You can take care of the []s by putting it through init . tail.
There's a discrepancy with your desired output in case k > n. If that's important an additional sequence of xs should be inserted between the two parts. Thus we get
-- NB: will diverge on infinite lists
window :: Int -> [a] -> [[a]]
window k xs
= (init . tail) $
take k (inits xs)
++ replicate (k-n-1) xs
++ map (take k) (tails xs)
where
n = length xs
note: Measuring length is an anti-pattern; it is used here for prototyping purposes only. Because of it the function will get stuck on infinite lists. Instead, length should be fused in so the function will be productive, producing successive windows indefinitely right away.
So now we get
> window 4 [1..6]
[[1],[1,2],[1,2,3],[1,2,3,4],[2,3,4,5],[3,4,5,6],[4,5,6],[5,6],[6]]
> window 6 [1..4]
[[1],[1,2],[1,2,3],[1,2,3,4],[1,2,3,4],[1,2,3,4],[2,3,4],[3,4],[4]]
tails is linear, and inits, normally quadratic, is capped by take k so in case k << n it'll be linear as well.
For completeness, here's a version which doesn't measure the length of the input list so it works for the infinite inputs as well:
window :: Int -> [a] -> [[a]]
window k xs | k > 0
= a
++ replicate (k - length a) xs
++ (init . map (take k) . tails
. drop 1 $ xs)
where
a = take k . tail $ inits xs
Related
I need to find all the subsets of squares that is equal to given square number.Ex:
f (11^2) --> f (121) --> [1,2,4,10],[2,6,9] all there sum of individual squares is equal to 121.
First I tried to find all the possible combinations of sums that is equal sum of given number.Code that I have tried
squares x = map (\x -> x * x ) [1..x]
--Using Subsequences,to create [subsequences][1] of the list
f n = filter (\x -> sum x == n) (subsequences.map (\y -> y *y) $ [1..(sqrt n)])
But Sequences of a big number produces huge list Ex: f (50^2) takes long time.Is there is any other approach to proceed efficiently?
Let's say we want to pick from the 50 lowest square values in descending order, starting with this list: [2500, 2401, ... , 16, 9, 4, 1] and targeting a sum of 2500.
The problem with your subsequences-based algorithm is that it is going to generate and test all value subsequences. But it is for example pointless to test subsequences starting with [49*49, 48*48], because 49*49 + 48*48 = 4705 > 2500.
The subsequences-based algorithm does not maintain a running sum, also known as an accumulator. Considering the subsequences as a virtual tree, an accumulator allows you to eliminate whole branches of the tree at once, rather than having to check all possible leaves of the tree.
It is possible to write a recursive algorithm which maintains an accumulator for the partial sum. First, we need an auxiliary function:
import Data.List (tails, subsequences)
getPairs :: [a] -> [(a,[a])]
getPairs xs = map (\(x:xs) -> (x,xs)) $ filter (not . null) $ tails xs
Usage:
$ ghci
GHCi, version 8.8.4: https://www.haskell.org/ghc/ :? for help
...
λ>
λ> printAsLines xs = mapM_ (putStrLn . show) xs
λ>
λ> printAsLines $ getPairs $ reverse $ map (^2) [1..8]
(64, [49,36,25,16,9,4,1])
(49, [36,25,16,9,4,1])
(36, [25,16,9,4,1])
(25, [16,9,4,1])
(16, [9,4,1])
(9, [4,1])
(4, [1])
(1, [])
λ>
λ>
(Note: edited for readability)
Above, the left element of each pair is the element to be added to the running sum, while the right element is the list of remaining values that can still be considered for addition.
We can thus provide a general recursive algorithm for partial sums:
getSummations :: Int -> [Int] -> [[Int]]
getSummations s xs = go [] 0 xs
where
-- go prefix runningSum restOfValues
go prefix acc ys
| (acc > s) = [] -- all rejected
| (acc == s) = [prefix] -- cannot add further values
| otherwise =
let pairs = getPairs ys
in concat $ map (\(k,zs) -> go (k:prefix) (acc+k) zs) pairs
-- or: concatMap (\(k,zs) -> go (k:prefix) (acc+k) zs) pairs
Here, prefix is the list of values already included in the summation, and s is the target sum.
Note that the pruning of “dead branches” is done by the following lines:
| (acc > s) = [] -- all rejected
| (acc == s) = [prefix] -- cannot add further values
Next, we can specialize the mechanism for our square values:
getSquareSummations :: Int -> [[Int]]
getSquareSummations n = getSummations (n*n) (reverse $ map (^2) [1..n])
For comparison purposes, the subsequences-based algorithm can be written like this:
naiveGetSquareSummations :: Int -> [[Int]]
naiveGetSquareSummations n = let xss = subsequences $ map (^2) [1..n]
in filter (\xs -> sum xs == n*n) xss
Using GHC v8.8.4 with -O2, the expression getSquareSummations 50 returns the list of 91021 possible subsequences summing to 2500, in less than one second. This is with a vintage 2014 Intel x86-64 CPU, Intel(R) Core(TM) i5-4440 # 3.10GHz.
I am pretty new to Haskell. I am trying to write a program that takes a list and returns a list of one copy of the first element of the input list, followed by two copies of the second element, three copies of the third, and so on. e.g. input [1,2,3,4], return [1,2,2,3,3,3,4,4,4,4].
import Data.List
triangle :: [a] -> [a]
triangle (x:xs)
|x/=null = result ++ xs
|otherwise = group(sort result)
where result = [x]
I try to use ++ to add each list into a new list then sort it, but it does not work. What I tried to achieve is, for example: the list is [1,2,3], result = [1,2,3]++[2,3]++[3] but sorted.
here is a short version
triangle :: [a] -> [a]
triangle = concat . zipWith replicate [1..]
How it works
zipWith takes a function f : x -> y -> z and two lists [x1,x2,...] [y1,y2,..] and produces a new list [f x1 y1, f x2 y2, ...]. Both lists may be infinite - zipWith will stop as soon one of the list run out of elements (or never if both are infinite).
replicate : Int -> a -> [a] works like this: replicate n x will produce a list with n-elements all x - so replicate 4 'a' == "aaaa".
[1..] = [1,2,3,4,...] is a infinite list counting up from 1
so if you use replicate in zipWith replicate [1..] [x1,x2,...] you get
[replicate 1 x1, replicate 2 x2, ..]
= [[x1], [x2,x2], ..]
so a list of lists - finally concat will append all lists in the list-of-lists together to the result we wanted
the final point: instead of triangle xs = concat (zipWith replicate [1..] xs) you can write triangle xs = (concat . zipWith repliate [1..]) xs by definition of (.) and then you can eta-reduce this to the point-free style I've given.
Here you go:
triangle :: [Int] -> [Int]
triangle = concat . go 1
where
go n [] = []
go n (x:xs) = (replicate n x) : (go (n+1) xs)
update: now I see what you mean here. you want to take diagonals on tails. nice idea. :) Here's how:
import Data.Universe.Helpers
import Data.List (tails)
bar :: [a] -> [a]
bar = concat . diagonals . tails
That's it!
Trying it out:
> concat . diagonals . tails $ [1..3]
[1,2,2,3,3,3]
Or simply,
> diagonal . tails $ [11..15]
[11,12,12,13,13,13,14,14,14,14,15,15,15,15,15]
(previous version of the answer:)
Have you heard about list comprehensions, number enumerations [1..] and the zip function?
It is all you need to implement your function:
foo :: [a] -> [a]
foo xs = [ x | (i,x) <- zip [1..] xs, j <- .... ]
Can you see what should go there instead of the ....? It should produce some value several times (how many do we need it to be?... how many values are there in e.g. [1..10]?) and then we will ignore the produced value, putting x each time into the resulting list, instead.
--Returns last N elements in list
lastN :: Int -> [a] -> [a]
lastN n xs = let m = length xs in drop (m-n) xs
--create contiguous array starting from index b within list a
produceContiguous :: [a] -> Int -> [[a]]
produceContiguous [] _ = [[]]
produceContiguous arr ix = scanl (\acc x -> acc ++ [x]) [arr !! ix] inset
where inset = lastN (length arr - (ix + 1)) arr
--Find maximum sum of all possible contiguous sub arrays, modulo [n]
--d is dummy data
let d = [1,2,3,10,6,3,1,47,10]
let maxResult = maximum $ map (\s -> maximum s) $ map (\c -> map (\ac -> (sum ac )`mod` (last n)) c ) $ map (\n -> produceContiguous d n ) [0..(length d) -1]
I'm a Haskell newb - just a few days into it .. If I'm doing something obviously wrong, whoopsies
You can improve the runtime a lot by observing that map sum (produceContiguous d n) (which has runtime Ω(m^2), m the length of drop n d -- possibly O(m^3) time because you're appending to the end of acc on each iteration) can be collapsed to scanl (+) 0 (drop n d) (which has runtime O(m)). There are plenty of other stylistic changes I would make as well, but that's the main algorithmic one I can think of.
Cleaning up all the stylistic stuff, I would probably write:
import Control.Monad
import Data.List
addMod n x y = (x+y) `mod` n
maxResult n = maximum . (scanl (addMod n) 0 <=< tails)
In ghci:
*Main> jaggedGoofyMax 100 [1..1000]
99
(12.85 secs, 24,038,973,096 bytes)
*Main> dmwitMax 100 [1..1000]
99
(0.42 secs, 291,977,440 bytes)
Not shown here is the version of jaggedGoofyMax that has only the optimization I mentioned in my first paragraph applied, which has slightly better runtime/memory usage stats to dmwitMax when run in ghci (but basically identical to dmwitMax when both are compiled with -O2). So you can see that for even modest input sizes this optimization can make a big difference.
I am trying a problem recently. And in this case I am having few problems.
Input: generatingListforRightShifting 2 [1,2,3,4,5,6,7,8]
Output: [[1,2,3,4,5,6,7,8],[8,1,2,3,4,5,6,7],[7,8,1,2,3,4,5,6]]
As you understand this program will shift an element in right direction. The 1st argument indicates how many times it will do shifting.
As a newbie I am trying solving it few well known list functions. and using recursion. But to me recursion idea is not clear. My code is:
generatingListforRightShifting' _ []=[]
generatingListforRightShifting' 0 x=x
generatingListforRightShifting' n xs= newList where
newList=takeWhile(\i->[1..n]
<=n)(reverse(take
i(reverse xs))++reverse(drop i(reverse xs)))
I understand that the main mistake I'm doing is in the part takeWhile. But how can I iterate through n times. I have already made a program which directly shows the shifted result such as
Input:generatingListforRightShifting 2 [1,2,3,4,5,6,7,8]
Output: [7,8,1,2,3,4,5,6]
But when I try to get all previous shifting I cannot.
Can anyone help me out here. I also welcome you if you give me the solving idea.
This is more commonly known as rotating instead of shifting. Rotating the list right once is simple, as there are methods to get the last element and the the sublist of all elements but the last.
rotateOnce lst = (last lst):(init lst)
Also note that the rotating twice is equivalent to calling rotateOnce twice. Therefore, the method could be implemented simply as a recursion from the previous result:
rotateN 0 lst = [lst]
rotateN n lst = lst : rotateN (n-1) ((last lst):(init lst))
(Note: that may not be the most optimal solution.)
You can define "shift" recursively: shift 0 is a no-op, shift 1+n (x:xs) is shift n xs.
Something like:
shift 0 = \x -> x
shift n = \lst#(x:xs) -> (shift (n-1) xs)
-- example:
sh3 = shift 3
Then the 'rotate' problem becomes easier:
rotate n = \lst -> (shift lst) ++ (take n lst)
You seem to prefer that we fix your code than start again, so
let's have a look at your code. Firstly, the main list chopping:
reverse (take i (reverse xs)) ++ reverse (drop i (reverse xs))
Now reverse (take i (reverse xs)) takes i elements from the end of the list,
but you reverse the list twice to achieve this, and it would be better to do
drop (length xs - i) xs. Similarly, you can implement reverse (drop i (reverse xs)))
as take (length xs - i) xs. That gives us
drop (length xs - i) xs ++ take (length xs - i) xs
Now your code \i->[1..n]<=n doesn't make sense because it compares the list [1..n]
with n, which can't work. I think you're trying to make a loop where i runs from
1 to n, which is a good plan. Let's use a list comprehension to get the ones we wanted:
[drop (length xs - i) xs ++ take (length xs - i) xs | i <- [1 .. length xs], i <= n]
but now we're running from 1 to the length of the list but throwing away numbers above n,
which would be better written
[drop (length xs - i) xs ++ take (length xs - i) xs | i <- [1..n]]
This does allow n to be more than length xs, but I don't see a big issue there, we could check that at first.
Notice now that we're only using i in the form (length xs - i), and really we're recalculating
length xs an awful lot more than we should, so instead of letting i run from 1 to n, and using
length xs - i, why don't we just have j=length xs -i so j runs from length xs to length xs - n:
[drop j xs ++ take j xs | j <- [length xs,length xs - 1 .. length xs - n]]
which works because for example [6,5..1] == [6,5,4,3,2,1]
It would be neater to do
let l = length xs in
[drop j xs ++ take j xs | j <- [l,l - 1 .. l - n]]
or maybe you like to take more than you like to do arithmetic, so we could use:
let l = length xs in
take n [drop j xs ++ take j xs | j <- [l,l - 1 .. 0]]
which has the added benefit of stopping you doing too many, stopping
you when you get back to the start.
I'd rename your function from generatingListforRightShifting to rotationsR, giving
rotationsR n xs = let l = length xs in
take n [drop j xs ++ take j xs | j <- [l,l - 1 ..]]
Which gives rotationsR 6 [1..4] == [[1,2,3,4],[4,1,2,3],[3,4,1,2],[2,3,4,1],[1,2,3,4]].
Left rotation would look simpler:
rotationsL n xs = take n [drop j xs ++ take j xs | j <- [0..length xs]]
Digression: I couldn't help myself, sorry, and I started again.
I still don't like all that dropping and taking every single time, I'd rather pop
infinitely many copies of xs next to each other (cycle xs) and take infinitely
many tails of that, chopping them all to the right length, but just give you the first n:
rotationsL' n xs = let l = length xs in
take n . map (take l) . tails . cycle $ xs
Because of lazy evaluation, only a finite amount of cycle xs ever gets calculated,
but this one can run and run: rotationsL' 10 [1..4] gives you:
[[1,2,3,4],[2,3,4,1],[3,4,1,2],[4,1,2,3],[1,2,3,4],[2,3,4,1],[3,4,1,2],[4,1,2,3],[1,2,3,4],[2,3,4,1]]
It would be nice to do the right roations that way too, but it doesn't work because
I'd need to start at the end of an infinite list and work my way back. Let's reuse
your reverse, take what you need, reverse trick again, though:
rotationsR' n xs = let l = length xs in
take n . map (reverse.take l) . tails . cycle . reverse $ xs
Undigression: If you'd rather stick more closely to your original code, you can do
generatingListforRightShifting n xs =
[reverse (take i (reverse xs)) ++ reverse (drop i (reverse xs)) | i <- [1..n]]
I would drop the current approach, which is very convoluted. Instead, focus on abstracting the different components of the operation. If you break the operation into parts, you will notice that there are two symmetric components: rotating the list to the left, and rotating the list to the right. The operation you wish to define iterates the right rotation a specified number of times over some list. This suggests that the desired operation can be defined by taking a specified number of iterations of either the left or right rotation. For example,
left :: [a] -> [a]
left [] = []
left xs = tail xs ++ [head xs]
right :: [a] -> [a]
right [] = []
right xs = last xs : init xs
shiftL :: Int -> [a] -> [[a]]
shiftL n = take n . iterate left
shiftR :: Int -> [a] -> [[a]]
shiftR n = take n . iterate right
Using cycle here seems nice:
shifts n xs = take (n+1) $ shifts' (cycle xs)
where
len = length xs
shifts' ys = take len ys:shifts' (drop (len-1) ys)
I find a left rotation to be very straight forward using splitAt:
import Data.Tuple (swap)
rotateLeft n = uncurry (++) . swap . splitAt n
> rotateLeft 2 "Hello World!"
>>> "llo World!He"
How to define a rotates function that generates all rotations of the given list?
For example: rotates [1,2,3,4] =[[1,2,3,4],[2,3,4,1],[3,4,1,2],[4,1,2,3]]
I wrote a shift function that can rearrange the order
shift ::[Int]->[Int]
shift x=tail ++ take 1 x
but I don't how to generate these new arrays and append them together.
Another way to calculate all rotations of a list is to use the predefined functions tails and inits. The function tails yields a list of all final segments of a list while inits yields a list of all initial segments. For example,
tails [1,2,3] = [[1,2,3], [2,3], [3], []]
inits [1,2,3] = [[], [1], [1,2], [1,2,3]]
That is, if we concatenate these lists pointwise as indicated by the indentation we get all rotations. We only get the original list twice, namely, once by appending the empty initial segment at the end of original list and once by appending the empty final segment to the front of the original list. Therefore, we use the function init to drop the last element of the result of applying zipWith to the tails and inits of a list. The function zipWith applies its first argument pointwise to the provided lists.
allRotations :: [a] -> [[a]]
allRotations l = init (zipWith (++) (tails l) (inits l))
This solution has an advantage over the other solutions as it does not use length. The function length is quite strict in the sense that it does not yield a result before it has evaluated the list structure of its argument completely. For example, if we evaluate the application
allRotations [1..]
that is, we calculate all rotations of the infinite list of natural numbers, ghci happily starts printing the infinite list as first result. In contrast, an implementation that is based on length like suggested here does not terminate as it calculates the length of the infinite list.
shift (x:xs) = xs ++ [x]
rotates xs = take (length xs) $ iterate shift xs
iterate f x returns the stream ("infinite list") [x, f x, f (f x), ...]. There are n rotations of an n-element list, so we take the first n of them.
The following
shift :: [a] -> Int -> [a]
shift l n = drop n l ++ take n l
allRotations :: [a] -> [[a]]
allRotations l = [ shift l i | i <- [0 .. (length l) -1]]
yields
> ghci
Prelude> :l test.hs
[1 of 1] Compiling Main ( test.hs, interpreted )
Ok, modules loaded: Main.
*Main> allRotations [1,2,3,4]
[[1,2,3,4],[2,3,4,1],[3,4,1,2],[4,1,2,3]]
which is as you expect.
I think this is fairly readable, although not particularly efficient (no memoisation of previous shifts occurs).
If you care about efficiency, then
shift :: [a] -> [a]
shift [] = []
shift (x:xs) = xs ++ [x]
allRotations :: [a] -> [[a]]
allRotations l = take (length l) (iterate shift l)
will allow you to reuse the results of previous shifts, and avoid recomputing them.
Note that iterate returns an infinite list, and due to lazy evaluation, we only ever evaluate it up to length l into the list.
Note that in the first part, I've extended your shift function to ask how much to shift, and I've then a list comprehension for allRotations.
The answers given so far work fine for finite lists, but will eventually error out when given an infinite list. (They all call length on the list.)
shift :: [a] -> [a]
shift xs = drop 1 xs ++ take 1 xs
rotations :: [a] -> [[a]]
rotations xs = zipWith const (iterate shift xs) xs
My solution uses zipWith const instead. zipWith const foos bars might appear at first glance to be identical to foos (recall that const x y = x). But the list returned from zipWith terminates when either of the input lists terminates.
So when xs is finite, the returned list is the same length as xs, as we want; and when xs is infinite, the returned list will not be truncated, so will be infinite, again as we want.
(In your particular application it may not make sense to try to rotate an infinite list. On the other hand, it might. I submit this answer for completeness only.)
I would prefer the following solutions, using the built-in functions cycle and tails:
rotations xs = take len $ map (take len) $ tails $ cycle xs where
len = length xs
For your example [1,2,3,4] the function cycle produces an infinite list [1,2,3,4,1,2,3,4,1,2...]. The function tails generates all possible tails from a given list, here [[1,2,3,4,1,2...],[2,3,4,1,2,3...],[3,4,1,2,3,4...],...]. Now all we need to do is cutting down the "tails"-lists to length 4, and cutting the overall list to length 4, which is done using take. The alias len was introduced to avoid to recalculate length xs several times.
I think it will be something like this (I don't have ghc right now, so I couldn't try it)
shift (x:xs) = xs ++ [x]
rotateHelper xs 0 = []
rotateHelper xs n = xs : (rotateHelper (shift xs) (n - 1))
rotate xs = rotateHelper xs (length xs)
myRotate lst = lst : myRotateiter lst lst
where myRotateiter (x:xs) orig
|temp == orig = []
|otherwise = temp : myRotateiter temp orig
where temp = xs ++ [x]
I suggest:
rotate l = l : rotate (drop 1 l ++ take 1 l)
distinctRotations l = take (length l) (rotate l)