I'm doing a small project in Haskell, and I'm having difficulty in checking if there is a Loop in a [Moviment].
data Moviment = goLeft | goRight | Jump | Box
deriving (Show, Read, Eq, Ord)
goLeft -> Makes the Player move to the left goRight -> Makes the
Player move to the right Jump -> Makes the Player jump a Box or a
Block Box -> Makes the Player load or unload a Box
data Piece = Block | Box | Door | Empty
deriving (Show, Read, Eq, Ord)
At first I created a code where I see if [goRight, goLeft, goRight] or [goLeft, goRight, goLeft] is in a list of Moviment.
verificaEliminar :: [Moviment] -> [Moviment] -> Bool
verificaEliminar (x:y:z:[]) l = if(length l < 3)
then False
else if(x == head l && y == head (tail l) && z == head (tail (tail l)))
then True
else verificaEliminar (x:y:z:[]) (tail l)
verificaEliminar _ _ = False
eliminaLoops :: [[Moviment]] -> [Moviment] -> [[Moviment]]
eliminaLoops (h:t) m = if(verificaEliminar m h == True)
then eliminaLoops t m
else h : eliminaLoops t m
eliminaLoops _ _ = []
But I quickly realised that I could have a Map where I needed to see if the 1st and the 3rd positions of the player are the same. Meaning that he didnot fell.
x :: Mapa
x = [[Bloco, Vazio, Vazio, Vazio, Vazio, Vazio],
[Vazio, Bloco, Vazio, Vazio, Vazio, Vazio],
[Vazio, Vazio, Vazio, Bloco, Vazio, Vazio],
[Vazio, Vazio, Vazio, Bloco, Vazio, Vazio],
[Vazio, Vazio, Bloco, Vazio, Vazio, Vazio],
[Vazio, Vazio, Vazio, Vazio, Vazio, Vazio],
[Vazio, Vazio, Vazio, Vazio, Vazio, Vazio],
[Vazio, Vazio, Vazio, Vazio, Porta, Vazio],
[Bloco, Bloco, Bloco, Bloco, Bloco, Bloco]]
More information if is needed:
data Direction = West | East
deriving (Show, Read, Eq, Ord)
data Player = Player Coordinates Direction Bool
deriving (Show, Read, Eq, Ord)
data Game = Game Map Player
deriving (Read, Eq)
type Coordinates = (Int, Int)
One plan, in broad strokes, looks like this:
Identify all of the state that gets updated by each Moviment. Presumably this is Game, but I'm not 100% sure of that.
Write a function that updates all of the state according to one Moviment; let's say you name it update, so that
update :: Game -> Moviment -> Game
You can use scanl to get a list of the Games corresponding to each prefix of a [Moviment].
You can now iterate over this [Game] looking for two equal states. There are various ways to do this, but take a look at the source of nub for some hints about one way to do this.
Once you have it working, you can start thinking about refactoring it to improve efficiency. Just switching from the ideas in nub to the ideas in ordNub would be one good first step. You might also consider whether the entire Mapa needs to be compared each time or whether you can reduce the amount of comparisons done there somehow. I suspect you can come up with your own ideas, too.
Related
I have a working Haskell example of how to do it when we want to add zeros to the left and to the right of a list as two separate functions, and I did it because I considered the possibility of safe transposition by using a different definition for the latter, which I will post here as well to ask whether or not it's important to have such concerns.
rectangular :: [[Integer]] -> [[Integer]]
rectangular m = rect m []
where
rect [] a = ([0]:a)
rect (l:[]) a = (l:a)
rect (l:j:ks) a
| length l < length j = rect ((0:l):(rect (j:ks) a)) a
| length l > length j = rect (l:(rect ((0:j):ks) a)) a
| otherwise = rect (l:a) (rect (j:ks) a)
The above is to add zeros to the left, so it should be obvious how to add to the right, and the transposition definition that I'm using for this is:
transposition :: [[a]] -> [[a]]
transposition m = transpose' m []
where
transpose' [] a = a
transpose' ([]:xss) a = transpose' xss a
transpose' ((x:xs):xss) a = transpose' a ((x:map head xss): transpose' (xs:map tail xss) a)
Now that the list of lists is rectangular, transposition should work without running into empty list calls, before it's run to the end with every row having the same number of columns. Is this useful or simply redundant? These are numbers, when it could be data, so should we run the risk of adding to it? That is, in case we redefined it to accept other types, or generalized the choice between left and right.
I'm currently practicing Haskell in a number of ways.
using lists to create a ton of fun things.
Now I'm (think) having problems with understanding if statements.
What I want to do is make a Focuslist that shifts the focus to the most left item.
Focuslists are already quite tricky, essentially being two independent lists.
And it also splits the whole list in half, and reverses the back list.
For instance. If you want to make a focuslist of [0,1,2,3,4,5], and want a focus on 3, The focuslist will be [3,4,5][2,1,0].
I've already made three specific functions.
One that makes the focuslist datatype:
data FocusList a = FocusList { forward :: [a], backward :: [a]}
With which you can call it by using
fromList :: [a] -> FocusList a
fromList list = FocusList list []
One that changes it back to a list from a focuslist:
toList :: FocusList a -> [a]
toList (FocusList fw bw) = reverse bw ++ fw
and one that shifts it to left once, changes [0,1,2,3,4,5] to [0,1,2,3,4,5] which now looks like [2,3,4,5][0,1] as focuslist:
goLeft :: FocusList a -> FocusList a
goLeft (FocusList fw (f:bw)) = FocusList (f:fw) bw
Now, to the main point. If I were to shift it all the way to the left. I want to use goLeft until the length of the list is 1. I was thinking of using a recursive if statement until the length of the first list equals to one. and using goLeft if it was not one.
So i thought of a simple if statement. Which (for now) doesn't work at all.
it uses leftMost :: FocusList a -> FocusList a
leftMost (FocusList fw (f:bw)) = if (length (FocusList fw) == 1)
then FocusList (f:fw) bw
return leftMost
else FocusList fw (f:bw)
I was thinking of it the pythonic way. Which doesn't seem to work. How do I make it logically recursive?
Don't use length, it costs O(N) since it has to scan the whole list. If you instead use pattern matching, in this case you only pay a O(1) cost.
A simple approach is to use two equations, which are tried one after the other one.
leftMost :: FocusList a -> FocusList a
-- if there's only one backward item, leave the list as it is
leftMost (FocusList fw [f]) = FocusList fw [f]
-- otherwise, goLeft, then recurse
leftMost fl = leftMost (goLeft fl)
The pattern [f] only matches lists with a single item. It's equivalent to (f:[]).
Note that the code above will crash if the backward part is empty. If that's an issue, you'll need to handle that by adding more equations.
Alternatively, one can shorten the code using an as-pattern:
leftMost :: FocusList a -> FocusList a
leftMost fl#(FocusList fw [f]) = fl -- fl is the whole input
leftMost fl = leftMost (goLeft fl)
We can also inline goLeft, if we wish:
leftMost :: FocusList a -> FocusList a
leftMost fl#(FocusList fw [f]) = fl
leftMost (FocusList fw (f:bw)) = leftMost (FocusList (f:fw) bw)
Or even handle the empty-backward-list issue mentioned above:
leftMost :: FocusList a -> FocusList a
leftMost fl#(FocusList fw [f]) = fl
leftMost (FocusList fw (f:bw)) = leftMost (FocusList (f:fw) bw)
leftMost (FocusList (f:fw) []) = FocusList fw [f]
leftMost (FocusList [] []) = error "leftMost: empty list"
The last case, referring to an empty list, is hard to handle in a sensible way. You can choose to crash with an error message (as done above), return the empty list (is that the intended result?), or report the error to the caller by returning a Maybe (FocusList a) instead.
I don't have any idea on how to change the code for my add function.
type trie = Node of bool * (char * trie) list
let explode word =
let rec explode' i acc =
if i < 0 then acc else explode' (i-1) (word.[i] :: acc)
in explode' (String.length word - 1) []
let rec exists w tr = match w, tr with
| [], Node (b, _) -> b
| h::t, Node (_, l) -> try exists t (List.assoc h l) with Not_found -> false
let rec add w tr = match w, tr with
| [], Node (_, l) -> Node (true, l)
| h :: t, Node (b, l) -> try add t (List.assoc h l)
with Not_found -> Node (false, (h, add t tr) :: l)
The problem is when List.assoc h l finds something , then I don't keep track of my structure, no Node is built during the recursive call so I am losing data.
Example :
# let empty = Node(true, []);;
- : trie = Node (true, [])
# let w = explode "hi";;
val w : char list = ['h'; 'i']
# let ww = explode "hit";;
val ww : char list = ['h'; 'i'; 't']
# let tr = add w x;;
val tr : trie = Node (false, [('h', Node (false, [('i', Node (true, []))]))])
# add ww tr;;
- : trie = Node (false, [('t', Node (true, []))])
It seems your basic plan is to work down through the data structure with List.assoc, then add your new node when you find the right spot. This makes sense if you can modify the structure. However, your data structure is immutable. With immutable data, your basic plan must be to build a new data structure rather than to modify the old one. So you have to imagine yourself finding the right spot while keeping traack of the old structure along the way, then building up a new structure starting from the spot.
Here's some code that keeps an association list counting the number of instances of characters seen so far. Note that it returns a new association list rather than modifying the old one (which is impossible):
let rec add_char_count list char =
match list with
| [] -> [(char, 1)]
| (hchar, hcount) :: t ->
if hchar = char then (hchar, hcount + 1) :: t
else (hchar, hcount) :: add_char_count t char
The recursive call (hchar, hcount) :: add_char_count t char is the spot where the old structure is remembered. It rebuilds the old structure from the part of the list before where the new character is added.
OUnit.assert_equal ~pp_diff allows pretty-printing of expected/actual value differences and OUnitDiff seems to provide differs for collections.
Is there a stock pp_diff for string values though? Ideally one that makes a best-effort to expand diffs to the closest UTF-8 sequence boundaries.
Even common prefix/suffix elimination would be better than nothing.
An amusing morning challenge.
type move = Same | Add | Del
let edit_distance_matrix a b =
(* The usual dynamic edit distance algorithm, except we keep
a complete matrix of moves to be able to step back and see which
operations can turn [sa] into [sb].
This is not very efficient: we keep the complete matrices of
distances (costs) and moves. One doesn't need to know the move
for all cases of the matrix, only those that are on the "best"
path from begin to end; it would be better to recompute the moves
along the path after the facts. There probably also exists
a classic clever trick to apply the usual optimization of keeping
only two rows of the matrix at any time, and still compute the
best path along the way.
*)
let la, lb = String.length a, String.length b in
let m = Array.make_matrix (la + 1) (lb + 1) (-1) in
let moves = Array.make_matrix (la + 1) (lb + 1) Same in
m.(0).(0) <- 0;
for i = 1 to la do
m.(i).(0) <- i;
done;
for j = 1 to lb do
m.(0).(j) <- j;
done;
for i = 1 to la do
for j = 1 to lb do
let best, move =
if a.[i-1] = b.[j-1] then m.(i-1).(j-1), Same
else
if m.(i-1).(j) <= m.(i).(j-1)
then m.(i-1).(j) + 1, Del
else m.(i).(j-1) + 1, Add
in
m.(i).(j) <- best;
moves.(i).(j) <- move;
done;
done;
m, moves
let get m (i, j) = m.(i).(j)
let valid m pos =
fst pos >= 0 && snd pos >= 0
let previous (i, j) = function
| Same -> (i - 1, j - 1)
| Add -> (i, j - 1)
| Del -> (i - 1, j)
let cons _pos action = function
| (action', n) :: rest when action = action' ->
(action', n+1) :: rest
| list -> (action, 1) :: list
(** walk back along the "best path", taking notes of changes to make
as we go *)
let chunks moves =
let la = Array.length moves - 1 in
let lb = Array.length moves.(0) - 1 in
let start = (la, lb) in
let rec loop acc pos =
let move = get moves pos in
let next_pos = previous pos move in
(* if the next position is not valid,
the current move is a dummy move,
and it must not be returned as part of [acc] *)
if not (valid moves next_pos) then acc
else loop (cons pos move acc) next_pos
in loop [] start
(** print the list of changes in term of the original string
We skip large parts of the string that are common, keeping only
[context] characters on the sides to provide some context.
*)
let diff context sa sb =
let cost, moves = edit_distance_matrix sa sb in
let chks = chunks moves in
let buf = Buffer.create cost.(String.length sa).(String.length sb) in
let rec loop i j = function
| [] -> ()
| (Same, n) :: rest ->
if n <= 2 * context then
Buffer.add_substring buf sa i n
else begin
Buffer.add_substring buf sa i context;
Buffer.add_string buf "...\n...";
Buffer.add_substring buf sa (i + n - context) context;
end;
loop (i + n) (j + n) rest
| (Add, n) :: rest ->
begin
Buffer.add_string buf "[+";
Buffer.add_substring buf sb j n;
Buffer.add_char buf ']';
end;
loop i (j + n) rest
| (Del, n) :: rest ->
begin
Buffer.add_string buf "[-";
Buffer.add_substring buf sa i n;
Buffer.add_char buf ']';
end;
loop (i + n) j rest
in
begin
try loop 0 0 chks with _ -> ()
end;
Buffer.contents buf
Test:
# print_endline ## diff 4
"le gros chat mange beaucoup de croquettes au saumon"
"le chat maigre mange peu de croquettes au saumon"
;;
le[- gros] chat[+ maigre] mange [+p][-b]e[-auco]u[-p] de ...
...umon
I've to make a function that transforms an House to an NHouse.
data House = House { hworking :: Working, hfinished :: Finished}
type Working = [Roof] , type Finished = [Roof]
data NHouse = NHouse {rot :: [NRoof]}
data NRoof = NRoof {h :: Roof, st :: Status }
data Status = Working | Finished
I've thought of doing it making an auxiliary function that transforms each Roof in an NRoof and then aply that to every Roof in the House.
But I just can't figure it out. I'm doing something like this:
nWorking :: Roof -> NRoof
nWorking x = NRoof {x, Working }
Yes you are going in the right direction. You can make a function to transform Roof to NRoof given the status.
transform :: Status -> Roof -> NRoof
transform s r = NRoof r s
Then you can just map this function over the list of roofs you have in the house.
h2n :: House -> NHouse
h2n (House w f) = NHouse $
map (transform Working) w ++
map (transform Finished) f
In one line this can be written as
h2n (House w f) = NHouse $ map (flip NRoof Working) w ++ map (flip NRoof Finished) f