Haskell cartesian product of infinite lists - haskell

I want to generate a vectorspace from a basis pair, which looks something like:
genFromPair (e1, e2) = [x*e1 + y*e2 | x <- [0..], y <- [0..]]
When I examine the output though, it sems like I'm getting [0, e2, 2*e2,...] (i.e. x never gets above 0). Which sort of makes sense when I think about how I would write the code to do this list comprehension.
I wrote some code to take expanding "shells" from the origin (first the ints with norm 0, then with norm 1, then norm 2...) but this is kind of annoying and specific to Z^2 - I'd have to rewrite it for Z^3 or Z[i] etc. Is there a cleaner way of doing this?

The data-ordlist package has some functions which are extremely useful for working with sorted infinite lits. One of these is mergeAllBy, which combines an infinite list of infinite lists using some comparison function.
The idea is then to build an infinite list of lists such that y is fixed in each list, while x grows. As long as we can guarantee that each list is sorted, and that the heads of the lists are sorted, according to our ordering, we get a merged sorted list back.
Here's a quick example:
import Data.List.Ordered
import Data.Ord
genFromPair (e1, e2) = mergeAllBy (comparing norm) [[x.*e1 + y.*e2 | x <- [0..]] | y <- [0..]]
-- The rest just defines a simple vector type so we have something to play with
data Vec a = Vec a a
deriving (Eq, Show)
instance Num a => Num (Vec a) where
(Vec x1 y1) + (Vec x2 y2) = Vec (x1+x2) (y1+y2)
-- ...
s .* (Vec x y) = Vec (s*x) (s*y)
norm (Vec x y) = sqrt (x^2 + y^2)
Trying this in GHCi we get the expected result:
*Main> take 5 $ genFromPair (Vec 0 1, Vec 1 0)
[Vec 0.0 0.0,Vec 0.0 1.0,Vec 1.0 0.0,Vec 1.0 1.0,Vec 0.0 2.0]

You could look at your space as a tree. At the root of the tree one picks the first element and in its child you pick the second element..
Here's your tree defined using the ListTree package:
import Control.Monad.ListT
import Data.List.Class
import Data.List.Tree
import Prelude hiding (scanl)
infiniteTree :: ListT [] Integer
infiniteTree = repeatM [0..]
spacesTree :: ListT [] [Integer]
spacesTree = scanl (\xs x -> xs ++ [x]) [] infiniteTree
twoDimSpaceTree = genericTake 3 spacesTree
It's an infinite tree, but we could enumerate over it for example in DFS order:
ghci> take 10 (dfs twoDimSpaceTree)
[[],[0],[0,0],[0,1],[0,2],[0,3],[0,4],[0,5],[0,6],[0,7]]
The order you want, in tree-speak, is a variant of best-first-search for infinite trees, where one assumes that the children of tree nodes are sorted (you can't compare all the node's children as in normal best-first-search because there are infinitely many of those). Luckily, this variant is already implemented:
ghci> take 10 $ bestFirstSearchSortedChildrenOn sum $ genericTake 3 $ spacesTree
[[],[0],[0,0],[0,1],[1],[1,0],[1,1],[0,2],[2],[2,0]]
You can use any norm you like for your expanding shells, instead of sum above.

Using the diagonal snippet from CodeCatalog:
genFromPair (e1, e2) = diagonal [[x*e1 + y*e2 | x <- [0..]] | y <- [0..]]
diagonal :: [[a]] -> [a]
diagonal = concat . stripe
where
stripe [] = []
stripe ([]:xss) = stripe xss
stripe ((x:xs):xss) = [x] : zipCons xs (stripe xss)
zipCons [] ys = ys
zipCons xs [] = map (:[]) xs
zipCons (x:xs) (y:ys) = (x:y) : zipCons xs ys

Piggybacking on hammar's reply: His approach seems fairly easy to extend to higher dimensions:
Prelude> import Data.List.Ordered
Prelude Data.List.Ordered> import Data.Ord
Prelude Data.List.Ordered Data.Ord> let norm (x,y,z) = sqrt (fromIntegral x^2+fromIntegral y^2+fromIntegral z^2)
Prelude Data.List.Ordered Data.Ord> let mergeByNorm = mergeAllBy (comparing norm)
Prelude Data.List.Ordered Data.Ord> let sorted = mergeByNorm (map mergeByNorm [[[(x,y,z)| x <- [0..]] | y <- [0..]] | z <- [0..]])
Prelude Data.List.Ordered Data.Ord> take 20 sorted
[(0,0,0),(1,0,0),(0,1,0),(0,0,1),(1,1,0),(1,0,1),(0,1,1),(1,1,1),(2,0,0),(0,2,0),(0,0,2),(2,1,0),(1,2,0),(2,0,1),(0,2,1),(1,0,2),(0,1,2),(2,1,1),(1,2,1),(1,1,2)]

Related

Finding all possible options of Sums of squares of the numbers equal to square of a given number

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.

Haskell duplicate the value in a list according to its position

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.

Computing Moving Average in Haskell

I'm working on learning Haskell, so I tried to implement a moving average function. Here is my code:
mAverage :: Int-> [Int] -> [Float]
mAverage x a = [fromIntegral k / fromIntegral x | k <- rawAverage]
where
rawAverage = mAverage' x a a
-- First list contains original values; second list contains moving average computations
mAverage' :: Int -> [Int] -> [Int] -> [Int]
mAverage' 1 a b = b
mAverage' x a b = mAverage' (x - 1) a' b'
where
a' = init a
b' = zipWith (+) a' (tail b)
where the user calls mAverage with a length for each average and the list of values (e.g. mAverage 4 [1,2..100]).
However, when I run the code on the input mAverage 4 [1,2..100000], I get that it takes 3.6 seconds in ghci (using :set +s) and uses a gigabyte of memory. This seems very inefficient to me, as the equivalent function takes a fraction of a second in Python. Is there some way that I could make my code more efficient?
If you want to learn something new you can take a look at this nice solution for Moving Average problem. It is written by one of my students so I won't claim authorship. I really like it because it's very short. The only problem here is average function. Such functions are known to be bad. Instead you can use Beautiful folds by Gabriel Gonzalez. And yes, this function takes O(k) time (where k is size of window) for calculating average of window (I find it better because you can face floating point errors if you try to add only new element to window and subtract last). Oh, it also uses State monad :)
{-# LANGUAGE UnicodeSyntax #-}
module MovingAverage where
import Control.Monad (forM)
import Control.Monad.State (evalState, gets, modify)
moving :: Fractional a ⇒ Int → [a] → [a]
moving n _ | n <= 0 = error "non-positive argument"
moving n xs = evalState (forM xs $ \x → modify ((x:) . take (n-1)) >> gets average) []
where
average xs = sum xs / fromIntegral n
Here is a straightforward list-based solution which is idiomatic and fast enough, though requires more memory.
import Data.List (tails)
mavg :: Fractional b => Int -> [b] -> [b]
mavg k lst = take (length lst-k) $ map average $ tails lst
where average = (/ fromIntegral k) . sum . take k
This solution allows to use any function instead of average in a moving window.
The following solution is less universal but it is constant in space and seems to be the fastest one.
import Data.List (scanl')
mavg :: Fractional b => Int -> [b] -> [b]
mavg k lst = map (/ fromIntegral k) $ scanl' (+) (sum h) $ zipWith (-) t lst
where (h, t) = splitAt k lst
Finally, the solution which uses a kind of Okasaki's persistent functional queue, to keep the moving window. It does make sense when dealing with streaming data, like conduits or pipes.
mavg k lst = map average $ scanl' enq ([], take k lst) $ drop k lst
where
average (l,r) = (sum l + sum r) / fromIntegral k
enq (l, []) x = enq ([], reverse l) x
enq (l, (_:r)) x = (x:l, r)
And as it was mentioned in comments to the original post, do not use ghci for profiling. For example, you won't be able to see any benefits of scanl' in ghci.
Here's a solution for you.
The idea is to scan two lists, one where the averaging window starts, and another where it ends. Getting a tail end of a list costs as much as scanning the part we're skipping, and we're not copying anything. (If the windows size was usually quite large, we could calculate the remaining_data along with counting the sum initial_data, in one go.)
We generate a list of partial sums as described in my comment, then divide them by the windows width to get averages.
While slidingAverage calculates averages for biased position (window width to the right), centeredSlidingAverage calculates centered averages, using half window width to the left and to the right.
import Data.List (splitAt, replicate)
slidingAverage :: Int -> [Int] -> [Double] -- window size, source list -> list of averages
slidingAverage w xs = map divide $ initial_sum : slidingSum initial_sum xs remaining_data
where
divide = (\n -> (fromIntegral n) / (fromIntegral w)) -- divides the sums by window size
initial_sum = sum initial_data
(initial_data, remaining_data) = splitAt w xs
centeredSlidingAverage :: Int -> [Int] -> [Double] -- window size, source list -> list of averages
centeredSlidingAverage w xs = slidingAverage w $ left_padding ++ xs ++ right_padding
where
left_padding = replicate half_width 0
right_padding = replicate (w - half_width) 0
half_width = (w `quot` 2) -- quot is integer division
slidingSum :: Int -> [Int] -> [Int] -> [Int] -- window_sum before_window after_window -> list of sums
slidingSum _ _ [] = []
slidingSum window_sum before_window after_window = new_sum : slidingSum new_sum new_before new_after
where
value_to_go = head before_window
new_before = tail before_window
value_to_come = head after_window
new_after = tail after_window
new_sum = window_sum - value_to_go + value_to_come
When I try length $ slidingAverage 10 [1..1000000], it takes less than a second on my MBP. Due to the laziness, centeredSlidingAverage takes about the same time.
One simple way of doing it that also uses O(n) complexity
movingAverage :: (Fractional a) => Int -> [a] -> [a]
movingAverage n _ | n <= 0 = error "non-positive argument"
movingAverage n xs = fmap average $ groupBy n xs
where average xs' = sum xs' / fromIntegral (length xs')
groupBy :: Int -> [a] -> [[a]]
groupBy _ [] = []
groupBy n xs = go [] xs
where
go _ [] = []
go l (x:xs') = (x:t) : go (x:l) xs'
where t = take (n-1) l
Another way is to use STUArray.
import Data.Array.Unboxed
import Data.Array.ST
import Data.STRef
import Control.Monad
import Control.Monad.ST
movingAverage :: [Double] -> IO [Double]
movingAverage vals = stToIO $ do
let end = length vals - 1
myArray <- newArray (1, end) 0 :: ST s (STArray s Int Double)
forM_ [1 .. end] $ \i -> do
let cval = vals !! i
let lval = vals !! (i-1)
writeArray myArray i ((cval + lval)/2)
getElems myArray

How do you multiply two generating series?

Forgive me if this is better suited to MathOverflow, but my question is probably too simple to put there.
I'm reading S.K Lando's Lectures on Generating Functions, which gives this definition of the product of two generating functions A and B:
A(s)*B(s) = a0*b0 + (a0*b1 + a1*b0)*s + (a0*b2 + a1*b1 + a2*b0)*s^2 ...
I understand that the s is just formal. But - and I know it's obtuse of me - I can't understand how the pattern of terms combining coefficients should continue. If anyone could just extend the definition to one or two more terms, it would probably help me a lot. Many thanks!
For bonus points, an algorithm in Haskell for multiplying two series (represented as lists of coefficients) would be much appreciated too - but it'd be enough for me just to understand the above definition.
Notice that the sum of the coefficient indices is constant in each term. For example a0*b0 -> 0+0=0, while a0*b1 -> 0+1=1 and a1*b0 -> 1+0=1.
Recall the story of young Gauss, who discovered that by summing a list of consecutive numbers with its reverse, we obtain a list of constants. The same trick applies here. We'll just take the first k a_i and b_i coefficients, reverse the list of b_i coefficients, and take the component-wise product of the lists.
Here's some Haskell code to generate the coefficient of s^i for i>=0, given i and the list of as=[a0,a1,...] and bs=[b0,b1,...]:
genCoeff :: [Double] -> [Double] -> Int -> Double
genCoeff as bs i = sum $ zipWith (*) (take (i+1) as) (reverse (take (i+1) bs))
To generate all of the coefficients, we simply map the partially applied function genCoeff as bs onto the list [0,1,...], i.e.
genAllCeoffs :: [Double] -> [Double] -> [Double]
genAllCoeffs as bs = map (genCoeff as bs) [0..]
Here is a solution which doesn't use reverse:
add [] bs = bs
add as [] = as
add (a:as) (b:bs) = (a+b) : add as bs
mult :: [Int] -> [Int] -> [Int]
mult [] bs = [] -- note: [] = 0
mult as [] = []
mult (a:as) (b:bs) = (a*b) : add (add (map (*a) bs) (map (*b) as)) (0:mult as bs)
test1 = do
let as = [1,2,3]
bs = [4,5]
putStrLn $ "as = " ++ show as
putStrLn $ "bs = " ++ show bs
putStrLn $ "as * bs = " ++ show (mult as bs)
Output:
as = [1,2,3]
bs = [4,5]
as * bs = [4,13,22,15]
It was derived from the following identity:
(a0+a1*x) * (b0 + b1*x) = a0*b0 + a0*b1*x + b0*a1*x + a1*b1*x^2
The correspondences are:
a0*b0 <-> a*b
a0*b1*x <-> map (*a) bs
b0*a1*x <-> map (*b) as
a1*b1*x^2 <-> (0:mult as bs)

How do i "put a restriction" on a list of permutations and subsequences of a list?

I'm really new to programming and Haskell in particular (so new that I actually don't know if this is a stupid question or not). But I was watching the lecture given by Eric Meijer (http://channel9.msdn.com/Series/C9-Lectures-Erik-Meijer-Functional-Programming-Fundamentals) and i was fascinated by the program written by Dr. Graham Hutton in lecture 11; The countdown problem.
My question is:
Is there a way of "filtering" the list of solutions by the length (number of elements), so that the list of solutions are restricted to the solutions that only uses (for example) three of the source numbers? In other words, I would like to change the question from "given the numbers [1,2,3,4,5,6,8,9] construct 18 using the operators..." to "given the numbers [..] which three numbers can be used to construct..."
In my futile attempts, I've been trying to put a kind restriction on his function subbags (which returns all permutations and subsequences of a list)
subbags :: [a] -> [[a]]
subbags xs = [zs | ys <- subs xs, zs <- perms ys]
So that I get all the permutations and subsequences that only contain three of the source numbers. Is this possible? If so, how?
Like I said, I have no idea if this is even a legitimate question - but I have gone from curious to obsessed, so any form of help or hint would be greatly appreciated!
The simplest way would be to just select from the candidates three times
[ (x, y, z) | x <- xs, y <- xs, z <- xs ]
although this assumes that repeat use of a single number is OK.
If it's not, we'll have to get smarter. In a simpler scenario we'd like to pick just two candidates:
[ (x, y) | x <- xs, y <- ys, aboveDiagonal (x, y) ]
in other words, if we think of this as a cartesian product turning a list into a grid of possibilities, we'd like to only consider the values "above the diagonal", where repeats don't happen. We can express this by zipping the coordinates along with the values
[ (x, y) | (i, x) <- zip [1..] xs
, (j, y) <- zip [1..] xs
, i < j
]
which can be extended back out to the n=3 scenario
[ (x, y, z) | (i, x) <- zip [1..] xs
, (j, y) <- zip [1..] xs
, (k, z) <- zip [1..] xs
, i < j
, j < k
]
Ultimately, however, this method is inefficient since it still has to scan through all of the possible pairs and then prune the repeats. We can be a bit smarter by only enumerating the above diagonal values to begin with. Returning to n=2 we'll write this as
choose2 :: [a] -> [(a, a)]
choose2 [] = []
choose2 (a:as) = map (a,) as ++ choose2 as
In other words, we pick first all of the pairs where the head of the list comes first and a value in the tail of the list comes second—this captures one edge of the upper triangle—and then we recurse by adding all of the upper diagonal values of the list of candidates sans the head.
This method can be straightforwardly extended to the n=3 case by using the n=2 case as a building block
choose3 :: [a] -> [(a, a, a)]
choose3 [] = []
choose3 (a:as) = map (\(y, z) -> (a, y, z)) (choose2 as) ++ choose3 as
which also provides a direct generalization to the fully general n dimensional solution
choose :: Int -> [a] -> [[a]]
choose 0 as = [[]] -- there's one way to choose 0 elements
choose _ [] = [] -- there are 0 ways to choose (n>0) elements of none
choose 1 as = map (:[]) as -- there are n ways to choose 1 element of n
choose n (a:as) = map (a:) (choose (n-1) as) ++ choose n as
I like this solution, which does not require the list elements to be an instance of Eq:
import Data.List (tails)
triples ls = [[x,y,z] | (x:xs) <- tails ls,
(y:ys) <- tails xs,
z <- ys]
This returns only subsequences, not permutations, though.

Resources