Nested List Haskell Iteration - haskell

I need to implement a nested list operation in Haskell.
f :: [[String]] -> [[String]]
My input is a 2d array
[ [ ”A” , ”A” , ”A” ]
, [ ”B” , ”B” , ”A” ]
, [ ”A” , ”A” , ”B” ] ]
I arbitrarily generated that list.
A A A
B B A
A A B
So in my implementation I need to do the following.
If a position has A, and it has 2 or more than 2 "B" neighbors, it will turn to B.
If a position has B, and it has 2 or more than 2 "B" neighbors, it stays like as it is.
If a position has B, and it has less than 2 "B" neighbors, it will turn to A.
So after 1st step my table will look like this.
B B A
A B B
B B A
If I were going to use C or C++, my algorithm would like this:
Make a copy of my input.
Traverse both list in 2for loops, check if statements to make a change in the location and whenever I'm going to make a change, I will change the second list not the first, so that traversing the first list won't effect the other "A"'s and "B"'s.
Return second list.
The problem is, in Haskell, I cannot use iteration. How can I solve this problem?

As I stated in a comment, recursion is the looping primitive in Haskell. However, Haskell gives us a lot of power to build more user-friendly abstractions instead of using recursion directly. As #Lazersmoke mentioned, Comonad is a good abstraction when you're updating each individual value of a collection based on other values in the collection, such as the neighbors of the value.
There are quite a few examples of the Comonad class on the web, but it is sadly eclipsed by Monad. So here's my attempt to even the score a bit.
This is going to be a long post, so let me begin with the results. This is from GHCi:
λ display example
[[A,A,A],[B,B,A],[A,A,B]]
λ display (transition example)
[[B,B,A],[A,B,B],[B,B,A]]
Ok, now let's get down to business. First a few administrative things:
module Main where
import Control.Comonad -- from the comonad package
I'm going to try explaining each piece carefully, but it may take a while before the bigger picture becomes apparent. First, we're going to create an interesting data structure often called a zipper and implement an instance of Functor for it.
data U x = U [x] x [x] deriving Functor
instance Functor U where
fmap f (U as x bs) = U (fmap f as) (f x) (fmap f bs)
This data structure doesn't seem so special. It's how we use U that makes it cool. Because Haskell is lazy, we can use infinite lists with the U constructor. For example, i1 = U [-1,-2..] 0 [1,2..] represents all integers. That's not all, though. There's another piece of information: a center point at 0. We could have also represented all integers as i2' = U [0,-1..] 1 [2,3..]. These values are almost the same; they are just shifted by one. We can, in fact, create functions that will transform one into the other.
rightU (U a b (c:cs)) = U (b:a) c cs
leftU (U (a:as) b c) = U as a (b:c)
As you can see, we can slide a U to the left or the right just by rearranging elements. Let's make a Show instance for U and then verify that rightU and leftU work. We obviously can't print infinite lists, so we'll just take 3 elements from each side.
instance Show x => Show (U x) where
show (U as x bs) = (show . reverse . take 3) as ++ (show x) ++ (show . take 3) bs
λ i1
[-3,-2,-1]0[1,2,3]
λ leftU i2
[-3,-2,-1]0[1,2,3]
λ i2
[-2,-1,0]1[2,3,4]
λ rightU i1
[-2,-1,0]1[2,3,4]
Let's review our ultimate goal. We want to have a data structure where we can update each value based on all of its neighbors. Let's see how to do that with our U data structure. Suppose we want to replace each number with the sum of its neighbors. First, let's write a function that calculates the neighbors of the current position of a U:
sumOfNeighbors :: U Int -> Int
sumOfNeighbors (U (a:_) _ (b:_)) = a + b
And just to verify that it works:
λ sumOfNeighbors i1
0
λ sumOfNeighbors i2
2
Unfortunately, this only gives us a single result. We want to apply this function to every possible position. Well U has a Functor instance, so we can fmap a function over it. That would work great if our function had a type like Int -> Int, but it's actually U Int -> Int. But what if we could turn our U Int into a U (U Int)? Then fmap sumOfNeighbors would do exactly what we want!
Get ready for some inception-level data structuring. We're going to take our U Int and create a U (U Int) that will look like this:
-- not real Haskell. just for illustration
U [leftU u, (leftU . leftU) u, (leftU . leftU . leftU) u..] u [rightU u, (rightU . rightU) u, (rightU . rightU . rightU) u..]
This center of this new U (U a) is the original U a. When we slide left, we get original U a slid left, and likewise sliding right. In other words, the new U (U a) contains all the left and right slides of the original U a Here's how we do it:
duplicate :: U a -> U (U a)
duplicate u = U lefts u rights
where lefts = tail $ iterate leftU u
rights = tail $ iterate rightU u
We can use duplicate to write the function that we want:
extend :: (U a -> b) -> U a -> U b
extend f = fmap f . duplicate
Let's try it out.
λ extend sumOfNeighbors i1
[-6,-4,-2]0[2,4,6]
Looks like it works. These function names, duplicate and extend weren't chosen arbitrarily (by me, at least). These functions are part of the Comonad type class. We've been implementing it for our U data type.
class Functor w => Comonad w where
extract :: w a -> a
duplicate :: w a -> w (w a)
extend :: (w a -> b) -> w a -> w b
The only thing missing is extract which is trivial for U:
extract (U _ x _) = x
It's probably not apparent how useful this class is yet. Let's move on and look at how to handle the 2-dimensional case. We can do 2-dimensions with a zipper of zippers. That is, U (U a) where moving left and right shifts the inner zippers, and moving up and down shifts the outer zipper.
newtype V a = V { getV :: U (U a) }
instance Functor V where
fmap f = V . (fmap . fmap) f . getV
-- shift the 'outer' zipper
up :: V a -> V a
up = V . leftU . getV
down :: V a -> V a
down = V . rightU . getV
-- shift the 'inner' zippers
left :: V a -> V a
left = V . fmap leftU .getV
right :: V a -> V a
right = V . fmap rightU . getV
Here's what Comonad looks like for V:
instance Comonad V where
extract = extract . extract . getV
duplicate = fmap V . V . dup . dup . getV
where dup u = U (lefts u) r (right u)
lefts u = tail $ iterate (fmap leftU) u
rights u = tail $ iterate (fmap rightU) u
The extract function is fairly straightforward; it just digs through two layers of zippers to grab the current value. On the other hand, duplicate is sort of a monster. Ignoring the newtype V, its type would be duplicate :: U (U a) -> U (U (U (U a))). The purpose of thedup helper function is to add a U layer. It gets invoked twice. Then we wrap that in V to get a V (U (U a)). Then fmap V wraps the inner U (U a) to make the result V (V a).
Oh by the way, if you're wondering where extend is, we don't actually have to write it. The definition given above is its default.
That was a lot of work, but now we'll be able to easily tackle the original problem! Check this out. I'm going to make a data structure that includes your A and B values, and also a value that we don't care about, C:
data Token = A | B | C deriving (Eq,Show)
And here's some stuff to make building and displaying a V easier.
-- a list of U's containing nothing but x's
filled x = repeat $ U (repeat x) x (repeat x)
type Triple a = (a,a,a)
-- create a U with the middle values a, b, and c, and all the other values the defaulted to d
toU :: a -> Triple a -> U a
toU d (a,b,c) = U (a : repeat d) b (c : repeat d)
-- create a V centered on the 9 given values and default all other values to d
toV :: a -> Triple (Triple a) -> V a
toV d (as, bs, cs) = V (U x y z)
where x = (toU d as) : filled d
y = toU d bs
z = (toU d cs) : filled d
display :: Show a => V a -> [[a]]
display v = fmap g [ [up . left, up, up . right]
, [left, id, right]
, [down . left, down , down . right] ]
where g = fmap (extract . ($ v))
Here's what the example looks like:
example = toV C ((A,A,A)
,(B,B,A)
,(A,A,B))
And the rule is implemented by:
-- move into each neighboring position and get the value in that position
neighbors :: V a -> [a]
neighbors v = fmap (extract . ($ v)) positions
where positions = [ up . left
, up
, up . right
, left
, right
, down . left
, down
, down . right ]
numberOfBs :: V Token -> Int
numberOfBs = length . filter (==B) . neighbors
rule :: V Token -> Token
rule v = case extract v of
C -> C -- C's remain C's forever
_ -> if numberOfBs v >= 2 then B else A
Finally, we can apply rule to every value using extend:
transition = extend rule
λ display (transition example)
[[B,B,A],[A,B,B],[B,B,A]]
This rule is kind of boring though. Everything quickly becomes B's.
λ take 10 $ fmap display (iterate transition example)
[[[A,A,A],[B,B,A],[A,A,B]],[[B,B,A],[A,B,B],[B,B,A]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]]]
Creating a different rule is easy.
rule2 :: V Token -> Token
rule2 v = case extract v of
C -> C
A -> if numberOfBs v >= 2 then B else A
B -> if numberOfBs v >= 4 then A else B
λ take 10 $ fmap display (iterate (extend rule2) example)
[[[A,A,A],[B,B,A],[A,A,B]],[[B,B,A],[B,B,B],[B,B,B]],[[B,A,B],[A,A,A],[B,A,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,A,B],[A,A,A],[B,A,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,A,B],[A,A,A],[B,A,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,A,B],[A,A,A],[B,A,B]],[[B,B,B],[B,B,B],[B,B,B]]]
Cool, right? One final thing I want to mention. Did you notice that we didn't write any special cases to handle the edges? Since the data structure is infinite, we just filled the stuff out of the range which we don't care about with the value C and ignored it when considering the neighbors.

Related

Is this an accurate example of a Haskell Pullback?

I'm still trying to grasp an intuition of pullbacks (from category theory), limits, and universal properties, and I'm not quite catching their usefulness, so maybe you could help shed some insight on that as well as verifying my trivial example?
The following is intentionally verbose, the pullback should be (p, p1, p2), and (q, q1, q2) is one example of a non-universal object to "test" the pullback against to see if things commute properly.
-- MY DIAGRAM, A -> B <- C
type A = Int
type C = Bool
type B = (A, C)
f :: A -> B
f x = (x, True)
g :: C -> B
g x = (1, x)
-- PULLBACK, (p, p1, p2)
type PL = Int
type PR = Bool
type P = (PL, PR)
p = (1, True) :: P
p1 = fst
p2 = snd
-- (g . p2) p == (f . p1) p
-- TEST CASE
type QL = Int
type QR = Bool
type Q = (QL, QR)
q = (152, False) :: Q
q1 :: Q -> A
q1 = ((+) 1) . fst
q2 :: Q -> C
q2 = ((||) True) . snd
u :: Q -> P
u (_, _) = (1, True)
-- (p2 . u == q2) && (p1 . u = q1)
I was just trying to come up with an example that fit the definition, but it doesn't seem particularly useful. When would I "look for" a pull back, or use one?
I'm not sure Haskell functions are the best context
in which to talk about pull-backs.
The pull-back of A -> B and C -> B can be identified with a subset of A x C,
and subset relationships are not directly expressible in Haskell's
type system. In your specific example the pull-back would be
the single element (1, True) because x = 1 and b = True are
the only values for which f(x) = g(b).
Some good "practical" examples of pull-backs may be found
starting on page 41 of Category Theory for Scientists
by David I. Spivak.
Relational joins are the archetypal example of pull-backs
which occur in computer science. The query:
SELECT ...
FROM A, B
WHERE A.x = B.y
selects pairs of rows (a,b) where a is a row from table A
and b is a row from table B and where some function of a
equals some other function of b. In this case the functions
being pulled back are f(a) = a.x and g(b) = b.y.
Another interesting example of a pullback is type unification in type inference. You get type constraints from several places where a variable is used, and you want to find the tightest unifying constraint. I mention this example in my blog.

Having trouble with matching type in Haskell (generateTrees)

i am sitting with two guys on a haskell project and we have quite a bit of trouble with the following code:
I try to give you all the necessary information:
From the module Types.hs:
class Game g s | g -> s where
findPossibleMoves :: Player -> g -> [(s,g)]
identifyWinner :: g -> Player -> Maybe Player
data Player = Player1 | Player2 deriving (Eq,Ord)
and here is the code we want to implement:
generateGameTree :: Game g s => g -> Player -> Tree (g,Player) s
generateGameTree g p = ([ Node ((snd x),p) [] | x <- (findPossibleMoves p g )])
So we try to get this thing compiled but it wont work . It might be important to know how a tree looks like so thats the definition:
data Tree v e = Node v [(e,Tree v e)] deriving (Show,Eq,Ord)
We allready know, that the returntype of the function and our returntype doesn't match, but there must be another mistake in this.
We would appreciate any help , thanks in advance
You may want to split this operation into two smaller ones:
A generic unfold function first which, given a seed of type s and a function computing one layer of tree generates a whole tree by repeatedly calling itself on the next generation of seeds. This definition would have type:
unfold :: (s -> (v, [(e,s)])) -> s -> Tree v e
unfold next seed = _fillThisIn
You can then use this function to define your generateGameTree. The intuition behind using unfold is that the seed of type s represents the state of the game and the function next computes the possible new states after one move (together with the v and e "outputs").
To whom it may interest:
This works now without compiler error:
generateGameTree g p = Node (g,p) [ ((fst x),generateGameTree (snd x) (nextPlayer p)) | x <- (findPossibleMoves p g) ]

Why do we need containers?

(As an excuse: the title mimics the title of Why do we need monads?)
There are containers [1] (and indexed ones [2]) (and hasochistic ones [3]) and descriptions.[4] But containers are problematic [5] and to my very small experience it's harder to think in terms of containers than in terms of descriptions. The type of non-indexed containers is isomorphic to Σ — that's quite too unspecific. The shapes-and-positions description helps, but in
⟦_⟧ᶜ : ∀ {α β γ} -> Container α β -> Set γ -> Set (α ⊔ β ⊔ γ)
⟦ Sh ◃ Pos ⟧ᶜ A = ∃ λ sh -> Pos sh -> A
Kᶜ : ∀ {α β} -> Set α -> Container α β
Kᶜ A = A ◃ const (Lift ⊥)
we are essentially using Σ rather than shapes and positions.
The type of strictly-positive free monads over containers has a rather straightforward definition, but the type of Freer monads looks simpler to me (and in a sense Freer monads are even better than usual Free monads as described in the paper [6]).
So what can we do with containers in a nicer way than with descriptions or something else?
References
Abbott, Michael, Thorsten Altenkirch, and Neil Ghani. "Containers: Constructing strictly positive types." Theoretical Computer Science 342, no. 1 (2005): 3-27.
Altenkirch, Thorsten, Neil Ghani, Peter Hancock, Conor McBride, and PETER MORRIS. 2015. “Indexed Containers.” Journal of Functional Programming 25. Cambridge University Press: e5. doi:10.1017/S095679681500009X.
McBride, Conor. "hasochistic containers (a first attempt)." Jun, 2015.
Chapman, James, Pierre-Evariste Dagand, Conor Mcbride, and Peter Morris. "The gentle art of levitation." In ICFP 2010, pp. 3-14. 2010.
Francesco. "W-types: good news and bad news." Mar 2010.
Kiselyov, Oleg, and Hiromi Ishii. "Freer monads, more extensible effects." In 8th ACM SIGPLAN Symposium on Haskell, Haskell 2015, pp. 94-105. Association for Computing Machinery, Inc, 2015.
To my mind, the value of containers (as in container theory) is their uniformity. That uniformity gives considerable scope to use container representations as the basis for executable specifications, and perhaps even machine-assisted program derivation.
Containers: a theoretical tool, not a good run-time data representation strategy
I would not recommend fixpoints of (normalized) containers as a good general purpose way to implement recursive data structures. That is, it is helpful to know that a given functor has (up to iso) a presentation as a container, because it tells you that generic container functionality (which is easily implemented, once for all, thanks to the uniformity) can be instantiated to your particular functor, and what behaviour you should expect. But that's not to say that a container implementation will be efficient in any practical way. Indeed, I generally prefer first-order encodings (tags and tuples, rather than functions) of first-order data.
To fix terminology, let us say that the type Cont of containers (on Set, but other categories are available) is given by a constructor <| packing two fields, shapes and positions
S : Set
P : S -> Set
(This is the same signature of data which is used to determine a Sigma type, or a Pi type, or a W type, but that does not mean that containers are the same as any of these things, or that these things are the same as each other.)
The interpretation of such a thing as a functor is given by
[_]C : Cont -> Set -> Set
[ S <| P ]C X = Sg S \ s -> P s -> X -- I'd prefer (s : S) * (P s -> X)
mapC : (C : Cont){X Y : Set} -> (X -> Y) -> [ C ]C X -> [ C ]C Y
mapC (S <| P) f (s , k) = (s , f o k) -- o is composition
And we're already winning. That's map implemented once for all. What's more, the functor laws hold by computation alone. There is no need for recursion on the structure of types to construct the operation, or to prove the laws.
Descriptions are denormalized containers
Nobody is attempting to claim that, operationally, Nat <| Fin gives an efficient implementation of lists, just that by making that identification we learn something useful about the structure of lists.
Let me say something about descriptions. For the benefit of lazy readers, let me reconstruct them.
data Desc : Set1 where
var : Desc
sg pi : (A : Set)(D : A -> Desc) -> Desc
one : Desc -- could be Pi with A = Zero
_*_ : Desc -> Desc -> Desc -- could be Pi with A = Bool
con : Set -> Desc -- constant descriptions as singleton tuples
con A = sg A \ _ -> one
_+_ : Desc -> Desc -> Desc -- disjoint sums by pairing with a tag
S + T = sg Two \ { true -> S ; false -> T }
Values in Desc describe functors whose fixpoints give datatypes. Which functors do they describe?
[_]D : Desc -> Set -> Set
[ var ]D X = X
[ sg A D ]D X = Sg A \ a -> [ D a ]D X
[ pi A D ]D X = (a : A) -> [ D a ]D X
[ one ]D X = One
[ D * D' ]D X = Sg ([ D ]D X) \ _ -> [ D' ]D X
mapD : (D : Desc){X Y : Set} -> (X -> Y) -> [ D ]D X -> [ D ]D Y
mapD var f x = f x
mapD (sg A D) f (a , d) = (a , mapD (D a) f d)
mapD (pi A D) f g = \ a -> mapD (D a) f (g a)
mapD one f <> = <>
mapD (D * D') f (d , d') = (mapD D f d , mapD D' f d')
We inevitably have to work by recursion over descriptions, so it's harder work. The functor laws, too, do not come for free. We get a better representation of the data, operationally, because we don't need to resort to functional encodings when concrete tuples will do. But we have to work harder to write programs.
Note that every container has a description:
sg S \ s -> pi (P s) \ _ -> var
But it's also true that every description has a presentation as an isomorphic container.
ShD : Desc -> Set
ShD D = [ D ]D One
PosD : (D : Desc) -> ShD D -> Set
PosD var <> = One
PosD (sg A D) (a , d) = PosD (D a) d
PosD (pi A D) f = Sg A \ a -> PosD (D a) (f a)
PosD one <> = Zero
PosD (D * D') (d , d') = PosD D d + PosD D' d'
ContD : Desc -> Cont
ContD D = ShD D <| PosD D
That's to say, containers are a normal form for descriptions. It's an exercise to show that [ D ]D X is naturally isomorphic to [ ContD D ]C X. That makes life easier, because to say what to do for descriptions, it's enough in principle to say what to do for their normal forms, containers. The above mapD operation could, in principle, be obtained by fusing the isomorphisms to the uniform definition of mapC.
Differential structure: containers show the way
Similarly, if we have a notion of equality, we can say what one-hole contexts are for containers uniformly
_-[_] : (X : Set) -> X -> Set
X -[ x ] = Sg X \ x' -> (x == x') -> Zero
dC : Cont -> Cont
dC (S <| P) = (Sg S P) <| (\ { (s , p) -> P s -[ p ] })
That is, the shape of a one-hole context in a container is the pair of the shape of the original container and the position of the hole; the positions are the original positions apart from that of the hole. That's the proof-relevant version of "multiply by the index, decrement the index" when differentiating power series.
This uniform treatment gives us the specification from which we can derive the centuries-old program to compute the derivative of a polynomial.
dD : Desc -> Desc
dD var = one
dD (sg A D) = sg A \ a -> dD (D a)
dD (pi A D) = sg A \ a -> (pi (A -[ a ]) \ { (a' , _) -> D a' }) * dD (D a)
dD one = con Zero
dD (D * D') = (dD D * D') + (D * dD D')
How can I check that my derivative operator for descriptions is correct? By checking it against the derivative of containers!
Don't fall into the trap of thinking that just because a presentation of some idea is not operationally helpful that it cannot be conceptually helpful.
On "Freer" monads
One last thing. The Freer trick amounts to rearranging an arbitrary functor in a particular way (switching to Haskell)
data Obfuncscate f x where
(:<) :: forall p. f p -> (p -> x) -> Obfuncscate f x
but this is not an alternative to containers. This is a slight currying of a container presentation. If we had strong existentials and dependent types, we could write
data Obfuncscate f x where
(:<) :: pi (s :: exists p. f p) -> (fst s -> x) -> Obfuncscate f x
so that (exists p. f p) represents shapes (where you can choose your representation of positions, then mark each place with its position), and fst picks out the existential witness from a shape (the position representation you chose). It has the merit of being obviously strictly positive exactly because it's a container presentation.
In Haskell, of course, you have to curry out the existential, which fortunately leaves a dependency only on the type projection. It's the weakness of the existential which justifies the equivalence of Obfuncscate f and f. If you try the same trick in a dependent type theory with strong existentials, the encoding loses its uniqueness because you can project and tell apart different choices of representation for positions. That is, I can represent Just 3 by
Just () :< const 3
or by
Just True :< \ b -> if b then 3 else 5
and in Coq, say, these are provably distinct.
Challenge: characterizing polymorphic functions
Every polymorphic function between container types is given in a particular way. There's that uniformity working to clarify our understanding again.
If you have some
f : {X : Set} -> [ S <| T ]C X -> [ S' <| T' ]C X
it is (extensionally) given by the following data, which make no mention of elements whatsoever:
toS : S -> S'
fromP : (s : S) -> P' (toS s) -> P s
f (s , k) = (toS s , k o fromP s)
That is, the only way to define a polymorphic function between containers is to say how to translate input shapes to output shapes, then say how to fill output positions from input positions.
For your preferred representation of strictly positive functors, give a similarly tight characterisation of the polymorphic functions which eliminates abstraction over the element type. (For descriptions, I would use exactly their reducability to containers.)
Challenge: capturing "transposability"
Given two functors, f and g, it is easy to say what their composition f o g is: (f o g) x wraps up things in f (g x), giving us "f-structures of g-structures". But can you readily impose the extra condition that all of the g structures stored in the f structure have the same shape?
Let's say that f >< g captures the transposable fragment of f o g, where all the g shapes are the same, so that we can just as well turn the thing into a g-structure of f-structures. E.g., while [] o [] gives ragged lists of lists, [] >< [] gives rectangular matrices; [] >< Maybe gives lists which are either all Nothing or all Just.
Give >< for your preferred representation of strictly positive functors. For containers, it's this easy.
(S <| P) >< (S' <| P') = (S * S') <| \ { (s , s') -> P s * P' s' }
Conclusion
Containers, in their normalized Sigma-then-Pi form, are not intended to be an efficient machine representation of data. But the knowledge that a given functor, implemented however, has a presentation as a container helps us understand its structure and give it useful equipment. Many useful constructions can be given abstractly for containers, once for all, when they must be given case-by-case for other presentations. So, yes, it is a good idea to learn about containers, if only to grasp the rationale behind the more specific constructions you actually implement.

Non-tree data structures in Haskell

Making tree like data structures is relatively easy in Haskell. However, what if I want a structure like the following:
A (root)
/ \
B C
/ \ / \
D E F
So if I traverse down the structure through B to update E, the returned new updated structure also has E updated if I traverse through C.
Could someone give me some hints about how to achieve this? You can assume there are no loops.
I would flatten the data structure to an array, and operate on this instead:
import Data.Array
type Tree = Array Int -- Bounds should start at (1) and go to sum [1..n]
data TreeTraverse = TLeft TreeTraverse | TRight TreeTraverse | TStop
Given some traverse directions (left, right, stop), it's easy to see that if we go left, we simply add the current level to our position, and if we go right, we also add the current position plus one:
getPosition :: TreeTraverse -> Int
getPosition = getPosition' 1 1
where
getPosition' level pos (TLeft ts) = getPosition' (level+1) (pos+level) ts
getPosition' level pos (TRight ts) = getPosition' (level+1) (pos+level + 1) ts
getPosition' _ pos (TStop) = pos
In your case, you want to traverse either ABE or ACE:
traverseABE = TLeft $ TRight TStop
traverseACE = TRight $ TLeft TStop
Since we already now how to get the position of your element, and Data.Array provides some functions to set/get specific elements, we can use the following functions to get/set tree values:
getElem :: TreeTraverse -> Tree a -> a
getElem tt t = t ! getPosition tt
setElem :: TreeTraverse -> Tree a -> a -> Tree a
setElem tt t x = t // [(getPosition tt, x)]
To complete the code, lets use your example:
example = "ABCDEF"
exampleTree :: Tree Char
exampleTree = listArray (1, length example) example
And put everything to action:
main :: IO ()
main = do
putStrLn $ "Traversing from A -> B -> E: " ++ [getElem traverseABE exampleTree]
putStrLn $ "Traversing from A -> C -> E: " ++ [getElem traverseACE exampleTree]
putStrLn $ "exampleTree: " ++ show exampleTree ++ "\n"
putStrLn $ "Setting element from A -> B -> E to 'X', "
let newTree = setElem traverseABE exampleTree 'X'
putStrLn $ "but show via A -> C -> E: " ++ [getElem traverseACE newTree]
putStrLn $ "newTree: " ++ show newTree ++ "\n"
Note that this is most-likely not the best way to do this, but the first thing that I had in mind.
Once you've established identity, it can be done.
But first you must establish identity.
In many languages, values can be distinct from each other, but equal. In Python, for example:
>>> a = [1]
>>> b = [1]
>>> a == b
True
>>> a is b
False
You want to update E in one branch of the tree, and also update all other elements for which that element is E. But Haskell is referentially transparent: it has no notion of things being the same object; only equality, and even that is not applicable for every object.
One way you could do this is equality. Say this was your tree:
__A__
/ \
B C
/ \ / \
1 2 2 3
Then we could go through the tree and update all the 2s to, say, four. But this isn't exactly what you want in some cases.
In Haskell, if you want to update one thing in multiple places, you'll have to be explicit about what is and isn't the same thing. Another way you could deal with this is to tag each different value with a unique integer, and use that integer to determine identity:
____________A___________
/ \
B C
/ \ / \
(id=1)"foo" (id=2)"bar" (id=2)"bar" (id=3)"baz"
Then we could update all values with an identity of 2. Accidental collisions cannot be a problem, as there can be no collisions except those that are intentional.
This is essentially what STRef and IORef do, except they hoist the actual value into the monad's state and hide the identities from you. The only downside of using these is you'll need to make much of your code monadic, but you're probably not going to get away from that easily whatever you do. (Modifying values rather than replacing them is an inherently effectful thing to do.)
The structure you gave was not specified in much detail so it's impossible to tailor an example to your use case, but here's a simple example using the ST monad and a Tree:
import Control.Monad
import Control.Monad.ST
import Data.Tree
import Data.Traversable (traverse)
import Data.STRef
createInitialTree :: ST s (Tree (STRef s String))
createInitialTree = do
[a, b, c, d, e, f] <- mapM newSTRef ["A", "B", "C", "D", "E", "F"]
return $ Node a [ Node b [Node d [], Node e []]
, Node c [Node e [], Node f []]
]
dereferenceTree :: Tree (STRef s a) -> ST s (Tree a)
dereferenceTree = traverse readSTRef
test :: ST s (Tree String, Tree String)
test = do
tree <- createInitialTree
before <- dereferenceTree tree
let leftE = subForest (subForest tree !! 0) !! 1
writeSTRef (rootLabel leftE) "new" -- look ma, single update!
after <- dereferenceTree tree
return (before, after)
main = do
let (before, after) = runST test
putStrLn $ drawTree before
putStrLn $ drawTree after
Observe that although we only explicitly modified the value of the left E value, it changed on the right side, too, as desired.
I should note that these are not the only ways. There are probably many other solutions to this same problem, but they all require you to define identity sensibly. Only once that has been done can one begin the next step.

Haskell Tic Tac Toe tuple board: How to generate possible moves?

So I have a Tic Tac Toe board, in the form of nested tuples, like so:
type Row = (Field, Field, Field)
type Board = (Row, Row, Row)
data Field = X | O | B
deriving (Eq, Ord)
Where B stands for empty. I need to take a player, a given board state, and then generate a list of all possible board states after the next move.
moves :: Player -> Board -> [Board]
However, I just can't figure it out. My initial thought is that I need to iterate through every field, to check whether or not it is empty, and then add a new Board to the list or do nothing. However, I see no way to iterate through all the fields. Even if I manually check every field with if statement or guards, how do I move onto the next field to check it, regardless of whether I end up with a possible move or not?
If I convert the board format into a list I could do it, but I feel like that defeats the purpose of this problem. There's got to be a better solution that doesn't require restructuring Board.
You're not going to be able to iterate through the fields of a tuple -- tuples aren't intended for that. A list of lists is probably a more natural representation for this problem.
That said, you can implement this function with the board representation you're using by following the types. A move on a Board is a move on either the first, second, or third row. A move on a row is the placement of the player on either the first, second, or third field. The difficulty with your representation is that there's no simple way to map over a tuple, since tuples are generally heterogeneous. So instead, one thing you can do is write yourself a generic way to apply a function to a location in a tuple. Here's one way to do that (if the Monad stuff confuses you, mentally substitute "list of foo" everywhere you see m foo and you'll be okay):
mReplace1 :: Monad m => (a -> m d) -> (a,b,c) -> m (d,b,c)
mReplace1 f (a,b,c) = f a >>= \d -> return (d,b,c)
mReplace2 :: Monad m => (b -> m d) -> (a,b,c) -> m (a,d,c)
mReplace2 f (a,b,c) = f b >>= \d -> return (a,d,c)
mReplace3 :: Monad m => (c -> m d) -> (a,b,c) -> m (a,b,d)
mReplace3 f (a,b,c) = f c >>= \d -> return (a,b,d)
These functions provide a way to apply a function to the first, second, and third slots in a tuple, respectively. They're wrapped in a monad so that we can have a function that returns a list of possibilities for the slot, and automatically convert that to a list of possibilities for the tuple as a whole.
With these, we can write the overall function just by stringing these calls together.
moves p board = mReplace1 rowMoves board ++
mReplace2 rowMoves board ++
mReplace3 rowMoves board
where rowMoves row = mReplace1 fieldMoves row ++
mReplace2 fieldMoves row ++
mReplace3 fieldMoves row
fieldMoves B = [p]
fieldMoves _ = []
That is: the moves for a board are all the possibilities for a move in row 1, plus all the possibilities for row 2, plust all the possibilities for row 3. For a given row, the possible moves are all the moves for slot 1, plus all the moves for slot 2, plus all the moves for slot 3. For a given slot, if there's already an X or an O there, then there are no possible moves; otherwise there's one possible move (placing the player in that slot).
Here's a simple solution that I've used before
import qualified Data.Map as Map
data Piece    = O | X deriving (Eq,Ord)
type Position = (Int,Int)
type Board = Map.Map Position Piece
positions = [(i,j) | i <- [0,1,2], j <- [0,1,2]]
spaces board = map (\pos -> Map.notMember pos board) positions
moves player board = map (\pos -> Map.insert pos player board) (spaces board)
As other people have stated, tuples is not a very good idea for this approach, since there is no way to traverse them.
You said you needed tuples, so there you go, I'm almost sure it works, test it.
First your code how I would've done it
import Control.Monad (msum)
import Control.Applicative ((<*>), pure)
data Player = P1 | P2 deriving (Eq, Show)
data Field = X | O | B deriving (Eq, Show)
type Board = ((Field,Field,Field)
,(Field,Field,Field)
,(Field,Field,Field))
symbolToPlayer :: Field -> Player
symbolToPlayer X = P1
symbolToPlayer O = P2
checkThree :: (Field,Field,Field) -> Maybe Player
checkThree (a,b,c)
| a == b && a == c = Just $ symbolToPlayer a
| otherwise = Nothing
winHorizontal :: Board -> Maybe Player
winHorizontal (r1, r2, r3) = msum $ map checkThree [r1, r2, r3]
winVertical :: Board -> Maybe Player
winVertical ((a,b,c), (d,e,f), (g,h,i)) =
msum $ map checkThree [(a,d,g), (b,e,h), (c,f,i)]
winDiagonal :: Board -> Maybe Player
winDiagonal ((a,_,c), (_,e,_), (g,_,i)) =
msum $ map checkThree [(a,e,i), (c,e,g)]
hasWinner :: Board -> Maybe Player
hasWinner b = msum $ [winHorizontal, winVertical, winHorizontal] <*> pure b
This is the part of nextStates function
boardBlanks :: Board -> Int
boardBlanks (r1,r2,r3) = rowBlanks r1 + rowBlanks r2 + rowBlanks r3
rowBlanks :: (Field, Field, Field) -> Int
rowBlanks (a,b,c) = foldr hack 0 [a,b,c]
where hack B c = 1 + c
hack _ c = c
changeBoard :: Field -> Int -> Board -> Board
changeBoard f i (a,b,c)
| hack [a] > i = (changeRow f (i - hack []) a, b, c)
| hack [a,b] > i = (a, changeRow f (i - hack [a]) b, c)
| hack [a,b,c] > i= (a, b, changeRow f (i - hack [a,b]) c)
where
hack ls = sum $ map rowBlanks ls
changeRow f 0 row =
case row of
(B,a,b) -> (f,a,b)
(a,B,b) -> (a,f,b)
(a,b,B) -> (a,b,f)
otherwise -> row
changeRow f 1 row =
case row of
(B,B,a) -> (B,f,a)
(a,B,B) -> (a,B,f)
otherwise -> row
changeRow f 2 row =
case row of
(B,B,B) -> (B,B,f)
otherwise -> row
nextStates :: Board -> [Board]
nextStates b = os ++ xs
where
os = foldr (hack O) [] . zip [0..] $ replicate (boardBlanks b) b
xs = foldr (hack X) [] . zip [0..] $ replicate (boardBlanks b) b
hack f (i,a) ls = changeBoard f i a : ls

Resources