Related
I'm new to haskell and I got stuck in a little program I tried to make. I want to count number of times my guard statement goes through in all recursion rounds and then return that as Int. For example if c1 is 'a', c2 is 'b', g is 2 and s is "aaabbb" then returned int would be 2, because my guard statement is true in 2 cases.
I tried to make variable x and then add x + 1 to it every time guard statement happens. That didn't work because I learnt that in Haskell variable you set is always static so for example setting x = 0 at start would set that x to 0 every recursion round.
Here's my code:
gaps :: (Char, Char) -> Int -> String -> Int
gaps (c1,c2) g (s:xs)
| c1 == s && c2 == (s:xs) !! g = --Count how many times this statement happens --
| otherwise = gaps (c1,c2) g xs
Just add 1 and call the function recursively
gaps :: (Char, Char) -> Int -> String -> Int
gaps _ _ [] = 0 -- base case
gaps (c1,c2) g (s:xs)
| c1 == s && c2 == (s:xs) !! g = 1 + gaps (c1,c2) g xs -- add one to final result
| otherwise = gaps (c1,c2) g xs
> gaps ('a','b') 2 "aaabbb"
2
> gaps ('a','b') 3 "aaaabbbb"
3
Be carefull when using !!. It isn't total and might fail if your input string has c1's values less than g positions before the end of the string
> gaps ('a','b') 3 "aaaababbb" -- doesn't fail
3
> gaps ('a','b') 3 "aaaabbabb" -- does fail!!!!
Off the back of questions on how to make this thing safer, I have made the following code snippet, borrowing from Ismor's answer.
-- a way to safely get the nth item from a list
get' :: [a] -> Int -> Maybe a
get' [] _ = Nothing
get' (x:xs) 0 = Just x
get' (x:xs) n
| n > 0 = get' xs (n-1)
| otherwise = Nothing
-- takes a Maybe value. if it's Nothing, return 0. if it's Just a value, compare
-- the value and a given param, if equal return 1, else 0
seeEqual:: (Num b, Eq a) => Maybe a -> a -> b
seeEqual Nothing _ = 0
seeEqual (Just a) b
| a==b = 1
| otherwise = 0
-- I have edited the first guard so that it checks c1 and s, then tries to calculate
-- whether c2 and the specific list item are equal, and then recurses as before
gaps :: (Char, Char) -> Int -> String -> Int
gaps _ _ [] = 0 -- base case
gaps (c1,c2) g (s:xs)
| c1 == s = (seeEqual (get' (s:xs) g) c2) + gaps (c1,c2) g xs -- add one to final result
| otherwise = gaps (c1,c2) g xs
I do not claim that this is perfect, but I do think this is safe and shouldn't throw any exceptions or raise any errors.
Prelude> gaps ('a','b') 3 "aaaababbb"
3
Prelude> gaps ('a','b') 3 "aaaabbabb"
2
These trees represent the integer partitions of n <= 5 with at most m = 3 parts.
1 2 3 4 5
| / \ / \ |
| / \ / \ |
| / \ / \ |
1,1 2,1 2,2 3,1 3,2 4,1
| | | |
| | | |
| | | |
1,1,1 2,1,1 2,2,1 3,1,1
Let's enumerate them from top to bottom and left to right:
1 2 3 4 5
6 7 8 9 10 11
12 13 14 15
I need a list D such that D!!i is, if P is the partition numbered by i, the number of the partition P ++ [1]. That is, for this example,
D!!1 = 6, because (1,1) has number 6
D!!2 = 7 because (2,1) has number 7.
D!!3 = 9 because (3,1) has number 9.
D!!4 = 11 because (4,1) has number 11.
D!!5 = "nothing" because there's no child (5,1).
D!!6 = 12 because (1,1) has number 6 and (1,1,1) has number 12.
And so on, D!!7 = 13, D!!8 = 14, and D!!9 = 15.
I have absolutely no idea how to start. I know SO is not a code writing service but I'm asking only for any hints.
EDIT
Here is an attempt.
dico' :: Int -> Int -> Seq (Maybe Int)
dico' m n = go 1 S.empty
where
go :: Int -> Seq (Maybe Int) -> Seq (Maybe Int)
go k d'
| k == n-1 = d'
| otherwise = go (k+1) (inner 0 [0] [m] [m] 0 d')
where
inner :: Int -> [Int] -> [Int] -> [Int] -> Int -> Seq (Maybe Int) -> Seq (Maybe Int)
inner i a b c end d
| i >= length a = d -- what is the terminating condition here ?
| otherwise = if b!!i > 0
then let l = min (b!!i) (c!!i) in
let dd = d |> (Just $ end+1) in
inner (i+1) (a ++ [end + 1 .. end + l]) (b ++ map (\x -> b!!i - x) [1 .. l]) (c ++ [1 .. l]) (end + l) dd
else inner (i+1) a b c end (d |> Nothing)
It works except that the result is too long. I don't find the appropriate terminating condition of the inner loop.
> dico' 5 3
fromList [Just 1,Just 6,Just 7,Just 9,Just 11,Nothing,Just 12,Just 13,Just 14,Just 15,Nothing,Nothing,Just 16,Just 17,Nothing,Nothing,Just 18,Nothing,Nothing]
EDIT 2
Ok I get it now. I'm still interested in any improvement.
a008284_tabl :: [[Int]]
a008284_tabl = [1] : f [[1]]
where
f xss = ys : f (ys : xss)
where
ys = map sum (zipWith take [1..] xss) ++ [1]
_P :: Int -> Int -> Int
_P m n = sum (concatMap (take (min m n)) (take m a008284_tabl))
dico' :: Int -> Int -> Seq (Maybe Int)
dico' m n = go 1 S.empty
where
pmn = Just $ Just $ _P m n
go :: Int -> Seq (Maybe Int) -> Seq (Maybe Int)
go k d'
| k == n-1 = d'
| otherwise = go (k+1) (inner 0 [0] [m] [m] 0 d')
where
inner :: Int -> [Int] -> [Int] -> [Int] -> Int -> Seq (Maybe Int)
-> Seq (Maybe Int)
inner i a b c end d
| S.lookup (S.length d - 1) d == pmn = d
| otherwise = let bi = b!!i in
if bi > 0
then let l = min bi (c!!i) in
let dd = d |> (Just $ end+1) in
let range1l = [1 .. l] in
inner (i+1) (a ++ [end + 1 .. end + l])
(b ++ map (\x -> bi - x) range1l)
(c ++ range1l) (end + l) dd
else inner (i+1) a b c end (d |> Nothing)
> dico' 5 3
fromList [Just 1,Just 6,Just 7,Just 9,Just 11,Nothing,Just 12,Just 13,Just 14,Just 15]
> dico' 10 7
fromList [Just 1,Just 11,Just 12,Just 14,Just 17,Just 21,Just 26,Just 30,Just 33,Just 35,Nothing,Just 36,Just 37,Just 38,Just 40,Just 41,Just 43,Just 46,Just 47,Just 49,Just 52,Just 54,Just 55,Just 57,Just 59,Nothing,Just 60,Just 61,Just 63,Nothing,Just 64,Just 65,Nothing,Just 66,Nothing,Nothing,Just 67,Just 68,Just 69,Just 70,Just 72,Just 73,Just 74,Just 76,Just 77,Just 79,Just 80,Just 81,Just 82,Just 84,Just 85,Nothing,Just 86,Nothing,Just 87,Just 88,Just 89,Just 90,Nothing,Nothing,Just 91,Just 92,Nothing,Nothing,Just 93,Nothing,Nothing,Just 94,Just 95,Just 96,Just 97,Just 98,Just 100,Just 101,Just 102,Just 103,Just 104,Just 105,Nothing,Nothing,Just 106,Just 107,Just 108,Nothing,Just 109,Nothing,Nothing,Just 110,Just 111,Nothing,Nothing,Just 112,Nothing,Nothing,Just 113,Just 114,Just 115,Just 116,Just 117,Nothing,Just 118,Just 119,Just 120,Nothing,Just 121,Nothing,Just 122,Just 123,Nothing,Nothing,Just 124,Nothing,Nothing,Just 125,Just 126,Just 127,Just 128,Nothing,Just 129,Just 130,Nothing,Nothing,Just 131]
how to solve identity for a matrix using Haskell scripts?
For example, if with this given type
type Matrice a = [[a]]
identity :: Int -> Maybe (Matrice Int)
How can it return the identity matrice for the given size? I know that identity matrice is a square matrice which has zero for all values, except the values on the top-left to bottom-right diagonal which are all one. With the condition of, if the size is less than 1, then the identity matrice isn't defined and Nothing is returned.
So say for example,
Prelude > identity 5
Just [[1,0,0,0,0],[0,1,0,0,0],[0,0,1,0,0],[0,0,0,1,0],[0,0,0,0,1]]
Prelude > identity 2
Just [[1,0],[0,1]]
I've tried
identity1 :: Int -> Int -> [Int]
identity1 a b
| a == 0 []
| b == 0 (1:identity (a-1) (-1))
| otherwise = (0:identity' (a-1) (b-1))
identity2 :: Int -> Int -> Matrice Int
identity2 a b
| b == 0 []
| otherwise = (0:identity1 (a-1) (b-1) : identity2 a (b-1)
One short approach is to define the "infinite" identity matrix as
ii = (1 : repeat 0) : fmap (0:) ii
The first row is 1 0 0 ...; each subsequent row is the row above it with a 0 prepended to it.
It should be obvious that the first n rows of the first n columns of the infinite identity matrix is In.
1 | 0 | 0 | 0 | 0 | 0 |
--+ | | | | |
0 1 | 0 | 0 | 0 | 0 |
------+ | | | |
0 0 1 | 0 | 0 | 0 |
----------+ | | | ...
0 0 0 1 | 0 | 0 |
--------------+ | |
0 0 0 0 1 | 0 |
------------------+ |
0 0 0 0 0 1 |
----------------------+
. .
. .
. .
Given that, we just use take to obtain the appropriate-sized sub matrix. take n applied to each row will return the first n columns, and take n applied to the result takes just the first n rows.
type Matrix a = [[a]]
identity :: Int -> Maybe (Matrix Int)
identity n | n <= 0 = Nothing
| otherwise = let ii = (1:repeat 0) : (fmap (0:) ii)
in Just $ take n (take n <$> ii)
If recursively defined infinite lists tie your brain in knots, you can also just define an enlarge function that generates In+1 from In. To do so, it is convenient to assume that I0 exists and is represented as an empty list.
enlarge :: Matrix Int -> Matrix Int
enlarge [] = [[1]]
enlarge i#(r:_) = (1:(0<$r)) : fmap (0:) i
Then you can define identity :: Int -> Matrix Int by indexing an infinite list of identity matrices
identity n | n <= 0 = Nothing
identity n = Just (identities !! n)
where identities :: [Matrix Int] is built with either iterate
identities = iterate enlarge []
or Data.List.unfoldr:
identities = unfoldr (\x -> Just (x, enlarge x)) []
It's also worth noting that the infinite identity matrix is the fixed point of enlarge:
import Data.Function
ii = fix enlarge
One way to accomplish this is through recursion.
I'm going to ask you some leading questions, since I haven't seen what you've tried so far:
What's the identity for 1x1 matrices?
Given the identity for nxn matrices, what would you need to add to create the identity for (n+1)x(n+1) matrices?
Or in pseudo-code:
identity 1 = Just $ _1x1_identity
-- _1x1_identity :: [[Int]]
identity n_plus_1 | n_plus_1 > 1 = fmap _alter_identity (identity n)
where n = n_plus_1 - 1
-- _alter_identity :: [[Int]] -> [[Int]]
identity n | n < 1 = Nothing
If you're unfamiliar with fmap, it's used here to unwrap/rewrap the Maybe value returned from the other call to identity.
I could do the same more verbosely as
identity n_plus_1 | n_plus_1 > 1 = case identity n of
Nothing -> Nothing
Just matrix -> Just (_alter_identity matrix)
where n = n_plus_1 - 1
Your approach in the comments attempts to construct the entire matrix row by row, which is also workable.
One way to implement that approach more directly is through a list comprehension.
List comprehensions make it easy to define new lists and lists of lists:
Prelude> [ i | i <- [0..4] ]
[0,1,2,3,4]
Prelude> [ [(i,j) | j <- [0..3]] | i <- [0..2] ]
[ [(0,0),(0,1),(0,2),(0,3)]
, [(1,0),(1,1),(1,2),(1,3)]
, [(2,0),(2,1),(2,2),(2,3)]
]
Above we can see that we can use a list comprehension to generate a matrix of coordinates - the value (i,j) shows up in the i'th row and the jth column.
List comprehensions allow you to place arbitrary expressions on the left-hand-side of the |, so I could do i + j instead of (i,j) to get a very different matrix:
Prelude> [ [i + j | j <- [0..3]] | i <- [0..2] ]
[ [0,1,2,3]
, [1,2,3,4]
, [2,3,4,5]
]
That's a rectangular matrix. A square matrix would use the same bounds for i and j.
If you were to use a list comprehension like that to create a square matrix, what expression would you put to the left hand side of the | to create the identity matrix? To put it another way, can you express the identity matrix's value at row i column j in terms of i and j?
In case one needs some iterative approach in Haskell, recursion is used. This means that we need to define base case(s) as well as inductive case(s).
There are two base cases here:
the value is less than or equal to zero, in that case the value is Nothing;
the case where the value is exactly one, in that case we return a Just with a 1×1 matrix:
1
There is one inductive case: in case the number is greater than 1, we first generate the identity matrix for n-1, and then we add row at the top and a column at the left:
1 0 0 0
0 1 0 0
0 0 1 0
0 0 0 1
this means we thus need to prepend all rows of the previous matrix with 0, and we prepend the matrix with a list that contains one 1 and n-1 zeros.
Let us first forget about the first base case (n is less than or equal to zero), and assume n is always strictly positive. In that case there is no need to wrap the value in a Maybe, so we first construct a function:
identity' :: Int -> Matrix Int
identity' = ...
so the base case is where the parameter is 1:
identity' 1 = ...
and the inductive case has shape:
identity' n = first_row : map prepend_zero (identity (n-1))
where first_row = ...
prepend_zero = ...
Now we can construct identity in terms of identity' by only once check whether the value is less than or equal to zero:
identity :: Int -> Maybe (Matrix Int)
identity n | n <= 0 = Nothing
| otherwise = Just (identity' n)
where identity' 1 = ...
identity' n = first_row : map prepend_zero (identity (n-1))
where first_row = ...
prepend_zero = ...
I leave the expressions (...) as an exercise that should probably be reasonable.
deconstructivism
identity n = splitEvery n $ (concat $ replicate (n-1) $ 1: replicate n 0)++[1]
proof without words
[[1,0,0,0,0],[0,1,0,0,0],[0,0,1,0,0],[0,0,0,1,0],[0,0,0,0,1]] ~
[1,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,1] ~
[1,0,0,0,0,0],[1,0,0,0,0,0],[1,0,0,0,0,0],[1,0,0,0,0,0] ++ [1] ~
[1,0,0,0,0,0]{4} ++ [1] ~
(1:[0]{5}){4} ++ [1]
you need to handle special cases (n<0 and n==1)
Suppose I have some data that is organized in a grid like this (dimensions may vary, but side of a grid is always n**2):
0 1 2 3
4 5 6 7
8 9 A B
C D E F
What I would like to achieve is to have a list with the same data represented in different ways, i.e. split into column, rows, or (most importantly) cells which is
0 1 | 2 3
4 5 | 6 7
----+----
8 9 | A B
C D | E F
So that if I do some action I will be able to get data as a following list:
[[0, 1, 4, 5],
[2, 3, 6, 7],
[8, 9, C, D],
[A, B, E, F]]
Where ordering does not matter.
I would like to use this to later construct a lens, that will be able to set values considering different kinds of representations. This is something that could have been acheived with use of pointers or references in imperative languages (where applicable).
Besides specifics, I would like to know if there is a general approach to having same internal data represented differently.
Here's what I got so far, using [Int] as internal representation, and conversion function to get specific "views":
import Data.List (transpose)
data Access = Rows | Columns | Cells
isqrt :: Int -> Int
isqrt = floor . sqrt . fromIntegral
group :: Int -> [a] -> [[a]]
group _ [] = []
group n l
| n > 0 = (take n l) : (group n (drop n l))
| otherwise = error "inappropriate n"
representAs :: [Int] -> Access -> [[Int]]
representAs list Rows = group (isqrt . length $ list) list
representAs list Columns = transpose $ list `representAs` Rows
representAs list Cells = let row_width = isqrt . length $ list
cell_width = isqrt row_width
drops = map (\x -> cell_width
* row_width
* (x `quot` cell_width)
+ cell_width
* (x `rem` cell_width)
) [0..row_width-1]
in (map ( (map snd)
. (filter ( (==0)
. (`quot` cell_width)
. (`rem` row_width)
. fst)
)
. (zip [0..])
. (take (row_width * cell_width))
. (`drop` list)
) drops
)
main = mapM_ (putStrLn . show) ([1..16] `representAs` Cells)
My question is based on the same idea as this one, but the answer there regards only memory issues, rather than construction. Besides, if I am to store same data differently in a few representations, I will have to update all of them up setting new value, as far as I understand.
First of all, as user2407038 has mentioned in the comments, List is not a very efficient data structure, especially for what you are trying to do. So I will provide an implementation using a boxed Vector from vector package, which obviously has an advantage of a constant time lookup.
Secondly, you cannot think while programming in a functional language the same way you would in imperative language. In Haskell you should choose a data structure that is most efficient in how you will handle the data, and the actual representation delegate to functions that operate on that data. What I mean is (because there is no mutation, unless you really really need it) you cannot set a value and expect it to change in all representations of the data, but rather should have data stored in a single data structure and all of the functions that operate on that data, take in account it's representation.
In implementation below it always stores data as a flat Vector and lets all the functions that operate on MyGrid take in account it's current representation Access. You probably would rather pass Access around to functions, instead of making it part of MyGrid data type, but I made that choice just for simplicity.
import qualified Data.Vector as V
data Access = Rows | Columns | Cells
data MyGrid a = MyGrid { side :: Int -- square grid with each side = N
, view :: Access
, vect :: V.Vector a }
This approach allows you to create proper constructors, that do all the sanity checks, for instance:
-- | Constructs a grid from a list, while making sure no elements are lost.
fromList :: [a] -> Access -> MyGrid a
fromList ls a = MyGrid { side = if side'*side' == length ls
then if even side'
then side'
else error "grid cannot be split in the middle"
else error "list cannot be represented as a square grid"
, view = a
, vect = V.fromList ls } where
side' = floor . sqrt . fromIntegral . length $ ls
another constructor could possibly be the one that uses a function to generate elements by using indexes of the grid and current representation:
fromFunction :: Int -> Access -> ((Int, Int) -> a) -> MyGrid a
Now, here is the most important part that takes care of the representation, which is retrieving an element from the grid:
index :: MyGrid a -> (Int, Int) -> a
index grid (i, j) =
case view grid of
Rows -> vect grid V.! (i * side grid + j)
Columns -> vect grid V.! (j * side grid + i)
Cells -> vect grid V.! if even i then k else k - d where
n = side grid
d = n `div` 2
k = (i + j `div` d) * n + j `mod` d
And now you can use that function to deal with representation of your data, for instance converting it to a list of lists, describe how it is printed, or mapped over, etc.:
toLists :: MyGrid a -> [[a]]
toLists grid = map (map (index grid)) [[(j, i) | i <- [0..n]] | j <- [0..n]]
where n = side grid - 1
instance Show a => Show (MyGrid a) where
show grid = unlines . map show $ toLists grid
instance Functor MyGrid where
fmap f grid = grid { vect = V.map f $ vect grid}
Which now allows you to deal with MyGrid's current representation (through using show, fmap, etc.):
λ> fromList [0..15] Rows
[0,1,2,3]
[4,5,6,7]
[8,9,10,11]
[12,13,14,15]
λ> succ <$> fromList [0..15] Columns
[1,5,9,13]
[2,6,10,14]
[3,7,11,15]
[4,8,12,16]
λ> fromList [0..15] Cells
[0,1,4,5]
[2,3,6,7]
[8,9,12,13]
[10,11,14,15]
Here is the assumption I made about how to split the cells for a grid with side bigger than 4. Maybe the grid should have a side with powers of 2, maybe cells should be 2 by 2, I couldn't infer. Just adjust the math to what you need, but I chose to split larger grids for Cells in this way:
0 1 2 | 3 4 5
6 7 8 | 9 10 11
---------+---------
12 13 14 | 15 16 17
18 19 20 | 21 22 23
---------+---------
24 25 26 | 27 28 29
30 31 32 | 33 34 35
If you need further help with proper cell splitting, edit the question with some examples how it should be done and I'll adjust the implementation.
For posterity and future reference, I will post an implementation based on ideas collected. Whole answer is a literate Haskell program, and can be saved as *.lhs and be run (although due to formatting, it will need additional lines to separate code and text).
> {-# LANGUAGE TemplateHaskell, FlexibleContexts #-}
> import Control.Lens (makeLenses, lens, (^.), ix, (.~), (.=), (^?), (%~))
> import qualified Data.Vector as V
> import Data.Vector.Lens (sliced)
> import Data.Maybe (fromJust)
> import Data.Function ((&))
> import Data.List (sortBy)
Data representation accessor:
Cells are non-overlapping squares such that the number of elements
in each is equal to grid side;
Rows are just data split into chunks of grid-side length;
Columns are rows transposed.
> data Access = Rows | Columns | Cells
Data structure itself, an sample representation would be
1 2 3 | 4 5 6 | 7 8 9
10 11 12 | 13 14 15 | 16 17 18
19 20 21 | 22 23 24 | 25 26 27
---------+----------+---------
28 29 30 | 31 32 33 | 34 35 36
37 38 39 | 40 41 42 | 43 44 45
46 47 48 | 49 50 51 | 52 53 54
---------+----------+---------
55 56 57 | 58 59 60 | 61 62 63
64 65 66 | 67 68 69 | 70 71 72
73 74 75 | 76 77 78 | 79 80 81
Where a single cell is, e.g.
1 2 3
10 11 12
19 20 21
A cell always holds same amount of elements as a row or column.
> data MyGrid a = MyGrid { _cell :: Int -- size of cell in grid, whole grid
> -- is a square of width `cell^2`
> , _vect :: V.Vector a -- internal data storage
> }
> makeLenses ''MyGrid
Convert 2D index of given representation and cell size to internal
> reduce_index_dimension :: Access -> Int -> (Int, Int) -> Int
> reduce_index_dimension a s (x,y) =
> case a of
> Cells -> (y`rem`s)
> + (x`rem`s) * s
> + (y`quot`s) * s^2
> + (x`quot`s) * s^3
> Rows -> x * s * s + y
> Columns -> y * s * s + x
Convert internal index for given representation and cell size to 2D
> increase_index_dimension :: Access -> Int -> Int -> (Int, Int)
> increase_index_dimension a s i =
> case a of
> Cells -> ( s * i `quot` s^3
> + (i `rem` s^2) `quot` s
> , s * ((i `quot` s^2) `rem` s)
> + i `rem` s )
> Rows -> ( i `rem` s^2
> , i `quot` s^2)
> Columns -> ( i `quot` s^2
> , i `rem` s^2)
Constructs a grid from a list, while making sure no elements are lost.
> fromList :: [a] -> MyGrid a
> fromList ls = MyGrid { _cell = if side'^2 == length ls
> then if cell'^2 == side'
> then cell'
> else error "can't represent cell as a square"
> else error "can't represent list as a square"
> , _vect = V.fromList ls } where
> side' = floor . sqrt . fromIntegral . length $ ls -- grid width
> cell' = floor . sqrt . fromIntegral $ side' -- cell width
Convert given representation to internal
> convert :: Access -> [[a]] -> [a]
> convert from list = map snd
> . sortBy compare_index
> . map reduce_index
> . concatMap prepend_index
> . zip [0..] $ list
> where
> size = floor . sqrt . fromIntegral . length $ list
> prepend_index (a, xs) = zipWith (\b c -> ((a, b), c)) [0..] xs
> reduce_index (i, x) = (reduce_index_dimension from size i, x)
> compare_index (i, _) (j, _) = compare i j
Constructs a grid from another grid, taking representation into account
> fromListsAs :: Access -> [[a]] -> MyGrid a
> fromListsAs a l = MyGrid { _cell = if allEqualLength l
> then if cell'^2 == side'
> then cell'
> else error "can't represent cell as a square"
> else error "lists have different length or do not fit"
> , _vect = V.fromList . convert a $ l } where
> side' = length l
> cell' = floor . sqrt . fromIntegral $ side' -- cell width
> allEqualLength xs = and $ map ((== side') . length) (tail xs)
combining lenses over same object, see Haskell use first level lenses to create complex lens
> (x ^>>= f) btofb s = f (s ^. x) btofb s
lens to focus at element poited to in given representation with given 2d index
> lens_as a i = cell ^>>= \s -> vect . sliced (reduce_index_dimension a s i) 1 . ix 0
convert to 2d representation
> toListsAs :: MyGrid a -> Access -> [[a]]
> toListsAs g a = [[fromJust $ g^?(lens_as a (x, y)) | y <- [0..n]] | x <- [0..n]]
> where n = (g^.cell)^2 - 1
defaults
> toLists :: MyGrid a -> [[a]]
> toLists g = g `toListsAs` Rows
> instance Show a => Show (MyGrid a) where
> show grid = unlines . map show . toLists $ grid
> instance Functor MyGrid where
> fmap f grid = grid & vect %~ V.map f
sanity check
> main = mapM_ (putStrLn . show) (fromList [0..(+80)0] `toListsAs` Cells)
An inefficient implementation perhaps trigger better ideas
column,row :: Int -> [((Int,Int),a)] -> [a]
column n xs = map snd $ filter (\((_,y),_) -> y==n) xs
row n xs = map snd $ filter (\((x,_),_) -> x==n) xs
cell :: Int -> Int -> [((Int,Int),a)] -> [a]
cell n m xs = map snd $ filter (\((x,y),_) -> (div x 2 == n) && (div y 2==m)) xs
here indexing the elements of 4x4 matrix
> let a = zipWith (\x y -> ((div y 4,mod y 4),x)) [0..15] [0..]
cells are 2x2 blocks
> cell 1 1 a
[10,11,14,15]
> cell 0 0 a
[0,1,4,5]
> column 2 a
[2,6,10,14]
> row 1 a
[4,5,6,7]
I'm solving the Brigde and torch problem
in Haskell.
I wrote a function that given a state of the puzzle, as in which people have yet to cross and those who have crossed, gives back a list of all possible moves from one side to the other (moving two people forwards and one person backwards).
module DarkBridgeDT where
data Crossing = Trip [Float] [Float] Float deriving (Show)
data RoundTrip = BigTrip Crossing Crossing deriving (Show)
trip :: [Float] -> [Float] -> Float -> Crossing
trip x y z = Trip x y z
roundtrip :: Crossing -> Crossing -> RoundTrip
roundtrip x y = BigTrip x y
next :: Crossing -> [RoundTrip]
next (Trip [] _ _) = []
next (Trip (a:b:[]) s _ )
|a>b = [BigTrip (Trip [] (a:b:s) a) (Trip [] [] 0)]
|otherwise = [BigTrip (Trip [] (b:a:s) b) (Trip [] [] 0)]
next (Trip d s _) = [BigTrip (Trip [x,z] (i:j:s) j) b | i <- d, j <- d, i < j, x <- d, z <- d, x < z, z /= i, z /= j, x /= z, x /= i, x /= j, b <- (back [x,z] (i:j:s))]
where
back [] s = []
back d s = [Trip (i:d) (filter (/= i) s) i | i <- s]
Now I need a function that given a state as the one above and a maximum amount of time gives back all possible solutions to the puzzle in less than that given time.
All I have for that is this:
cross :: Crossing -> Float -> [[RoundTrip]]
cross (Trip [] _ _) _ = []
cross (Trip _ _ acu) max
| acu > max = []
cross (Trip a b acu) max = map (cross (map (crec) (next (Trip a b acu)) acu)) max
where
crec (BigTrip (Trip _ _ t1) (Trip a b t2)) acu = (Trip a b (t1+t2+acu))
Of course that doesn't compile, the 5th line is the one that's driving me insane. Any input?
Edit:
The cross function is meant to apply the next function to every result of the last nextfunction called.
If the first result of next was something like: [A,B,C,D] then it would call next on A B C and D to see if any or all of those get to a solution in less than max (A B C and D would be Crossings inside which contain the floats that are the time that ads up and is compared to max).
My data structure is
Crossing: Contains the first side of the bridge (the people in it represented by the time they take to cross the bridge) the other side of the bridge (the same as the other) and a time that represents the greatest time that last crossed the bridge (either the greatest of the two in the first crossing or the only one in the second) or the amount of time acumulated crossing the bridge (in the cross function).
RoundTrip: Represents two crossings, the first and the second, the one getting to safety and the one coming back to danger.
cross (Trip [1,2,5,10] [] 0) 16 should give an empty list for there is no solution that takes less than 17 minutes (or whatever time unit).
cross (Trip [1,2,5,10] [] 0) 17 should give the normal solution to the puzzle as a list of roundtrips.
I hope that makes it clearer.
Edit2:
I finally got it. I read Carsten's solution before I completed mine and we laid it out practically the same. He used fancier syntax and more complex structures but it's really similar:
module DarkBridgeST where
data Torch = Danger | Safety deriving (Eq,Show)
data State = State
[Float] -- people in danger
[Float] -- people safe
Torch -- torch position
Float -- remaining time
deriving (Show)
type Crossing = [Float]
classic :: State
classic = State [1,2,5,10] [] Danger 17
next :: State -> [Crossing] -- List all possible moves
next (State [] _ _ _) = [] -- Finished
next (State _ [] Safety _) = [] -- No one can come back
next (State danger _ Danger rem) = [[a,b] | a <- danger, b <- danger, a /= b, a < b, max a b <= rem]
next (State _ safe Safety rem) = [[a] | a <- safe, a <= rem]
cross :: State -> Crossing -> State -- Crosses the bridge depending on where the torch is
cross (State danger safe Danger rem) cross = State (taking cross danger) (safe ++ cross) Safety (rem - (maximum cross))
cross (State danger safe Safety rem) cross = State (danger ++ cross) (taking cross safe) Danger (rem - (maximum cross))
taking :: [Float] -> [Float] -> [Float]
taking [] d = d
taking (x:xs) d = taking xs (filter (/=x) d)
solve :: State -> [[Crossing]]
solve (State [] _ _ _) = [[]]
solve sf = do
c <- next sf
let sn = cross sf c
r <- solve sn
return (c:r)
All in all thanks everyone. I'm new to Haskell programming and this helped me understand a lot of things. I hope this post can also help someone starting haskell like me one day :)
I'm not going to leave much of your code intact here.
The first problems are with the data structures. Crossing doesn't actually represent anything to do with crossing the bridge, but the state before or after a bridge crossing. And you can't use RoundTrip because the number of bridge crossings is always odd.
I'm renaming the data structure I'm actually keeping, but I'm not keeping it unmodified.
data Bank = Danger | Safety deriving (Eq,Show)
data PuzzleState = PuzzleState
[Float] -- people still in danger
[Float] -- people on the safe bank
Bank -- current location of the torch
Float -- remaining time
type Crossing = ([Float],Bank)
Modifying/writing these functions is left as an exercise for the reader
next :: PuzzleState -> [Crossing] -- Create a list of possible crossings
applyCrossing :: PuzzleState -> Crossing -> PuzzleState -- Create the next state
Then something like this function can put it all together (assuming next returns an empty list if the remaining time is too low):
cross (PuzzleState [] _ _ _) = [[]]
cross s1 = do
c <- next s1
let s2 = applyCrossing s1 c
r <- cross s2
return $ c : r
Just for the fun, an approach using a lazy tree:
import Data.List
import Data.Tree
type Pawn = (Char, Int)
data Direction = F | B
data Turn = Turn {
_start :: [Pawn],
_end :: [Pawn],
_dir :: Direction,
_total :: Int
}
type Solution = ([String], Int)
-- generate a tree
mkTree :: [Pawn] -> Tree Turn
mkTree p = Node{ rootLabel = s, subForest = branches s }
where s = Turn p [] F 0
-- generates a node for a Turn
mkNode :: Turn -> Tree Turn
mkNode t = Node{ rootLabel = t, subForest = branches t }
-- next possible moves
branches :: Turn -> [Tree Turn]
-- complete
branches (Turn [] e d t) = []
-- moving forward
branches (Turn s e F t) = map (mkNode.turn) (next s)
where
turn n = Turn (s\\n) (e++n) B (t+time n)
time = maximum . map snd
next xs = [x| x <- mapM (const xs) [1..2], head x < head (tail x)]
-- moving backward
branches (Turn s e B t) = map (mkNode.turn) e
where
turn n = Turn (n:s) (delete n e) F (t+time n)
time (_,b) = b
solve :: Int -> Tree Turn -> [Solution]
solve limit tree = solve' [] [] limit tree
where
solve' :: [Solution] -> [String] -> Int -> Tree Turn -> [Solution]
solve' sols cur limit (Node (Turn s e d t) f)
| and [t <= limit, s == []] = sols ++ [(cur++[step],t)]
| t <= limit = concat $ map (solve' sols (cur++[step]) limit) f
| otherwise = []
where step = "[" ++ (v s) ++ "|" ++ (v e) ++ "]"
v = map fst
Then you you can get a list of solutions:
solve 16 $ mkTree [('a',2), ('b',4), ('c',8)]
=> [(["[abc|]","[c|ab]","[ac|b]","[|bac]"],14),(["[abc|]","[c|ab]","[bc|a]","[|abc]"],16),(["[abc|]","[b|ac]","[ab|c]","[|cab]"],14),(["[abc|]","[a|bc]","[ba|c]","[|cab]"],16)]
Or also generate a tree of solutions:
draw :: Int -> Tree Turn -> Tree String
draw limit (Node (Turn s e d t) f)
| t > limit = Node "Time Out" []
| s == [] = Node ("Complete: " ++ step) []
| otherwise = Node step (map (draw limit) f)
where step = "[" ++ (v s) ++ "|" ++ (v e) ++ "]" ++ " - " ++ (show t)
v = map fst
Then:
putStrLn $ drawTree $ draw 16 $ mkTree [('a',2), ('b',4), ('c',8)]
Will result in:
[abc|] - 0
|
+- [c|ab] - 4
| |
| +- [ac|b] - 6
| | |
| | `- Complete: [|bac] - 14
| |
| `- [bc|a] - 8
| |
| `- Complete: [|abc] - 16
|
+- [b|ac] - 8
| |
| +- [ab|c] - 10
| | |
| | `- Complete: [|cab] - 14
| |
| `- [cb|a] - 16
| |
| `- Time Out
|
`- [a|bc] - 8
|
+- [ba|c] - 12
| |
| `- Complete: [|cab] - 16
|
`- [ca|b] - 16
|
`- Time Out