Let's say we have the following code representing binary trees where decodeInt searches the tree for an integer:
import Text.Show.Functions
data BinTree a b = Leaf b | Node a (BinTree a b) (BinTree a b) deriving Show
example :: BinTree (Int -> Bool) Char
example = Node (\x -> x > 4) (Node (\x -> x * x == x) (Leaf 'g') (Node (\x -> x == 0)
(Leaf 'u') (Leaf 'l'))) (Node (\x -> x >= 7) (Leaf 'f') (Leaf 'i'))
countInnerNodes :: BinTree a b -> Int
countInnerNodes (Node a b c) = 1 + countInnerNodes b + countInnerNodes c
countInnerNodes (Leaf x) = 0
decodeInt :: BinTree (Int -> Bool) b -> Int -> b
decodeInt (Leaf b) p = b
decodeInt (Node x y z) p = if (x(p) == True) then decodeInt z p else decodeInt y p
decode :: BinTree (Int -> Bool) b -> [Int] -> String
decode x [] = "empty list"
decode x xs = ??????
How can I use map to get a result like this when calling decode?
decode Tree [1,2,3,4]
= [decodeInt Tree (1), decodeInt Tree (2),
decodeInt Tree (3), decodeInt Tree (4)]
/edit: Followup
Let's also say we would like to create a function like the following
mapTree (\x -> ’e’) example
mapTree should return a BinTree just like example with the only difference being that the Char of every Leaf has been replaced with an 'e'. How do I accomplish that? I've started Haskell yesterday so I'm quite new to functional programming.
decodeInt :: BinTree (Int -> Bool) b -> Int -> b, so assuming t :: BinTree (Int -> Bool) b, then decodeInt t :: Int -> b. You map that function over your list of Ints.
decode t xs = let y = map (decodeInt t) xs
in ...
You'll still have to figure out how to convert y to the String value that decode is expected to return.
A bit too late but maybe this helps :
decode :: BinTree (Int -> Bool) b -> [Int] -> [b]
decode _ [] = []
decode x (y:ys) = decodeInt x y .... maybe you have an idea how to continue here ;)
Related
listTree :: Tree a -> [a]
listTree = foldTree f z
where
f x y z = x + y + z
z = []
This is what I have so far, but my f is wrong because the expected type is Tree a -> [a] but the actual is Tree [a] -> [a]
data Tree a
= Tip
| Bin (Tree a) a (Tree a)
deriving (Show, Eq)
foldTree :: (b -> a -> b -> b) -> b -> Tree a -> b
foldTree f z Tip = z
foldTree f z (Bin l x r) = f (foldTree f z l) x (foldTree f z r)
This is fold and data type for tree.
Need help with defining f.
First of all, combining lists uses ++ in haskell. + is only used for adding numbers. Second, the variable y is of type a, not [a], so you cannot use ++ on it directly.
listTree :: Tree a -> [a]
listTree = foldTree f z
where
f x y z = x ++ [y] ++ z
z = []
I am having trouble completing a task where I am to create a function that uses a generalised fold function to evaluate a boolean AST. I will show you some examples to illustrate.
First, an example of what I want, but for an AST that sums integers:
data Expr = Val Int | Add Expr Expr deriving Show
folde :: (Int -> a) -> (a -> a -> a) -> Expr -> a
folde f g (Val x) = f x
folde f g (Add x y) = g (folde f g x) (folde f g y)
eval :: Expr -> Int
eval expr = folde (\x -> x) (\x y -> x + y) expr
This works fine.
Now for the boolean AST, and the folding function:
data Bexp = T | F | And Bexp Bexp | Or Bexp Bexp deriving (Ord, Eq)
foldb :: a -> a -> (a -> a -> a) -> (a -> a -> a) -> Bexp -> a
foldb t f a o T = t
foldb t f a o F = f
foldb t f a o (And x y) = a (foldb t f a o x) (foldb t f a o y)
foldb t f a o (Or x y) = o (foldb t f a o x) (foldb t f a o y)
What I am having trouble with, is creating a function that does the same as the eval function does for the simple AST above, that is, using the foldb function with some lambdas to evaluate whether the Bexp expression is either T or F.
I don't understand why this function doesn't work:
evb :: Bexp -> Bool
evb bexp = foldb (\_ -> True) (\_ -> False) (\x y -> x == T && y == T) (\x y -> x == T || y == T) bexp
GHCi doesn't even wanna to compile it because of type error.
Thanks in advance.
The code does't compile for few reasons.
-- Observe type signatures.
foldb :: a -> a -> (a -> a -> a) -> (a -> a -> a) -> Bexp -> a
evb bexp = foldb (\_ -> True) (\_ -> False) (\x y -> x == T && y == T) (\x y -> x == T || y == T) bexp
If foldb takes its first argument as a Function x -> Bool then from the type signature of foldb a is of type function but observe this (\x y -> x == T && y == T) here you used a as Bexp, which don't match at all.
a = Bexp from (\x y -> x == T && y == T)
a = x -> Bool from (\_ -> True)
And also the return type of evb is Bool, but from your argument passing to foldb a can be 2 things & the compiler is confused to pick the right type.
If we want to use foldb to produce a Bool at the very end, we need to choose a = Bool in its type. So, we are now using
foldb :: Bool
-> Bool
-> (Bool -> Bool -> Bool)
-> (Bool -> Bool -> Bool)
-> Bexp
-> Bool
Hence, foldb (\_->True) (\_->False) ... is wrong since the first two arguments must be booleans, not functions. We need something like foldb True False ....
The next two parameters must be boolean binary operators like \x y -> x && y, which can be written as (&&) for short.
We finally get:
evb :: Bexp -> Bool
evb bexp = foldb True False (&&) (||)
A "map" of type
mapIsh :: Traversable t => (a -> Either b c) -> t a -> Either b (t c)
would be a start. (Hayoo doesn't find one.) Or a "fold" of type
foldIsh :: (b -> a -> Either l b) -> b -> t a -> Either l b
Best of all (for my case) would be this:
mapAccumIsh :: (a -> b -> Either l (a, c)) -> a -> t b -> Either l (a, t c)
That might be all you need to read. In case you want more details, though, here's a concrete example:
Imagine a treelike structure to mapAccum over. Each branch, after evaluating its children, gets transformed by some function of its children and the accumulator.
Here's some working code that adds each Tree's value to the accumulator, and also adds to each Branch's label the product of its childrens' labels:
module Temp where
import Data.List
data Tree = Leaf Float | Branch Float [Tree] deriving (Show)
label :: Tree -> Float
label (Leaf i) = i
label (Branch i _) = i
f :: Float -> Tree -> (Float, Tree)
f i (Leaf j) = (i+j, Leaf j)
f i (Branch j ts) = (i + tf, Branch tf ts2) where
(i2, ts2) = mapAccumL f i ts
tf = j + (foldl (*) 1 $ map label ts2)
-- the problem: what if instead of (*) in the line above, we used this?
evenMult :: Float -> Float -> Either String Float
evenMult a b = case even $ round b of True -> Right $ a * b
False -> Left "that's odd"
go = f 0 $ Branch 2 [Branch 2 [Leaf 2]
,Branch 2 [Leaf 2, Leaf (-2)]]
Here's what that returns:
(-6.0,Branch (-6.0) [Branch 4.0 [Leaf 2.0]
,Branch (-2.0) [Leaf 2.0,Leaf (-2.0)]])
But what if, instead of using (*) in the foldl, we used evenMult?
I want to make a sudoku solver in Haskell (as an exercise). My idea is:
I have t :: [[Int]] representing a 9x9 grid so that it contains 0 in an empty field and 1-9 in a solved field.
A function solve :: [[Int]] -> [[Int]] returns the solved sudoku.
Here is a rough sketch of it (i'd like to point out i'm a beginner, i know it is not the most optimal code):
solve :: [[Int]] -> [[Int]]
solve t
| null (filter (elem 0) t) = t
| t /= beSmart t = solve (beSmart t)
| otherwise = guess t
The function beSmart :: [[Int]] -> [[Int]] tries to solve it by applying some solving algorithms, but if methodical approach fails (beSmart returns the unchanged sudoku table in that case) it should try to guess some numbers (and i'll think of that function later). In order to fill in an empty field, i have to find it first. And here's the problem:
beSmart :: [[Int]] -> [[Int]]
beSmart t = map f t
where f row
| elem 0 row = map unsolvedRow row
| otherwise = row
where unsolvedRow a
| a == 0 = tryToDo t r c --?!?!?!?! skip
| otherwise = a
The function tryToDo :: [[Int]]] -> Int -> Int - > Int needs the row and column of the field i'm trying to change, but i have no idea how to get that information. How do i get from map what element of the list i am in at the moment? Or is there a better way to move around in the table? I come from iterative and procedural programing and i understand that perhaps my approach to the problem is wrong when it comes to functional programing.
I know this is not really an answer to your question, but I would argue, that usually you would want a different representation (one that keeps a more detailed view of what you know about the sudoku puzzle, in your attempted solution you can only distinguish a solved cell from a cell that is free to assume any value). Sudoku is a classical instance of CSP. Where modern approaches offer many fairly general smart propagation rules, such as unit propagation (blocking a digit in neighboring cells once used somewhere), but also many other, see AC-3 for further details. Other related topics include SAT/SMT and you might find the algorithm DPLL also interesting. In the heart of most solvers there usually is some kind of a search engine to deal with non-determinism (not every instance must have a single solution that is directly derivable from the initial configuration of the instance by application of inference rules). There are also techniques such as CDCL to direct the search.
To address the question in the title, to know where you are, its probably best if you abstract the traversal of your table so that each step has access to the coordinates, you can for example zip a list of rows with [0..] (zip [0..] rows) to number the rows, when you then map a function over the zipped lists, you will have access to pairs (index, row), the same applies to columns. Just a sketch of the idea:
mapTable :: (Int -> Int -> a -> b) -> [[a]] -> [[b]]
mapTable f rows = map (\(r, rs) -> mapRow (f r) rs) $ zip [0..] rows
mapRow :: (Int -> a -> b) -> [a] -> [b]
mapRow f cols = map (uncurry f) $ zip [0..] cols
or use fold to turn your table into something else (for example to search for a unit cell):
foldrTable :: (Int -> Int -> a -> b -> b) -> b -> [[a]] -> b
foldrTable f z rows = foldr (\(r, rs) b -> foldrRow (f r) b rs) z $ zip [0..] rows
foldrRow :: (Int -> a -> b -> b) -> b -> [a] -> b
foldrRow f z cols = foldr (uncurry f) z $ zip [0..] cols
to find which cell is unital:
foldrTable
(\x y v acc -> if length v == 1 then Just (x, y) else acc)
Nothing
[[[1..9],[1..9],[1..9]],[[1..9],[1..9],[1..9]],[[1..9],[1],[1..9]]]
by using Monoid you can refactor it:
import Data.Monoid
foldrTable' :: Monoid b => (Int -> Int -> a -> b) -> [[a]] -> b
foldrTable' f rows = foldrTable (\r c a b -> b <> f r c a) mempty rows
unit :: Int -> Int -> [a] -> Maybe (Int, Int)
unit x y c | length c == 1 = Just (x, y)
| otherwise = Nothing
firstUnit :: [[[a]]] -> Maybe (Int, Int)
firstUnit = getFirst . foldrTable' (\r c v -> First $ unit r c v)
so now you would do
firstUnit [[[1..9],[1..9],[1..9]],[[1,2],[3,4],[5]]]
to obtain
Just (1, 2)
correctly determining that the first unit cell is at position 1,2 in the table.
[[Int]] is a good type for a sodoku. But map does not give any info regarding the place it is in. This is one of the ideas behind map.
You could zip together the index with the value. But a better idea would be to pass the whole [[Int]] and the indexes to to the function. So its type would become:
f :: [[Int]] -> Int -> Int -> [[Int]]
inside the function you can now access the current element by
t !! x !! y
Already did this a while ago as a learning example. It is definitely not the nicest solution, but it worked for me.
import Data.List
import Data.Maybe
import Data.Char
sodoku="\
\-9-----1-\
\8-4-2-3-7\
\-6-9-7-2-\
\--5-3-1--\
\-7-5-1-3-\
\--3-9-8--\
\-2-8-5-6-\
\1-7-6-4-9\
\-3-----8-"
sodoku2="\
\----13---\
\7-5------\
\1----547-\
\--418----\
\951-67843\
\-2---4--1\
\-6235-9-7\
\--7-98--4\
\89----1-5"
data Position = Position (Int, Int) deriving (Show)
data Sodoku = Sodoku [Int]
insertAtN :: Int -> a -> [a] -> [a]
insertAtN n y xs = intercalate [y] . groups n $ xs
where
groups n xs = takeWhile (not.null) . unfoldr (Just . splitAt n) $ xs
instance Show Sodoku where
show (Sodoku s) = (insertAtN 9 '\n' $ map intToDigit s) ++ "\n"
convertDigit :: Char -> Int
convertDigit x = case x of
'-' -> 0
x -> if digit>=1 && digit<=9 then
digit
else
0
where digit=digitToInt x
convertSodoku :: String -> Sodoku
convertSodoku x = Sodoku $ map convertDigit x
adjacentFields :: Position -> [Position]
adjacentFields (Position (x,y)) =
[Position (i,y) | i<-[0..8]] ++
[Position (x,j) | j<-[0..8]] ++
[Position (u+i,v+j) | i<-[0..2], j<-[0..2]]
where
u=3*(x `div` 3)
v=3*(y `div` 3)
positionToField :: Position -> Int
positionToField (Position (x,y)) = x+y*9
fieldToPosition :: Int -> Position
fieldToPosition x = Position (x `mod` 9, x `div` 9)
getDigit :: Sodoku -> Position -> Int
getDigit (Sodoku x) pos = x !! (positionToField pos )
getAdjacentDigits :: Sodoku -> Position -> [Int]
getAdjacentDigits s p = nub digitList
where
digitList=filter (\x->x/=0) $ map (getDigit s) (adjacentFields p)
getFreePositions :: Sodoku -> [Position]
getFreePositions (Sodoku x) = map fieldToPosition $ elemIndices 0 x
isSolved :: Sodoku -> Bool
isSolved s = (length $ getFreePositions s)==0
isDeadEnd :: Sodoku -> Bool
isDeadEnd s = any (\x->x==0) $ map length $ map (getValidDigits s)$ getFreePositions s
setDigit :: Sodoku -> Position -> Int -> Sodoku
setDigit (Sodoku x) pos digit = Sodoku $ h ++ [digit] ++ t
where
field=positionToField pos
h=fst $ splitAt field x
t=tail$ snd $ splitAt field x
getValidDigits :: Sodoku -> Position -> [Int]
getValidDigits s p = [1..9] \\ (getAdjacentDigits s p)
-- Select numbers with few possible choices first to increase execution time
sortImpl :: (Position, [Int]) -> (Position, [Int]) -> Ordering
sortImpl (_, i1) (_, i2)
| length(i1)<length(i2) = LT
| length(i1)>length(i2) = GT
| length(i1)==length(i2) = EQ
selectMoves :: Sodoku -> Maybe (Position, [Int])
selectMoves s
| length(posDigitList)>0 = Just (head posDigitList)
| otherwise = Nothing
where
posDigitList=sortBy sortImpl $ zip freePos validDigits
validDigits=map (getValidDigits s) freePos
freePos=getFreePositions s
createMoves :: Sodoku -> [Sodoku]
createMoves s=
case selectMoves s of
Nothing -> []
(Just (pos, digits)) -> [setDigit s pos d|d<-digits]
solveStep :: Sodoku -> [Sodoku]
solveStep s
| (isSolved s) = [s]
| (isDeadEnd s )==True = []
| otherwise = createMoves s
solve :: Sodoku -> [Sodoku]
solve s
| (isSolved s) = [s]
| (isDeadEnd s)==True = []
| otherwise=concat $ map solve (solveStep s)
s=convertSodoku sodoku2
readSodoku :: String -> Sodoku
readSodoku x = Sodoku []
An ADT can be represented using the Scott Encoding by replacing products by tuples and sums by matchers. For example:
data List a = Cons a (List a) | Nil
Can be encoded using the Scott Encoding as:
cons = (λ h t c n . c h t)
nil = (λ c n . n)
But I couldn't find how nested types can be encoded using SE:
data Tree a = Node (List (Tree a)) | Leaf a
How can it be done?
If the Wikipedia article is correct, then
data Tree a = Node (List (Tree a)) | Leaf a
has Scott encoding
node = λ a . λ node leaf . node a
leaf = λ a . λ node leaf . leaf a
It looks like the Scott encoding is indifferent to (nested) types. All it's concerned with is delivering the correct number of parameters to the constructors.
Scott encodings are basically representing a T by the type of its case expression. So for lists, we would define a case expression like so:
listCase :: List a -> r -> (a -> List a -> r) -> r
listCase [] n c = n
listCase (x:xs) n c = c x xs
this gives us an analogy like so:
case xs of { [] -> n ; (x:xs) -> c }
=
listCase xs n (\x xs -> c)
This gives a type
newtype List a = List { listCase :: r -> (a -> List a -> r) -> r }
The constructors are just the values that pick the appropriate branches:
nil :: List a
nil = List $ \n c -> n
cons :: a -> List a -> List a
cons x xs = List $ \n c -> c x xs
We can work backwards then, from a boring case expression, to the case function, to the type, for your trees:
case t of { Leaf x -> l ; Node xs -> n }
which should be roughly like
treeCase t (\x -> l) (\xs -> n)
So we get
treeCase :: Tree a -> (a -> r) -> (List (Tree a) -> r) -> r
treeCase (Leaf x) l n = l x
treeCase (Node xs) l n = n xs
newtype Tree a = Tree { treeCase :: (a -> r) -> (List (Tree a) -> r) -> r }
leaf :: a -> Tree a
leaf x = Tree $ \l n -> l x
node :: List (Tree a) -> Tree a
node xs = Tree $ \l n -> n xs
Scott encodings are very easy tho, because they're only case. Church encodings are folds, which are notoriously hard for nested types.