Haskell - Manipulating lists [closed] - list

It's difficult to tell what is being asked here. This question is ambiguous, vague, incomplete, overly broad, or rhetorical and cannot be reasonably answered in its current form. For help clarifying this question so that it can be reopened, visit the help center.
Closed 10 years ago.
Given a matrix m,a starting position p1 and a final point p2.
The objective is to compute how many ways there are to reach the final matrix (p2=1 and others=0). For this, every time you skip into a position you decrements by one.
you can only skip from one position to another by at most two positions, horizontal or vertical. For example:
m = p1=(3,1) p2=(2,3)
[0 0 0]
[1 0 4]
[2 0 4]
You can skip to the positions [(3,3),(2,1)]
When you skip from one position you decrement it by one and does it all again. Let's skip to the first element of the list. Like this:
m=
[0 0 0]
[1 0 4]
[1 0 4]
Now you are in position (3,3) and you can skip to the positions [(3,1),(2,3)]
And doing it until the final matrix:
[0 0 0]
[0 0 0]
[1 0 0]
In this case the amount of different ways to get the final matrix is 20.
I've created the functions below:
import Data.List
type Pos = (Int,Int)
type Matrix = [[Int]]
moviments::Pos->[Pos]
moviments (i,j)= [(i+1,j),(i+2,j),(i-1,j),(i-2,j),(i,j+1),(i,j+2),(i,j-1),(i,j-2)]
decrementsPosition:: Pos->Matrix->Matrix
decrementsPosition(1,c) (m:ms) = (decrements c m):ms
decrementsPosition(l,c) (m:ms) = m:(decrementsPosition (l-1,c) ms)
decrements:: Int->[Int]->[Int]
decrements 1 (m:ms) = (m-1):ms
decrements n (m:ms) = m:(decrements (n-1) ms)
size:: Matrix->Pos
size m = (length m,length.head $ m)
finalMatrix::Pos->Pos->Matrix
finalMatrix (m,n) p = [[if (l,c)==p then 1 else 0 | c<-[1..n]]| l<-[1..m]]
possibleMov:: Pos->Matrix->[Pos]
possibleMov p mat = checks0 ([(a,b)|a<-(dim m),b<-(dim n)] `intersect` xs) mat
where xs = movements p
(m,n) = size mat
dim:: Int->[Int]
dim 1 = [1]
dim n = n:dim (n-1)
checks0::[Pos]->Matrix->[Pos]
checks0 [] m =[]
checks0 (p:ps) m = if ((takeValue m p) == 0) then checks0 ps m
else p:checks0 ps m
takeValue:: Matrix->Pos->Int
takeValue x (i,j)= (x!!(i-1))!!(j-1)
Any idea how do I create a function ways?
ways:: Pos->Pos->Matrix->Int

Explore the possible paths in parallel. From the starting position, make all possible moves. Each of the resulting configurations can be reached in exactly one way. Then, from each of the resulting configurations, make all possible moves. Add the counts of the new configurations that can be reached from several of the previous configurations. Repeat that step until there is only one nonzero element in the grid. Cull impossible paths early.
For the bookkeeping which configuration can be reached in how many ways from the initial configuration, the easiest way is to use a Map. I chose to represent the grid as an (unboxed) array, since
they are easier to handle for indexing and updating than lists of lists
they use less space and indexing is faster
The code:
module Ways where
import qualified Data.Map.Strict as M
import Data.Array.Unboxed
import Data.List
import Data.Maybe
type Grid = UArray (Int,Int) Int
type Position = (Int,Int)
type Configuration = (Position, Grid)
type State = M.Map Configuration Integer
buildGrid :: [[Int]] -> Grid
buildGrid xss
| null xss || maxcol == 0 = error "Cannot create empty grid"
| otherwise = listArray ((1,1),(rows,maxcol)) $ pad cols xss
where
rows = length xss
cols = map length xss
maxcol = maximum cols
pad (c:cs) (r:rs) = r ++ replicate (maxcol - c) 0 ++ pad cs rs
pad _ _ = []
targets :: Position -> [Position]
targets (i,j) = [(i+d,j) | d <- [-2 .. 2], d /= 0] ++ [(i,j+d) | d <- [-2 .. 2], d /= 0]
moves :: Configuration -> [Configuration]
moves (p,g) = [(p', g') | p' <- targets p
, inRange (bounds g) p'
, g!p' > 0, let g' = g // [(p, g!p-1)]]
moveCount :: (Configuration, Integer) -> [(Configuration, Integer)]
moveCount (c,k) = [(c',k) | c' <- moves c]
step :: (Grid -> Bool) -> State -> State
step okay mp = foldl' ins M.empty . filter (okay . snd . fst) $ M.assocs mp >>= moveCount
where
ins m (c,k) = M.insertWith (+) c k m
iter :: Int -> (a -> a) -> a -> a
iter 0 _ x = x
iter k f x = let y = f x in y `seq` iter (k-1) f y
ways :: Position -> Position -> [[Int]] -> Integer
ways start end grid
| any (< 0) (concat grid) = 0
| invalid = 0
| otherwise = fromMaybe 0 $ M.lookup target finish
where
ini = buildGrid grid
bds = bounds ini
target = (end, array bds [(p, if p == end then 1 else 0) | p <- range bds])
invalid = not (inRange bds start && inRange bds end && ini!start > 0 && ini!end > 0)
okay g = g!end > 0
rounds = sum (concat grid) - 1
finish = iter rounds (step okay) (M.singleton (start,ini) 1)

Related

Testing diagonally adjacent elements in nested lists

This is a followup to a recent question that wasn't asked clearly. The poster Aditi Jain's clarifications invalidate the answer somewhat that's already posted there, hence this new post.
The objective is to check whether there's no diagonally adjacent pair of elements in the nested lists which are negative of one another. The poster is new to Haskell programming.
The function signature is:
checkNegation :: [[Int]] -> Bool
Examples:
checkNegation [[1,2], [-2,3]] will return False:
[ [ 1 , 2], -- 2, -2 are diagonally adjacent
[-2 , 3] ]
checkNegation [[1,2], [3,-1]] will return False:
[ [ 1 , 2], -- 1, -1 are diagonally adjacent
[ 3 , -1] ]
checkNegation [[1,2], [-1,3]] will return True:
[ [ 1 , 2], -- no diagonally adjacent negatives
[-1 , 3] ]
checkNegation [[0,2,1], [3,1,-2], [3,-1,3]] will return False:
[ [ 0 , 2, 1], -- 2, -2 are diagonally adjacent
[ 3 , 1, -2],
[ 3 , -1, 3] ]
No coding attempts were provided in the original post.
(I'm not marking this as CW so as not to prevent the answerers getting reputation points for their efforts)
It's a little easier to do things if we take the matrix row-by-row. For the following, for instance:
[a,b,c],
[d,e,f],
We only want to compare the pairs:
[(a,e),(b,f),(b,d),(c,e)]
So the first step is to write a function which constructs that list from two adjacent rows.
diags xs ys = zip xs (drop 1 ys) ++ zip (drop 1 xs) ys
We're using drop 1 rather than tail because it doesn't error on the empty list, and the way I'm going to use this function later will use empty lists.
If we use this in a fold, then, it looks like the following:
anyDiags :: (a -> a -> Bool) -> [[a]] -> Bool
anyDiags p = fst . foldr f (False, [])
where
f xs (a, ys) = (a || or (zipWith p xs (drop 1 ys)) || or (zipWith p (drop 1 xs) ys), xs)
We've also made it generic over any relation.
Next we will want to figure out how to check if two numbers are negations of each other.
negEachOther x y = negate x == y
And then our check negation function is as follows:
checkNegation = anyDiags negEachOther
There are some fun things we can do with the anyDiags function here. There's actually a use of the writer monad hidden in it. With that, we can rewrite the fold to use that fact:
anyDiags :: (a -> a -> Bool) -> [[a]] -> Bool
anyDiags p = getAny . fst . foldrM f []
where
f xs ys = (Any (or (zipWith p xs (drop 1 ys)) || or (zipWith p (drop 1 xs) ys)), xs)
Though I'm not sure if it's any clearer.
Alternatively, we could do the whole thing using the zip xs (tail xs) trick:
anyDiags :: (a -> a -> Bool) -> [[a]] -> Bool
anyDiags p xs = or (zipWith f xs (tail xs))
where
f xs ys = or (zipWith p xs (drop 1 ys)) || or (zipWith p (drop 1 xs) ys)
We can use the diagonals utility from Data.Universe.Helpers package. Such that
λ> diagonals [[0,2,1], [3,1,-2], [3,-1,3]]
[[0],[3,2],[3,1,1],[-1,-2],[3]]
which is only half of what we need. So lets flip our 2D list and apply diagonals once more. Flipping a list would take reverse . transpose operation such that
λ> (reverse . transpose) [[0,2,1], [3,1,-2], [3,-1,3]]
[[1,-2,3],[2,1,-1],[0,3,3]]
now we can use diagonals on this flipped list to obtain the remaining diagonals.
λ> (diagonals . reverse . transpose) [[0,2,1], [3,1,-2], [3,-1,3]]
[[1],[2,-2],[0,1,3],[3,-1],[3]]
For all diagonals we need to concatenate them. So altogether we may do like;
allDiags = (++) <$> diagonals . reverse . transpose <*> diagonals
The rest is applying necessary boolean test.
import Data.List (transpose)
import Data.Universe.Helpers (diagonals)
checkNegation :: Num a => Eq a => [[a]] -> Bool
checkNegation = and . map (and . (zipWith (\x y -> 0 /= (x + y)) <*> tail)) . allDiags
where
allDiags = (++) <$> diagonals . reverse . transpose <*> diagonals
λ> checkNegation [[0,2,1], [3,1,-2], [3,-1,3]]
False
λ> checkNegation [[1,2], [-1,3]]
True
If you have a matrix like this and want to compare adjacent diagonal elements:
m = [[ 1, 2, 3, 4]
,[ 5, 6, 7, 8]
,[ 9,10,11,12]]
then you want to make two comparisons. First, you want to compare, element by element, the sub-matrix you get by dropping the first row and first column (left) with the sub-matrix you get by dropping the last row and last column (right):
[[ 6, 7, 8] [[ 1, 2, 3]
,[10,11,12] ,[ 5, 6, 7]]
Second, you want to compare, element by element, the sub-matrix you get by dropping the first row and last column (left) with the sub-matrix you get by dropping the last row and first column (right):
[[ 5, 6, 7] [[ 2, 3, 4]
,[ 9,10,11]] ,[ 6, 7, 8]]
We can construct these submatrices using init, tail, and maps of these:
m1 = tail (map tail m) -- drop first row and first column
m2 = init (map init m) -- drop last row and last column
m3 = tail (map init m) -- drop first row and last column
m4 = init (map tail m) -- drop last row and first column
giving:
λ> m1
[[6,7,8],[10,11,12]]
λ> m2
[[1,2,3],[5,6,7]]
λ> m3
[[5,6,7],[9,10,11]]
λ> m4
[[2,3,4],[6,7,8]]
How do we compare two sub-matrices? Well, we can write a two-dimensional version of zipWith to apply a binary function (a comparison, say) element by element to two matrices, the same way zipWith applies a binary function element by element to two lists:
zipZipWith :: (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zipZipWith f m1 m2 = zipWith zipRow m1 m2
where zipRow r1 r2 = zipWith f r1 r2
This works by zipping the matrices together, row by row, using the zipRow helper function. For each pair of rows, zipRow zips the rows together, element by element, with the function f. This definition can be simplified to the slightly less clear:
zipZipWith f m1 m2 = zipWith (zipWith f) m1 m2
Anyway, to check if corresponding pairs of elements in two matrices are negatives of each other, we can use zipZipWith isNeg where:
isNeg :: (Num a, Eq a) => a -> a -> Bool
isNeg x y = x == -y
Then, to check if any of these pairs are negatives, we can use concat to change the matrix of booleans into a long list and or to check for any True values:
anyNegPairs :: (Num a, Eq a) => [[a]] -> [[a]] -> Bool
anyNegPairs ma mb = or . concat $ zipZipWith isNeg ma mb
Finally, then, a complete function to perform the comparison would be:
noDiagNeg :: (Num a, Eq a) => [[a]] -> Bool
noDiagNeg m = not (anyNegPairs m1 m2 || anyNegPairs m3 m4)
Since zipZipWith, like zipWith, ignores "extra" elements when comparing arguments of different sizes, it's not actually necessary to trim off the last column/row, so the sub-matrix definitions can be simplified by removing all the inits:
m1 = tail (map tail m)
m2 = m
m3 = tail m
m4 = map tail m
We could actually write m1 in terms of m4 to save double-calculating map tail m:
m1 = tail m4
but the compiler is smart enough to figure this out on its own.
So, a reasonable final solution would be:
noDiagNeg :: (Num a, Eq a) => [[a]] -> Bool
noDiagNeg m = not (anyNegPairs m1 m2 || anyNegPairs m3 m4)
where
m1 = tail (map tail m)
m2 = m
m3 = tail m
m4 = map tail m
anyNegPairs ma mb = or . concat $ zipZipWith isNeg ma mb
isNeg x y = x == -y
zipZipWith :: (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zipZipWith f m1 m2 = zipWith (zipWith f) m1 m2
and it seems to work as desired on the test cases:
λ> noDiagNeg [[1,2],[-2,3]]
False
λ> noDiagNeg [[1,2],[3,-1]]
False
λ> noDiagNeg [[1,2],[-1,3]]
True
λ> noDiagNeg [[0,2,1],[3,1,-2],[3,-1,3]]
False
This is quite similar to #oisdk's solution, though this version might be easier to understand if you aren't too familiar with folds yet.
It fails on (certain) matrices with no elements:
λ> noDiagNeg []
*** Exception: Prelude.tail: empty list
λ> noDiagNeg [[],[]]
*** Exception: Prelude.tail: empty list
so you could use #oisdk's technique of replacing tail with drop 1, if this is a problem. (Actually, I might define tail' = drop 1 as a helper and replace all tail calls with tail' calls, since that would look a little nicer.)
First we pair up the rows: first with second, then second with third, then third with fourth, and so on.
Then, for each pair of rows, we consider all wedge-shaped triples of cells, like this:
--*---
-*-*--
So that the bottom-row cells are diagonally adjacent to the top-row ones.
Then we just check if any of the bottom ones are a negative of the top.
Except this has (literally) an edge case: beginnings and ends of the rows. If we do this wedge-shaped triple thing, we're going to miss the first and the last elements of the top row. To get around this, we first wrap the whole matrix in Just and then extend each row with Nothings on left and right:
[a,b,c] ==> [Nothing, Just a, Just b, Just c, Nothing]
[d,e,f] ==> [Nothing, Just d, Just e, Just f, Nothing]
Now we can safely iterate in triples and not miss anything.
checkNegation :: [[Int]] -> Bool
checkNegation matrix = any rowPairHasNegation rowPairs
where
extendedMatrix = map extendRow matrix
extendRow row = [Nothing] ++ map Just row ++ [Nothing]
rowPairs = extendedMatrix `zip` drop 1 extendedMatrix
rowPairHasNegation (row, nextRow) =
any cellTripleHasNegation $
drop 1 row `zip` nextRow `zip` drop 2 nextRow
cellTripleHasNegation ((x1y0, x0y1), x2y1) =
isNegation x1y0 x0y1 || isNegation x1y0 x2y1
isNegation (Just a) (Just b) = a == -b
isNegation _ _ = False
As far as I understand, this will result in iterating over the whole matrix exactly thrice - once as top row and twice as bottom row, meaning O(n*m)

Maximal positive submatrices using haskell

I have following problem:
You are given matrix m*n and you have to find maximal positive ( all elements of submatrix should be > 0) submatrices from (1,1) to (x,y).
What do I mean by maximal is, when you have following matrix:
[[1,2,3,4],[5,6,7,8],[9,10,-11,12],[13,14,15,16]]
then maximal positive submatrices are:
[[[1,2,3,4],[5,6,7,8]],[[1,2],[5,6],[9,10],[13,14]]]
i.e. first two rows is one solution and first two columns is second solution.
Another example: matrix is
[[1,2,3,-4],[5,6,7,8],[-9,10,-11,12],[13,14,15,16]]
and solution is:
[[[1,2,3],[5,6,7]]]
This is my Haskell program which solves it:
import Data.List hiding (insert)
import qualified Data.Set as Set
unique :: Ord a => [a] -> [a]
unique = Set.toList . Set.fromList
subList::[[Int]] ->[[[Int]]]
subList matrix = filter (allPositiveMatrix) $ [ (submatrix matrix 1 1 x y) | x<-[1..width(matrix)], y<-[1..height(matrix)]]
maxWidthMat::[[[Int]]] -> Int
maxWidthMat subList =length ((foldl (\largestPreviousX nextMatrix -> if (length (nextMatrix!!0)) >(length (largestPreviousX !!0)) then nextMatrix else largestPreviousX ) [[]] subList)!!0)
maxWidthSubmatrices:: [[[Int]]] -> Int ->[[[Int]]]
maxWidthSubmatrices subList maxWidth = filter (\x -> (length $x!!0)==maxWidth) subList
height matrix = length matrix
width matrix = length (matrix!!0)
maximalPositiveSubmatrices matrix = maxWidthSubmatrices (subList matrix) (maxWidthMat (filter (\x -> (length $x!!0)==( maxWidthMat $ subList matrix )) (subList matrix)))
allPositiveList list = foldl (\x y -> if (y>0)&&(x==True) then True else False) True list
allPositiveMatrix:: [[Int]] -> Bool
allPositiveMatrix matrix = foldl (\ x y -> if (allPositiveList y)&&(x==True) then True else False ) True matrix
submatrix matrix x1 y1 x2 y2 = slice ( map (\x -> slice x x1 x2) matrix) y1 y2
slice list x y = drop (x-1) (take y list)
maximalWidthSubmatrix mm = maximum $ maximalPositiveSubmatrices mm
maximalHeigthSubmatrix mm = transpose $ maximum $ maximalPositiveSubmatrices $ transpose mm
-- solution
solution matrix =unique $ [maximalWidthSubmatrix matrix]++[maximalHeigthSubmatrix matrix]
As you can see it's extremely lengthy and ugly.
It problably isn't fastest too.
Could you show me more elegant, faster and shorter solution ( possibly with explantions) ?
Proposed algorithm
I think that in order to solve the problem, we first better perform a dimension reduction:
reduce_dim :: (Num a,Ord a) => [[a]] -> [Int]
reduce_dim = map (length . takeWhile (>0)) -- O(m*n)
Here for every row, we calculate the number of items - starting from the left - that are positive. So for the given matrix:
1 2 3 4 | 4
5 6 7 8 | 4
9 10 -11 12 | 2
13 14 15 16 | 4
The second row thus maps to 2, since the third element is -11.
Or for your other matrix:
1 2 3 -4 | 3
5 6 7 8 | 4
-9 10 -11 12 | 0
13 14 15 16 | 4
Since the first row has a -4 at column 4, and the third one at column 1.
Now we can obtain a scanl1 min over these rows:
Prelude> scanl1 min [4,4,2,4] -- O(m)
[4,4,2,2]
Prelude> scanl1 min [3,4,0,4] -- O(m)
[3,3,0,0]
Now each time the number decreases (and at the end), we know we have found a maximal submatrix at the row above. Since that means we now work with a row from where on, the number of columns is less. Once we reach zero, we know that further evaluation has no sense, since we are working with a matrix with 0 columns.
So based on that list, we can simply generate a list of tuples of the sizes of the maximal submatrices:
max_sub_dim :: [Int] -> [(Int,Int)]
max_sub_dim = msd 1 -- O(m)
where msd r [] = []
msd r (0:_) = []
msd r [c] = [(r,c)]
msd r (c1:cs#(c2:_)) | c2 < c1 = (r,c1) : msd (r+1) cs
| otherwise = msd (r+1) cs
So for your two matrices, we obtain:
*Main> max_sub_dim $ scanl1 min $ reduce_dim [[1,2,3,4],[5,6,7,8],[9,10,-11,12],[13,14,15,16]]
[(2,4),(4,2)]
*Main> max_sub_dim $ scanl1 min $ reduce_dim [[1,2,3,-4],[5,6,7,8],[-9,10,-11,12],[13,14,15,16]]
[(2,3)]
Now we only need to obtain these submatrices themselves. We can do this by using take and a map over take:
construct_sub :: [[a]] -> [(Int,Int)] -> [[[a]]]
construct_sub mat = map (\(r,c) -> take r (map (take c) mat)) -- O(m^2*n)
And now we only need to link it all together in a solve:
-- complete program
reduce_dim :: (Num a,Ord a) => [[a]] -> [Int]
reduce_dim = map (length . takeWhile (>0))
max_sub_dim :: [Int] -> [(Int,Int)]
max_sub_dim = msd 1
where msd r [] = []
msd r (0:_) = []
msd r [c] = [(r,c)]
msd r (c1:cs#(c2:_)) | c2 < c1 = (r,c1) : msd (r+1) cs
| otherwise = msd (r+1) cs
construct_sub :: [[a]] -> [(Int,Int)] -> [[[a]]]
construct_sub mat = map (\(r,c) -> take r (map (take c) mat))
solve :: (Num a,Ord a) => [[a]] -> [[[a]]]
solve mat = construct_sub mat $ max_sub_dim $ scanl1 min $ reduce_dim mat
Which then generates:
*Main> solve [[1,2,3,4],[5,6,7,8],[9,10,-11,12],[13,14,15,16]]
[[[1,2,3,4],[5,6,7,8]],[[1,2],[5,6],[9,10],[13,14]]]
*Main> solve [[1,2,3,-4],[5,6,7,8],[-9,10,-11,12],[13,14,15,16]]
[[[1,2,3],[5,6,7]]]
Time complexity
The algorithm runs in O(m×n) with m the number of rows and n the number of columns, to construct the dimensions of the matrices. For every defined function, I wrote the time complexity in comment.
It will take O(m2×n) to construct all submatrices. So the algorithm runs in O(m2×n).
We can transpose the approach and run on columns instead of rows. So in case we are working with matrices where the number of rows differs greatly from the number of columns, we can first calculate the minimum, optionally transpose, and thus make m the smallest of the two.
Point of potential optimization
we can make the algorithm faster by constructing submatrices while constructing max_sub_dim saving some work.

haskell infinite list of incrementing pairs

Create an infinite list pairs :: [(Integer, Integer)] containing pairs of the form (m,n),
where each of m and n is a member of [0 ..]. An additional requirement is that if (m,n)
is a legit member of the list, then (elem (m,n) pairs) should return True in finite time.
An implementation of pairs that violates this requirement is considered a non- solution.
****Fresh edit Thank you for the comments, Lets see if I can make some progress****
pairs :: [(Integer, Integer)]
pairs = [(m,n) | t <- [0..], m <- [0..], n <-[0..], m+n == t]
Something like this? I just don't know where it's going to return True in finite time.
I feel the way the question is worded elem doesn't have to be part of my answer. Just if you call (elem (m,n) pairs) it should return true. Sound right?
Ignoring the helper method, the list comprehension you have will list out all pairs but the order of elements is a problem. You'll have a infinitely many pairs like (0, m) which are followed by infinitely many pairs like (1, m). Of course elem will forever iterate all the (0, m) pairs never reaching (1, m) or (2, m) etc.
I'm not sure why you have the helper method -- with it, you are only building a list of pairs like [(0,0), (1,1), (2,2), ...] because you've filtered on m = n. Was that part of the requirements?
Like #hammar suggested, start with 0 = m + n and list out the pairs (m, n). Then list pairs (m, n) where 1 = m + n. Then your list will look like [(0,0), (0,1), (1,0), (0,2), (1,1), (2,0), ...].
The helper function ensures that pairs is a list of the form [ (0,0) , (1,1) , (2,2) ... ].
So elem ( m , n ) pairs can be implemented as:
elem (m , n) _ | m == n = True
| otherwise = False
This is a constant time implementation.
I first posted
Prelude> let pairs = [(m, n) | t <- [0..]
, let m = head $ take 1 $ drop t [0..]
, let n = head $ take 1 $ drop (t + 1) [0..]]
Which, I believed answered the three conditions set by the professor. But hammar pointed out that if I chose this list as an answer, that is, the list of pairs of the form (t, t+1), then I might as well choose the list
repeat [(0,0)]
Well, both of these do seem to answer the professor's question, considering there seems to be no mention of the list having to contain all combinations of [0..] and [0..].
That aside, hammer helped me see how you can list all combinations, facilitating the evaluation of elem in finite time by building the infinite list from finite lists. Here are two other finite lists - less succinct than Hammar's suggestion of the diagonals - that seem to build all combinations of [0..] and [0..]:
edges = concat [concat [[(m,n),(n,m)] | let m = t, n <- take m [0..]] ++ [(t,t)]
| t <- [0..]]
*Main> take 9 edges
[(0,0),(1,0),(0,1),(1,1),(2,0),(0,2),(2,1),(1,2),(2,2)]
which construct the edges (t, 0..t) (0..t, t), and
oddSpirals size = concat [spiral m size' | m <- n] where
size' = if size < 3 then 3 else if even size then size - 1 else size
n = map (\y -> (fst y * size' + div size' 2, snd y * size' + div size' 2))
[(x, t-x) | let size' = 5, t <- [0..], x <- [0..t]]
spiral seed size = spiral' (size - 1) "-" 1 [seed]
spiral' limit op count result
| count == limit =
let op' = if op == "-" then (-) else (+)
m = foldl (\a b -> a ++ [(op' (fst $ last a) b, snd $ last a)]) result (replicate count 1)
nextOp = if op == "-" then "+" else "-"
nextOp' = if op == "-" then (+) else (-)
n = foldl (\a b -> a ++ [(fst $ last a, nextOp' (snd $ last a) b)]) m (replicate count 1)
n' = foldl (\a b -> a ++ [(nextOp' (fst $ last a) b, snd $ last a)]) n (replicate count 1)
in n'
| otherwise =
let op' = if op == "-" then (-) else (+)
m = foldl (\a b -> a ++ [(op' (fst $ last a) b, snd $ last a)]) result (replicate count 1)
nextOp = if op == "-" then "+" else "-"
nextOp' = if op == "-" then (+) else (-)
n = foldl (\a b -> a ++ [(fst $ last a, nextOp' (snd $ last a) b)]) m (replicate count 1)
in spiral' limit nextOp (count + 1) n
*Main> take 9 $ oddSpirals 3
[(1,1),(0,1),(0,2),(1,2),(2,2),(2,1),(2,0),(1,0),(0,0)]
which build clockwise spirals of length 'size' squared, superimposed on hammar's diagonals algorithm.
I believe the solution to your task is:
pairs = [(x,y) | u <- [0..], x <- [0..u], y <-[0..u] , u == x+y]

How to count the number of 1's surrounding a given element in a 2D list with Haskell?

Suppose I have the following nested list:
list =
[[0, 1, 0],
[1, 9, 1],
[1, 1, 0]]
Assuming you are only given the x and y coordinate of 9. How do I use Haskell code to find out how many 1's surrounds the number 9?
Let me clarify a bit more, assume the number 9 is positioned at (0, 0).
What I am trying to do is this:
int sum = 0;
for(int i = -1; i <= 1; i++){
for(int j = -1; j <= 1; j++){
if(i == 0 || j == 0) continue;
sum += list[i][j];
}
}
The positions surrounding (0,0) are the following coordinates:
(-1, -1) (0, -1) (1, -1)
(-1, 0) (1, 0)
(-1, 1) (0, 1) (1, 1)
list = [[0,1,0],[1,9,1],[1,1,0]]
s x y = sum [list !! j !! i | i <- [x-1..x+1], j <- [y-1..y+1], i /= x || j /= y]
--s 1 1 --> 5
Note that I there is no error correction if the coordinates are at the edge. You could implement this by adding more conditions to the comprehension.
A list of lists isn't the most efficient data structure if things get bigger. You could consider vectors, or a Map (Int,Int) Int (especially if you have many zeros that could be left out).
[Edit]
Here is a slightly faster version:
s x y xss = let snip i zs = take 3 $ drop (i-1) zs
sqr = map (snip x) $ snip y xss
in sum (concat sqr) - sqr !! 1 !! 1
First we "snip out" the 3 x 3 square, then we do all calculations on it. Again, coordinates on the edges would lead to wrong results.
Edit: switched to summing surrounding 8 rather than surrounding 4
How often do you just want the surrounding count for just one entry? If you want it for all the entries, lists still perform fairly well, you just have to look at it holistically.
module Grid where
import Data.List (zipWith4)
-- given a grid A, generate grid B s.t.
-- B(x,y) = A(x-1,y-1) + A(x,y-1) + A(x+1,y-1)
-- + A(x-1,y) + A(x+1,y)
-- + A(x-1,y+1) + A(x,y+1) + A(x+1,y+1)
-- (where undefined indexes are assumed to be 0)
surrsum :: [[Int]] -> [[Int]]
surrsum rs = zipWith3 merge rs ([] : init rs') (tail rs' ++ [[]])
where -- calculate the 3 element sums on each row, so we can reuse them
rs' = flip map rs $ \xs -> zipWith3 add3 xs (0 : xs) (tail xs ++ [0])
add3 a b c = a+b+c
add4 a b c d = a+b+c+d
merge [] _ _ = []
-- add the left cell, right cell, and the 3-element sums above and below (zero-padded)
merge as bs cs = zipWith4 add4 (0 : init as) (tail as ++ [0]) (bs ++ repeat 0) (cs ++ repeat 0)
-- given a grid A, replace entries not equal to 1 with 0
onesOnly :: [[Int]] -> [[Int]]
onesOnly = map . map $ \e -> if e == 1 then 1 else 0
list :: [[Int]]
list = [[0, 1, 0]
,[1, 9, 1]
,[1, 1, 0]]
Now you can drop down to ghci to see it work:
*Grid Control.Monad> mapM_ (putStrLn . unwords . map show) list
0 1 0
1 9 1
1 1 0
*Grid Control.Monad> mapM_ (putStrLn . unwords . map show) $ onesOnly list
0 1 0
1 0 1
1 1 0
*Grid Control.Monad> mapM_ (putStrLn . unwords . map show) . surrsum $ onesOnly list
2 2 2
3 5 2
2 3 2

Haskell list comprehension 0's and 1's

I am trying to write a function
row :: Int -> Int -> [Int]
row n v
that returns a list of n integers, all 0's, except for the vth element, which needs to be a 1.
For instance,
row 0 0 = []
row 5 1 = [1,0,0,0,0]
row 5 3 = [0,0,1,0,0]
I am new to Haskell and having a lot of difficulty with this. In particular I can't figure out how to make it repeat 0's. I understand the concept of building a list from let's say [1..n], but I just get [1,2,3,4,5]
Any help with this would be greatly appreciated. Thank you.
Try:
let row n v = map (\x -> if x == v then 1 else 0) [1..n]
Here a "monadic" solution:
row n v = [(v-1, 0), (1, 1), (n-v, 0)] >>= (uncurry replicate)
The replicate function repeats a given value a number of times, e.g. replicate (v-1) 0 gives a list of v-1 zeros. The uncurry is used to modify the replicate in order to accept a tuple instead of two single arguments. The funny operator >>= is the heart of a monad; for lists it is the same as concatMap with flipped arguments.
With a comprehensive list :
row n v = [if x == v then 1 else 0 | x <- [1..n]]
Or using fromEnum (thanks dave4420)
row n v = [fromEnum (x == v) | x <- [1..n]]
This should also work:
row n v = replicate (v-1)­ 0 ++ [1] ++ repl­icate (n-v)­ 0
And yet another solution, recursively building up the list:
row :: Int -> Int -> [Int]
row 0 _ = []
row n 1 = 1 : (row (n-1) 0)
row n m = 0 : (row (n-1) (m-1))
And a more readable one, where zeros are "taken":
row :: Int -> Int -> [Int]
row 0 _ = []
row n m = take (m - 1) zeros ++ [1] ++ take (n - m) zeros
where zeros = (iterate id 0)
A simple recursive loop with two temporary variables c and lst . c is for counting and lst is list which we have to return.
row :: Int -> Int -> [ Int ]
row 0 0 = []
row n v = rowHelp n v 1 [] where
rowHelp n v c lst
| c > n = lst
| v == c = rowHelp n v ( c + 1 ) ( lst ++ [ 1 ] )
| otherwise = rowHelp n v ( c + 1 ) ( lst ++ [ 0 ] )
~
~
the fun with haskell is that it let's you write your program very much the way you would express the algorithm. So try:
row n v = [if (x `mod` v==0) then 1 else 0 | x <- [1..n] ]
At first you create a list from 1,2 to n.
Then you check if the number is divisible by v, if it is, 1 is inserted in the output list, if not 0.
Examples:
> row 0 0
[]
> row 5 1
[1,0,0,0,0]
> row 5 3
[0,0,1,0,0]
> row 15 3
[0,0,1,0,0,1,0,0,1,0,0,1,0,0,1]
HTH Chris
I like to demonstrate a top down approach, based on Chris's solution:
row n v = result
where
result = take n numbers -- our result will have a length of n
numbers = map trans [1,2,..] -- and is some transformation of
-- the list of natural numbers
trans e
| e `mod` v == 0 = 1 -- let every v-th element be 1
| otherwise = 0 -- 0 otherwise
This style emphasizes the idea in functional programming that one writes down what a certain value like row n v is supposed to be, rather than trying to write down what a function does. In reminiscence of a well known joke about the lesser known pragramming language Sartre one could say that in pure functional programming functions do nothing, they just are.