count continuous squares from a certain square - haskell

First of all, I have a board (10 x 10) and a list of specific coordinates, I'm trying to write a function that gets a certain coordinate and a list of specific coordinates and counts how many squares from that list is connected. e.g. let's say I send coordinate ('C', 5) and list [('C', 5), ('D', 5), ('D', 6), ('A', 4)], the function should return [('C', 5), ('D', 5), ('D', 6)] because all of the coordinates are connected. It would seem easy at object orientated programming but I cant figure a way to do that in functional programming.

something like this?
connected p = map fst . filter ((<=1).snd) . map (liftA2 (,) id (dist p))
where dist (a,x) (b,y) = max (abs (fromEnum a - fromEnum b)) (abs (y-x))
find the elements where max axis distance is less or equal to one, that is the cell itself or immediate neighbors. Perhaps can be written in a shorter way.
> connected ('C',5) [('C', 5), ('D', 5), ('D', 6), ('A', 4)]
should return
[('C',5), ('D',5), ('D',6)]

It's possible to use applicative style to generate the neighborhood then filter with elem. I used pred and succ to handle Enum instances (e.g. Integer, and Char):
filterConn :: (Char,Integer) -> [(Char,Integer)] -> [(Char,Integer)]
filterConn (r,c) = filter (`elem` genNeighborhood)
where
genNeighborhood = (,) <$> [pred r, r, succ r] <*> [pred c, c, succ c]
Furthermore, to obey bounds like a 10x10 board, I would define custom myPred, mySucc functions that only increment or decrement while obeying the bounds (note there will be duplicates when near a bound):
myPred :: (Enum a, Ord a) => a -> a -> a
myPred bound val = if pred val >= bound then pred val else val
mySucc :: (Enum a, Ord a) => a -> a -> a
mySucc bound val = if succ val <= bound then succ val else val
Then just drop in myPred and mySucc to genNeighborhood with their respective bounds like so:
genNeighborhood = (,) <$> [myPred 'A' r, r, mySucc 'J' r] <*> [myPred 1 c, c, mySucc 10 c]
Finally, use length to count how many squares are connected:
countConn s sqs = length $ filterConn s sqs
References: LYAH, Prelude

Related

Join elements with list with some same attributes

I have a list with the type `[(Int, Char, Int)]'. E.g:
[(1, 'x', 1), (1, 'y', 2), (2, 'x', 1)]
The first Int is the number of times the Char appears and the second Int is to differentiate the same char from each other. For example, there could be x1 and x2.
I want to join elements of that list that have the same 2nd and 3rd element. In the case of the list above, it would become [(3, 'x', 1), (1, 'y', 2)] (the first and third tuples from the initial list were added together).
I've looked into zipWith and list comprehensions, but none of them seem to work. Is there any other way that I'm not thinking about that might work here?
The two functions you want to use are Data.List.sortBy and Data.List.groupBy.
If we sort by comparing the second and third elements of each tuple, we get the entries in the list sorted by variable and exponent. This is accomplished by passing a lambda which uses pattern macthing to extract and compare just those elements.
import Data.List
lst = [(1, 'x', 1), (1, 'y', 2), (2, 'x', 1)]
lst' = sortBy (\(_, a, b) (_, a', b') -> (a,b) `compare` (a',b')) lst
-- [(1,'x',1), (2,'x',1), (1,'y',2)]
Now we need to group based on the second and third values. groupBy will not work the way you need on an unsorted list, so don't skip that step.
The lambda being passed to groupBy here should look very familiar from the previous example.
lst'' = groupBy (\(_, a, b) (_, a', b') -> a == a' && b == b') lst'
-- [[(1,'x',1), (2,'x',1)], [(1,'y',2)]]
Now summing the first elements of the tuples and incorporating the other information is trivial with list comprehensions.
We get the variable and exponent info from the first element in the list and bind those to x and y respectively, then sum up the first coefficients and build a new tuple.
[let (_,x,y) = lst!!0 in (sum [c | (c,_,_) <- lst], x, y) | lst <- lst'', not (null lst)]
-- [(3,'x',1), (1,'y',2)]
First of all, I would suggest working with more meaningful domain types. A 3-tuple of built-in types could mean a lot of different things. By defining a new type and naming the components, you make everything clearer and prevent mistakes like getting the two Ints mixed up:
type Power = Int
type Coefficient = Int
data Exp var = Exp var Power deriving (Show, Eq, Ord)
data Term var = Term Coefficient (Exp var) deriving Show
What you're doing looks a lot to me like combining terms in polynomials, so I've defined types that make sense in that context. You may prefer different names, or a different structure, if you're actually doing something else.
Now you're looking for a function of type [Term Char] -> [Term Char], which groups together like Exps. Generally Data.Map.fromListWith is a great tool for grouping list items together by a key:
import qualified Data.Map as M
combine :: Ord a => [Term a] -> M.Map (Exp a) Coefficient
combine = M.fromListWith (+) . map toTuple
where toTuple (Term coef exp) = (exp, coef)
Then all that's left is to re-inflate the Map we've extracted to a list again:
simplify :: Ord a => [Term a] -> [Term a]
simplify = map fromTuple . M.assocs . combine
where fromTuple (exp, coef) = Term coef exp
And indeed, we get the grouping you hoped for:
*Main> simplify [Term 1 (Exp 'x' 1), Term 1 (Exp 'y' 2), Term 2 (Exp 'x' 1)]
[Term 3 (Exp 'x' 1),Term 1 (Exp 'y' 2)]

Implementing Prim's algorithm in Haskell

I facing difficulties implementing prim's algorithm, my logic is quite wrong, this is what I got so far:
import Data.Array
import Data.Function (on)
import Data.List (sortBy, delete)
type Vertex = Int
type Weight = Int
type Graph = Array Vertex [(Vertex, Weight)]
type Bounds = (Vertex, Vertex)
type Edge = (Vertex, Vertex, Weight)
g1 = mkGraph (1, 4) [(1, 2, 1), (1, 3, 10), (1, 4, 3), (2, 3, 4), (2, 4, 10), (3, 4, 1)] -- 5
g2 = mkGraph (1, 5) [(1, 2, 15), (1, 3, 10), (2, 3, 1), (3, 4, 3), (2, 4, 5), (4, 5, 20)] -- 34
mkGraph :: Bounds -> [Edge] -> Graph
mkGraph bounds edges = accumArray (\xs x -> x:xs) [] bounds [ (x, (y, w)) | (x, y, w) <- edges]
--[(1,[(4,3),(3,10),(2,1)]),(2,[(4,10),(3,4)]),(3,[(4,1)]),(4,[])]
prim :: Graph -> Vertex -> [(Vertex, Weight)]
prim graph start = prim' (sortBy (compare `on` snd) (graph ! start)) [start] []
where
prim' [] _ mst = mst
prim' (x:xs) visited mst
| elem (fst x) visited = prim' xs visited mst
| otherwise = prim' (delete x $ sortBy (compare `on` snd) ((graph ! (fst x)) ++ xs)) ((fst x):visited) (x:mst)
My idea was, if I put every edge that is possible to reach from the vertice start (let's say that is 1) pick the minimum (in this case is the first element from that list, because it's sorted), pick it's first element from the tuple and use that as an index and also make all edges reachable from that vertice while adding the vertices reachable from the previous vertice too.
While doing this keeping track of the vertices visited, the problem is that if it reach the final vertice (it will be empty) then it will stop adding the edges and will use just the edges that was added already.
But this will not work either, because the way that I'm keeping tracking the visited vertices will skip something like [(1, 3, 10) (2, 3, 1)], because it will mark the vertice 3 as visited.
I think the issue is that your Graph representation as an array is implicitly "directed", so you need to take your input undirected graph and tabulate edges in both directions:
mkGraph :: Bounds -> [Edge] -> Graph
mkGraph bounds edges = accumArray (\xs x -> x:xs) [] bounds
[(x, (y, w)) | (x', y', w) <- edges, (x, y) <- [(x', y'), (y', x')]]
Now, the invariant for the recursion is that in:
prim' outgoing visited mst
the argument outgoing is the list of (vertex, weight) pairs of all directed, outgoing arrows from anywhere in the visited set to some other vertex (possibly including some arrows pointing to vertexes already in the visited set).
At each recursive step, you skip any such outgoing arrows to vertexes you've already visited, and when you find an unvisited vertex with minimum weight, you add that edge to your mst, add the unvisited vertex to those visited, and augment the set of outgoing arrows with any arrows outgoing from the newly visited vertex.
(In your code, you delete x, though there's no technical need to do this, as it'll be filtered out as part of the "already visited" check.)
With the above change to mkGraph, your prim seems to work correctly on g1, g2, and the graph:
g3 = mkGraph (1,3) [(1,3,10), (2,3,1)]

Indexed lenses for nested containers

How can I use lenses to obtain keys from multiple levels of nesting?
Consider the following types
data Outer = Outer { _outerMap :: Map String Inner }
data Inner = Inner { _innerMap :: Map Char Int }
makeLenses ''Outer
makeLenses ''Inner
and assume the following example value
example :: Outer
example = Outer $ Map.fromList
[ ("A", Inner $ Map.fromList [ ('a', 1), ('b', 2), ('c', 3) ])
, ("B", Inner $ Map.fromList [ ('a', 4), ('b', 6), ('c', 8) ])
, ("C", Inner $ Map.fromList [ ('a', 5), ('b', 7), ('c', 9) ])
]
Using lenses I can flatten example to a [Int] and filter the odd numbers as follows:
>>> example^..outerMap.folded.innerMap.folded.filtered odd
[1,3,5,7,9]
I can annotate the values with the inner key as follows:
>>> example^#..outerMap.folded.innerMap.ifolded.filtered odd
[('a',1),('c',3),('a',5),('b',7),('c',9)]
But how can I use lenses to annotate the values with both the outer and inner keys, to get the following result?
>>> _whatHere example
[(("A",'a'),1),(("A",'c'),3),(("C",'a'),5),(("C",'b'),7),(("C",'c'),9)]
The following attempt still only returns the inner keys:
>>> example^#..outerMap.ifolded.innerMap.ifolded.filtered odd
[('a',1),('c',3),('a',5),('b',7),('c',9)]
And the following attempt doesn't type-check
>>> example^..outerMap.ifolded.withIndex.alongside id (innerMap.ifolded.filtered odd.withIndex)
error:
• No instance for (Applicative
(Control.Lens.Internal.Getter.AlongsideRight
(Const (Data.Monoid.Endo [([Char], (Char, Int))])) [Char]))
An implementation without lenses might look something like this:
nolens :: Outer -> [((String, Char), Int)]
nolens =
filter (odd . snd)
. foldMap (\(k, i) -> (map (first (k, )) . Map.toList . _innerMap) i)
. Map.toList
. _outerMap
Use (<.>). It's just like (.), except it preserves the indices on both the left and the right. (.) itself (and its alias (.>)) preserves only the index of the RHS, unless the RHS is itself index-preserving, in which case the index comes from the LHS. The mnemonic is that the arrows point to the indices you'd like to save.
>>> example^#..outerMap.ifolded<.>innerMap.ifolded.filtered odd
[(("A",'a'),1),(("A",'c'),3),(("C",'a'),5),(("C",'b'),7),(("C",'c'),9)]

Generating all ways of applying a function to a single element with lens

This question is based on to the 11th advent of code task. It basically is a more general version of the river crossing puzzle, you can go up and down floors while carrying one or two items each step. The goal is to bring up all items to the 4th floor.
This is fairly straightforward to solve with an A* search but finding the neighboring states is somewhat annoying.
When solving the puzzle originally I just created masks for all items on the current floor and then used the list monad to generate the combinations - slow and awkward but it works. I figured that there would be an elegant solution using lenses, though.
An easy solution could use a function that returns all options of moving a single item from floor x to floor y. Is there a way to get all combinations of applying a function to a single element using lenses? i.e. f 1 2 [(1, 0), (1, 2)] = [[(2, 0) (1, 2)], [(1, 0), (2, 2)]]
For the sake of reference, this is the best I could come up with so far, slightly simplified:
import Control.Lens
import Data.List (sort)
import Data.Set (fromList, Set)
type GenFloor = Int
type ChipFloor = Int
type State = [(GenFloor, ChipFloor)]
neighborStates :: Int -> State -> Set State
neighborStates currentFloor state = finalize $ createStatesTowards =<< [pred, succ]
where
createStatesTowards direction = traverseOf (traverse . both) (moveTowards direction) state
moveTowards direction i
| i == currentFloor = [direction i, i]
| otherwise = [i]
finalize = fromList . map sort . filter valid
valid = (&&) <$> validCarry <*> validFloors
validCarry = (`elem` [1..2]) . carryCount
carryCount = length . filter (uncurry (/=)) . zip state
validFloors = allOf (traverse . each) (`elem` [1..4])
An easy solution could use a function that returns all options of moving a single item from floor x to floor y. Is there a way to get all combinations of applying a function to a single element using lenses? i.e. f 1 2 [(1, 0), (1, 2)] = [[(2, 0) (1, 2)], [(1, 0), (2, 2)]]
holesOf can do that. Quoting the relevant simplified signature from the documentation:
holesOf :: Traversal' s a -> s -> [Pretext' (->) a s]
Given a traversal, holesOf will generate a list of contexts focused on each element targeted by the traversal. peeks from Control.Comonad.Store can then be used to, from each context, modify the focused target and recreate the surrounding structure:
import Control.Lens
import Control.Comonad.Store
-- allMoves :: Int -> Int -> State -> [State]
allMoves :: (Traversable t, Eq a) => a -> a -> t (a, b) -> [t (a, b)]
allMoves src dst its = peeks (changeFloor src dst) <$> holesOf traverse its
where
-- changeFloor :: Int -> Int -> (Int, Int) -> (Int, Int)
changeFloor src dst = over both (\x -> if x == src then dst else x)
GHCi> allMoves 1 2 [(1,0),(1,2)]
[[(2,0),(1,2)],[(1,0),(2,2)]]

List of Pairs of Chars in Haskell?

Is there a function in Haskell where say if you supplied a Char, and a List of 13 Pairs of Chars (all different i.e. every letter of the alphabet was used once and only once) it would return you the Char which is paired with your inputted Char i.e. if I inputted the following:
pairedChar Q [(A,Z),(B,Y),(C,X),(D,W),(E,V),(F,U),(G,T),(H,S),(I,R),(J,Q),(K,P),(L,O),(M,N)]
I would like it to return J?
If there isn't a function like that I was thinking maybe of doing it with unzip to get a pair of lists but wasn't sure what to do with the lists after I get them?
The lookup function does this; not just for the kind of pairs you describe but for any list of two-element tuples. A list of such tuples is known as an association list, by the way.
It returns a Maybe, because there might beono match.
lookup :: Eq a => a -> [(a, b)] -> Maybe b
lookup key assocs
looks up a key in an association list
This answer builds on itsbruce's answer by still using lookup, but also first massaging the input list to include each pair twice, once for each ordering of elements.
Let's assume that your list is called pairs:
pairs :: [(Char, Char)]
pairs = [('A', 'Z'), ('B', 'Y'), ..., ('M', 'N')]
Then all you need to do is duplicate each pair and swap the elements:
import Data.Tuple (swap)
allPairs :: [(Char, Char)]
allPairs = pairs ++ map swap pairs
-- allPairs = [('A', 'Z') ... ('M', 'N'), ('Z', 'A'), ... ('N', 'M')]
... where swap is a function from Data.Tuple that takes the two elements of a tuple and swaps them. It's defined like this:
swap :: (a, b) -> (b, a)
swap (x, y) = (y, x)
Now you can do a lookup on the allPairs list:
pairedChar :: Char -> Maybe Char
pairedChar c = lookup c allPairs
If you want each duplicate pair to be adjacent to each other in the list, then you can also write allPairs like this:
allPairs = do
(x, y) <- pairs
[(x, y), (y, x)]
Now it will contain this ordering:
allPairs = [('A', Z'), ('Z', 'A'), ('B', 'Y'), ('Y', 'B') ... ('M', 'N'), ('N', 'M')]
You could just make a longer list.
alphabet = "ABCDEFGHIJKLMNOPQRTSUVXYZ"
pairs = zip alphabet (reverse alphabet)
theOtherChar k = lookup k pairs --does the job for you now.

Resources