Haskell -- Generate Coordinates From Ends of the Path - haskell

I have an input of [ ( (Int,Int) , (Int,Int) ) ] which is the coordinate of the ends of the path. All paths run either horizontally (same y-value for both ends) or vertically (same x-value for both ends).
So I want to write a function that generates all the coordinates of the path from the input.
For example, the input pair of ends is [((0, 0), (0, 3)), ((0, 2), (2, 2))](this is two paths), the output of the function I need is [[(0, 0), (0, 1), (0, 2), (0, 3)], [(0, 2), (1, 2), (2, 2)]]
getPaths :: [ ( (Integer,Integer) , (Integer,Integer) ) ] -> [[(Integer,Integer)]]
getPaths [((xa, ya), (xb, yb))]
| xa == xb : [(xa, yb + 1) | yb < ya]++
| xa == xb : [(xa, ya + 1) | ya < yb]++
| ya == yb : [(xa + 1, ya) | xa < xb]++
| ya == yb : [(xb + 1, ya) | xb < xa]++
I'm not sure if its right, could anyone have a look at it?

I think it is better to first make a function that works with a single pair of coordinates:
path :: ((Int, Int), (Int, Int)) -> [(Int, Int)]
path = …
then getPaths is just a mapping of this:
getPaths :: [((Int, Int), (Int, Int))] -> [[(Int, Int)]]
getPaths = map path
as for the path, you can make use of ranges, indeed [x₁ .. x₂] will produce all (integral) values between x₁ and x₂ (both inclusive).
The function thus can be constructed with list comprehension with:
path :: ((Int, Int), (Int, Int)) -> [(Int, Int)]
path ((x₁, y₁), (x₂, y₂)) = [ … | … <- …, … <- … ]
where you still need to fill in the … parts.

Related

Haskell Snake program move fuction

I need to do a project in Haskell, which does a snake program, but I'm stuck the last part.
These two test case should give True, but I dont have an idea how should I do that:
doInstruction Move (North, [(5, 7), (5, 6)], 2) == (North, [(5, 8), (5, 7)], 2)
doInstruction Move (East, [(2, 1), (1, 1), (1, 0)], 3) == (East, [(3, 1), (2, 1), (1, 1)], 3)
My code until that part
data Dir = West | North | East | South deriving (Eq, Show)
type Position = (Int, Int)
type Snake = (Dir, [Position], Int)
data Instruction = Move | Turn Dir deriving (Eq, Show)
isOppositeDir :: Dir -> Dir -> Bool
isOppositeDir West East = True
isOppositeDir East West = True
isOppositeDir North South = True
isOppositeDir South North = True
isOppositeDir _ _ = False
oppositeDir :: Dir -> Dir
oppositeDir West = East
oppositeDir East = West
oppositeDir North = South
oppositeDir South = North
nextPos :: Dir -> Position -> Position
nextPos x (a,b)
| x == West = (a - 1 , b)
| x == East = (a + 1 , b)
| x == North = (a , b + 1)
| x == South = (a , b - 1)
| otherwise = (a , b)
doInstruction :: Instruction -> Snake -> Snake
doInstruction (Turn dir) (x, p, y) = if isOppositeDir dir x then (x,p,y) else (dir,p,y)
The following is in no way a complete implementation of doInstruction, but should enable you to move forward. It passes your two test cases.
Just show me the code
Okay, here's a partial implementation of doInstruction:
doInstruction :: Instruction -> Snake -> Snake
doInstruction Move (currDir, p#(x:_), l) = (currDir, take l $ nextPos currDir x : p, l)
If you load it into GHCi, it'll pass the two test cases from the OP:
> doInstruction Move (North, [(5, 7), (5, 6)], 2) == (North, [(5, 8), (5, 7)], 2)
True
> doInstruction Move (East, [(2, 1), (1, 1), (1, 0)], 3) == (East, [(3, 1), (2, 1), (1, 1)], 3)
True
It'll still crash on lots of other input because it doesn't handle e.g. Turn instructions.
Explanation
doInstruction Move handles the Move instruction exclusively. (currentDir, p#(x:_), l) pattern-matches the snake's current direction, it's positions, and it's length (I'm assuming that the last integer is the length).
The p# syntax captures the entire position into the variable p. The function also needs the head of the list, so it also uses pattern matching on the list. Here, it matches only the head and ignores the tail: (x:_). The underscore is the wildcard character that ignores the match, in this case the tail.
This pattern match is also partial, because it's not going to match an empty list. You probably don't allow snakes of zero length, but if you did, this wouldn't match.
The function uses nextPos to calculate the next position of the head of the snake. It conses (uses :) the resulting Position value onto the p list. This in itself creates a list that's too long, but then the function uses take l to take only the first l elements of that list.
Next steps
You should add more cases to the doInstruction function, e.g.
doInstruction :: Instruction -> Snake -> Snake
doInstruction Move (currDir, p#(x:_), l) = (currDir, take l $ nextPos currDir x : p, l)
doInstruction (Turn dir) snake = -- More code goes here...

Haskell - Tree Recursion - Out Of Memory

The following code with any real-logic "hollowed out" still runs out of memory when compiled on GHC 7.10.3 with the -O flag. I do not understand why a simple tree recursion with at-most a stack-depth of 52 (number of cards in a standard deck) needs so much memory. I tried using seq on the result variables, but that did not help. Could someone take a look and let me know why the memory usage is so high, and what can I do to avoid it?
import qualified Data.Map.Strict as M
type Card = (Int, Char)
compute_rank_multiplicity_map :: [Card] -> M.Map Int Int
compute_rank_multiplicity_map cards = M.fromList [(x, x) | (x, _) <- cards]
determine_hand :: [Card] -> (Int, [(Int, Int)])
determine_hand [] = error "Card list is empty!"
determine_hand cards = (0, mult_rank_desc_list)
where rank_mult_map = compute_rank_multiplicity_map cards
mult_rank_desc_list = M.toDescList rank_mult_map
check_kicker_logic :: [Card] -> (Int, Int)
check_kicker_logic cards =
let first_cards = take 5 cards
second_cards = drop 5 cards
first_hand#(f_h, f_mrdl) = determine_hand first_cards
second_hand#(s_h, s_mrdl) = determine_hand second_cards
in if (first_hand > second_hand) || (first_hand < second_hand) -- is there a clear winner?
then if (f_h == s_h) && (head f_mrdl) == (head s_mrdl) -- do we need kicker logic?
then (1, 1)
else (0, 1)
else (0, 0)
card_deck :: [Card]
card_deck = [(r, s) | r <- [2 .. 14], s <- ['C', 'D', 'H', 'S']]
need_kicker_logic :: [Card] -> (Int, Int)
need_kicker_logic cards = visit_subset cards (length cards) [] 0 (0, 0)
where visit_subset a_cards num_a_cards picked_cards num_picked_cards result#(num_kicker_logic, num_clear_winners)
| num_cards_needed == 0 = (num_kicker_logic + nkl, num_clear_winners + ncw)
| num_cards_needed > num_a_cards = result
| otherwise = let result_1 = visit_subset (tail a_cards)
(num_a_cards - 1)
picked_cards
num_picked_cards
result
result_2 = visit_subset (tail a_cards)
(num_a_cards - 1)
((head a_cards) : picked_cards)
(num_picked_cards + 1)
result_1
in result_2
where num_cards_needed = 10 - num_picked_cards
(nkl, ncw) = check_kicker_logic picked_cards
main :: IO ()
main =
do
putStrLn $ show $ need_kicker_logic card_deck

Transforming Towers Of Hanoi Movement Sequence To Configuration Sequence

As part of some "self imposed homework" on Haskell study, I did the classic solution of the Towers of Hanoi:
doHanoi :: Int -> Int -> Int -> [(Int, Int)]
doHanoi 0 _ _ = []
doHanoi n from to = first ++ [(from, to)] ++ last
where
using = 3 - from - to;
first = doHanoi (n - 1) from using;
last = doHanoi (n - 1) using to
(where the meaning of doHanoi n from to using get the asequence of movements assuming the disks 0.. n - 1 are at peg from, and we need to move them to peg to.)
This gives the sequence of movements, e.g.,
>>> doHanoi 3 0 2
[(0,2),(0,1),(2,1),(0,2),(1,0),(1,2),(0,2)]
I then wanted to see if I could transform the output into the set of configurations (i.e., initially, all rings are on the left peg, then there are intermediate configurations, finally all rings are on the right peg). I could do this by writing a changeConfig function
changeConfig :: [[Int]] -> (Int, Int) -> [[Int]]
changeConfig [e0:e0s, e1s, e2s] (0, 1) = [e0s, e0:e1s, e2s]
changeConfig [e0:e0s, e1s, e2s] (0, 2) = [e0s, e1s, e0:e2s]
changeConfig [e0s, e1:e1s, e2s] (1, 0) = [e1:e0s, e1s, e2s]
changeConfig [e0s, e1:e1s, e2s] (1, 2) = [e0s, e1s, e1:e2s]
changeConfig [e0s, e1s, e2:e2s] (2, 0) = [e2:e0s, e1s, e2s]
changeConfig [e0s, e1s, e2:e2s] (2, 1) = [e0s, e2:e1s, e2s]
then using scanl:
>>> scanl changeConfig [[0.. 2], [], []] (doHanoi 3 0 2 1)
[[[0,1,2],[],[]],[[1,2],[],[0]],[[2],[1],[0]],[[2],[0,1],[]],[[],[0,1],[2]],[[0],[1],[2]],[[0],[],[1,2]],[[],[],[0,1,2]]]
While this works, I think I'm missing something in changeConfig: this is just an exhaustive enumeration of all configurations, in a setting that has some form of cyclic symmetry, that happened to work because there are three pegs, and would not scale well (in terms of LOC). What is the "Haskellic" way to write it?
Thanks to kind help by chepner and jberryman, here's what I came up with.
The function finding the movements is unchanged:
doHanoi :: Int -> Int -> Int -> [(Int, Int)]
doHanoi 0 _ _ = []
doHanoi n from to = first ++ [(from, to)] ++ last
where
using = 3 - from - to;
first = doHanoi (n - 1) from using;
last = doHanoi (n - 1) using to
Now an auxiliary function, changePeg es i from to new_e returns the output to peg i assuming it contained elements es, its index was i, the movement was from from to to, and of element new_e.
changePeg :: [Int] -> Int -> Int -> Int -> Int -> [Int]
changePeg es i from to new_e
| i == from = tail es
| i == to = new_e: es
| otherwise = es
Using this, changeConfig becomes
changeConfig :: [[Int]] -> (Int, Int) -> [[Int]]
changeConfig es (from, to) = new_es where
new_e = head $ es !! from;
new_es = [changePeg (es !! i) i from to new_e | i <- [0.. 2]]
As before, the solution can be found with
>>> scanl changeConfig [[0.. 2], [], []] (doHanoi 3 0 2)
[[[0,1,2],[],[]],[[1,2],[],[0]],[[2],[1],[0]],[[2],[0,1],[]],[[],[0,1],[2]],[[0],[1],[2]],[[0],[],[1,2]],[[],[],[0,1,2]]]

Cartesian Plane

I'm trying to define a function in Haskell that takes an integer argument c and returns the list of all points on the cartesian plane of the form (x/c,y/c) where x and y are integers.
x/c is between -2 and 1 and y/r is between -1 and 1
This is what I've gotten so far which I'm almost sure is right but I'm getting a parse error on input = when I run it particularly at this line: cart xs ys c = [(y/c,x/c) | x <- xs, y <- ys]
plane :: Int -> [a]
plane c = cart [-1*c .. 1*c] [-2*c .. 1*c] c
cart xs ys c = [(y/c,x/c) | x <- xs, y <- ys]
A sample output would be: plane 1 would generate:
[(-2.0, -1.0), (-1.0, -1.0), ( 0.0, -1.0), ( 1.0, -1.0),
(-2.0, 0.0), (-1.0, 0.0), ( 0.0, 0.0), ( 1.0, 0.0),
(-2.0, 1.0), (-1.0, 1.0), ( 0.0, 1.0), ( 1.0, 1.0)]
Anyone have any idea how I can fix this! Thanks
you are missing the where, other than that it looks like you have some type errors.
[a] is too general
/ only works on fractional types.
so
plane :: Int -> [(Int,Int)]
plane c = cart [-1*c .. 1*c] [-2*c .. 1*c] c where
cart xs ys c = [(y `div` c,x `div` c) | x <- xs, y <- ys]
might be what you want. Smallest change from what you have that more or less works.
This is how I'd do it. fromintegral is a type 'glue' function that converts any value in the Integral type class to any other type in the Num typeclass. The result type has to be in RealFrac (like Double or Rational) to use the / operator.
plane :: (Integral a, RealFrac b) => a -> [(b,b)]
plane d = [(fI y / fI d,fI x / fI d) | x <- [-2*d..d], y <- [-d..d]]
where fI = fromIntegral

Comparing Bool Value in Matrix

t = True
f = False
anzNachbarn :: [[Bool]] -> (Integer,Integer) -> Integer
anzNachbarn a (x,y)
| x < 0 || y < 0=-1
| otherwise ... here comes the comparison
This is an example matrix:
[[True,False,False],
[True,False,False],
[False,True,False]]
here i need an algorithm, where it calculates (for given x and y position in matrix) its neighbours (only "true" neighboors) and increase it by 1 for each true neighboor.
For example: anzNachbarn [[True,False,False],[True,False,False],[False,True,False]] (0,1)
returns 2 back.
:Edit
I still have a question how can I now implement each component of the result matrix, the number of named elements with True neighboring fields indicates the corresponding component of the argument matrix Applies to
[[True, False, False],
[True, False, False],
[False, True , False]]
the function func returns the results matrix [[1,2,0], [2,3,1], [2,1,1]]
with signature func :: [[Bool]] -> [[Integer]]
have you got any idea about this ?
You almost certainly want to use an array (from Data.Array) in this situation, since looking up an item in a list by its index is very slow.
Here's a quick implementation using Array:
countNeighbors :: Array (Int, Int) Bool -> (Int, Int) -> Int
countNeighbors board (x, y) = length
[ (x', y')
| x' <- [x - 1, x, x + 1]
, y' <- [y - 1, y, y + 1]
, x' /= x || y' /= y
, inRange (bounds board) (x', y')
, board ! (x', y')
]
This is a list comprehension with two generators and three guards. The generators simply give us the indices of the nine positions in a three-by-three square centered at (x, y) (you'll need a minor change if you don't want neighbors at the corners to be considered).
The first guard (x' /= y') ignores (x, y) itself. The second throws out positions that aren't within the bounds of the array. The final guard throws out positions that are in the array but have a False value.
So we now have a list of indices for the neighbors with True values. The length of this list is the desired count.
This is ugly, but seems to work...
anzNachbarn :: [[Bool]] -> (Int,Int) → Integer
anzNachbarn a (x,y)
| x < 0 || y < 0 = -1
| otherwise = sum [v x' y' | x' <- [max 0 (x-1)..x+1],
y' <- [max 0 (y-1)..y+1],
x ≠ x' || y ≠ y' ]
where v i j = if j >= length a
|| i >= length (a !! 0)
|| not (a !! j !! i)
then 0 else 1
[Edit]
In order to convert the whole array, you can write the equally ugly
conv a = [line y | y <- [0 .. (length a) - 1]]
where line y = [anzNachbarn a (x,y) | x <- [0 .. ((length (a !! 0) - 1)]]
Note that the performance of this is terrible.

Resources