Related
Heyy, I'm Haskell beginner and I pretend to do the following function:
occurrences 3 7 [-1,3,-4,3,4,3,-8,7,7,3]
Output that I want:
(4,2)
I made this try but doesn't worked so well, guess I having troubles to count the elements individually and to return the tuple
occurrences a b [] = 0
occurrences a b (x:xs)
| x == a = 1 + occurrences a b xs
| x == b = 1 + occurrences a b xs
| otherwise = occurrences a b xs
I appreciate any tip and help, thanks ;)
A good approach is to add a type signature, and use the error messages to guide you:
occurrences :: (Eq a) => a -> a -> [a] -> (Int, Int)
occurrences a b [] = 0
occurrences a b (x:xs)
| x == a = 1 + occurrences a b xs
| x == b = 1 + occurrences a b xs
| otherwise = occurrences a b xs
The first error is “Could not deduce (Num (Int, Int)) arising from the literal 0 from the context Eq a”. This means that we can’t use 0 in the first equation because it’s not a tuple, or more precisely, there is no Num instance that allows us to convert from the literal 0 to a tuple via fromIntegral. In the base case, we should return a tuple containing 0 for both sums:
occurrences :: (Eq a) => a -> a -> [a] -> (Int, Int)
occurrences a b [] = (0, 0)
occurrences a b (x:xs)
| x == a = 1 + occurrences a b xs
| x == b = 1 + occurrences a b xs
| otherwise = occurrences a b xs
The next error is “Could not deduce (Num (Int, Int)) arising from a use of + from the context Eq a. This means we’re trying to use + on the result of occurrences, but as with the previous error, it doesn’t have a Num instance to provide +, because it’s now a tuple. The fix here is to match on the result of occurrences and add to the first or second element of the tuple accordingly:
occurrences :: (Eq a) => a -> a -> [a] -> (Int, Int)
occurrences a b [] = (0, 0)
occurrences a b (x:xs)
| x == a = let (m, n) = occurrences a b xs in (m + 1, n)
| x == b = let (m, n) = occurrences a b xs in (m, n + 1)
| otherwise = occurrences a b xs
Now this produces the expected result:
> occurrences 'a' 'b' "ababcb"
(2,3)
But we can improve this solution in a few ways. First, a and b remain the same throughout the computation, so we can do the recursion in a helper function instead of passing a and b around to every call.
occurrences :: (Eq a) => a -> a -> [a] -> (Int, Int)
occurrences a b = go
where
go [] = (0, 0)
go (x:xs)
| x == a = let (m, n) = go xs in (m + 1, n)
| x == b = let (m, n) = go xs in (m, n + 1)
| otherwise = go xs
The idiom here is to define f a b … = go where go = …, and replace calls to f a b … with go—because they’re defined as equal! This is a great example of equational reasoning, replacing one side of an equation with the other.
Finally, since every equation of go except the base case contains a tail call to go, it suggests we can express this pattern of recursion with a fold. Here, our accumulator is the pair of results, and the combining function can increment the results accordingly as we step through the list. Since our accumulator is just a pair of integers, it’s a good idea to use a strict fold (foldl').
import Data.List (foldl')
occurrences :: (Eq a) => a -> a -> [a] -> (Int, Int)
occurrences a b = foldl' go (0, 0)
where
go (m, n) x
| x == a = (m + 1, n)
| x == b = (m, n + 1)
| otherwise = (m, n)
Finally, instead of keeping an accumulator and adding elements one by one, we can just map each element to a value (0 or 1) and reduce them by summation. This map/reduce pattern is captured by foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m, which maps each element of a container (t a) to a value (m) and combines the results using a Monoid instance. The monoid to use here is Sum from Data.Monoid, whose Monoid and Semigroup instances define mempty = Sum 0 and Sum a <> Sum b = Sum (a + b) respectively.
import Data.Coerce (coerce)
import Data.Foldable (foldMap)
import Data.Monoid (Sum(..))
occurrences :: (Eq a) => a -> a -> [a] -> (Int, Int)
occurrences a b = coerce . foldMap go
where
go x
| x == a = (Sum (1 :: Int), mempty)
| x == b = (mempty, Sum (1 :: Int))
| otherwise = mempty
We can make use of functions like first :: Arrow a => a b c -> a (b, d) (c, d) and second :: Arrow a => a b c -> a (d, b) (d, c) to construct a tuple where we apply a function to one of the two items of the 2-tuple. For example:
Prelude Control.Arrow> first (1+) (1,4)
(2,4)
Prelude Control.Arrow> second (1+) (1,4)
(1,5)
We thus can use this to update the tuple with:
import Control.Arrow(first, second)
import Data.List(foldl')
occurrences :: (Eq a, Integral i, Integral j, Foldable f) => a -> a -> f a -> (i, j)
occurrences a b = foldl' (flip f) (0, 0)
where f c | a == c = first (1+)
| b == c = second (1+)
| otherwise = id
For the sample input, this produces:
Prelude Control.Arrow Data.List> occurrences 3 7 [-1,3,-4,3,4,3,-8,7,7,3]
(4,2)
We can easily extent this behavior, by making use of lenses to update one of the elements of tuple.
#emg184 gave a good way to solve this problem, but there could be cleaner, easier to read ways to go about doing this. For example:
occurrences x y xs = (count x xs, count y xs)
where count = (length .) . filter . (==)
count could also be written in a more readable:
count x = (length . filter (== x))
You could approach this problem a lot of different way's here is an example of doing it with a fold.
occurrences :: (Eq a) => a -> a -> [a] -> (Int, Int)
occurrences a b list = foldr (\y (a', b') -> ((isEqual y a a'), (isEqual y b b'))) (0, 0) list
where isEqual listEle tupEle count = if (listEle == tupEle) then (count + 1) else count
One of the problem's is you have a type mismatch. you want a type of:
(Int, Int)
Yet you are returning a type of int here once you have an empty list:
occurrences a b [] = 0 -- Int
occurrences a b (x:xs)
| x == a = 1 + occurrences a b xs
| x == b = 1 + occurrences a b xs
| otherwise = occurrences a b xs
You need some type of an accumulator you could do this by where binding a local function that takes your starting tuple of (0, 0) or you could pass it to occurrences like this:
occurrences :: Int -> Int -> [Int] -> (Int, Int) -> (Int, Int)
I would suggest using a local function since you'll always want to start with (0, 0) in this approach.
occurrences' :: (Eq a) => a -> a -> [a] -> (Int, Int)
occurrences' a b list = go list (0,0)
where go x (e1, e2) = if (x == []) then (e1, e2) else (go (tail x) ((isEqual a (head x) e1), (isEqual b (head x) e2)))
isEqual v v' accum = if (v == v') then (accum + 1) else (accum)
This isnt the most idiomatic way to do it but it shows the point. You should try to use types to help with this.,
I'm looking for a Haskell container type like Data.Map that uses intervals as keys, where the left-most and right-most keys may also be unbounded intervals, but are otherwise non-overlapping. Additionally, the container should support a function similar to zipWith that allows to merge two containers into a new one, using the intersection of both key sets as the new key set and the argument function for a pointwise combination of both value sets.
There already are several packages that provide interval-based maps. I've had a look at IntervalMap, fingertree and SegmentTree, but none of these packages seem to provide the desired combination function. They all seem to use intervals for the intersection functions, that are equal in both maps, while I need a version that breaks intervals down into smaller ones if necessary.
The container should basically provide an efficient and storable mapping for key/value series of the form Ord k => k -> Maybe a, i.e. functions only defined on specific intervals or having larger intervals mapping to the same value.
Here is a small example to demonstrate the issue:
... -4 -3 -2 -1 0 1 2 3 4 ... -- key set
-----------------------------------
... -1 -1 -1 -1 0 1 1 1 1 ... -- series corresponding to signum
... 5 5 5 5 5 5 5 5 5 ... -- series corresponding to const 5
The first series could be efficiently expressed by a mapping [-infinity, -1] -> -1; [0, 0] -> 0; [1, infinity] -> 1 and the second one by [-infinity, infinity] -> 5. Now applying a combination function with (*) as arument function should give a new series
... -4 -3 -2 -1 0 1 2 3 4 ... -- key set
-----------------------------------
... -5 -5 -5 -5 0 5 5 5 5 ... -- combined series
The crucial point here—and all of the afore-mentioned packages don't seem to be able to do that—is that, when combining the key sets for these two series, you have to take the different values also into account. Both series span the full range of [-infinity, infinity] but it's necessary to break it into three parts for the final series.
There are also packages for working with intervals, e.g. the range package, which also provides an intersection operation on lists of intervals. However, I didn't found a way to use that in combination with one of the Map variants because it collapses adjacents intervals when doing calculations with them.
NB: Such a container is somewhat similar to a ZipList that extends to both sides, which is why I think it should also be possible to define a lawful Applicative instance for it, where <*> corresponds to the above-mentioned combining function.
To cut a long story short, is there already a package that provides such a container? Or is there an easy way to use the existing packages to build one?
The best suggestion from the comments above seems to be the step-function package, as suggested by B. Mehta. I haven't tried that package yet, but it looks like building a wrapper around that SF type is what I was looking for.
Meanwhile, I implemented another solution which I'd like to share. The code for the combining function (combineAscListWith in the code below) is a bit clumsy as it's more general than for just getting the intersection of both maps, so I'll sketch the idea:
First we need an Interval type with an Ord instance which stores pairs of Val a values which can either be -infinity, some value x or +infinity. Form that we can build an IntervalMap which is just a normal Map that maps these intervals to the final values.
When combining two such IntervalMaps by intersection, we first convert the maps into lists of key/value pairs. Next we traverse both lists in parallel to zip both lists into another one which corresponds to the final intersection map. There are two main cases when combining the list elements:
Both left-most intervals start at the same value. In that case we found an interval that actually overlaps/intersects. We clip the longer interval to the shorter one, and use the values associated with the two intervals to get the result value, which now—together with the shorter interval—goes into the result list. The rest of the longer interval goes back to the input lists.
One of the intervals starts at a smaller value than the other, which means we found a part of the two series that do not overlap. So for the intersection, all of the non-overlapping part of the interval (or even the whole interval) can be discared. The rest (if any) goes back to the input list.
For completeness, here's the full example code. Again, the code is rather clumsy; a step-function-based implementation would certainly be more elegant.
import Control.Applicative
import Data.List
import qualified Data.Map as Map
data Val a = NegInf | Val a | Inf deriving (Show, Read, Eq, Ord)
instance Enum a => Enum (Val a) where
succ v = case v of
NegInf -> NegInf
Val x -> Val $ succ x
Inf -> Inf
pred v = case v of
NegInf -> NegInf
Val x -> Val $ pred x
Inf -> Inf
toEnum = Val . toEnum
fromEnum (Val x) = fromEnum x
data Interval a = Interval { lowerBound :: Val a, upperBound :: Val a } deriving (Show, Read, Eq)
instance Ord a => Ord (Interval a) where
compare ia ib = let (a, a') = (lowerBound ia, upperBound ia)
(b, b') = (lowerBound ib, upperBound ib)
in case () of
_ | a' < b -> LT
_ | b' < a -> GT
_ | a == b && a' == b' -> EQ
_ -> error "Ord.Interval.compare: undefined for overlapping intervals"
newtype IntervalMap i a = IntervalMap { unIntervalMap :: Map.Map (Interval i) a }
deriving (Show, Read)
instance Functor (IntervalMap i) where
fmap f = IntervalMap . fmap f . unIntervalMap
instance (Ord i, Enum i) => Applicative (IntervalMap i) where
pure = IntervalMap . Map.singleton (Interval NegInf Inf)
(<*>) = intersectionWith ($)
intersectionWith :: (Ord i, Enum i) => (a -> b -> c)
-> IntervalMap i a -> IntervalMap i b -> IntervalMap i c
intersectionWith f = combineWith (liftA2 f)
combineWith :: (Ord i, Enum i) => (Maybe a -> Maybe b -> Maybe c)
-> IntervalMap i a -> IntervalMap i b -> IntervalMap i c
combineWith f (IntervalMap mpA) (IntervalMap mpB) =
let cs = combineAscListWith f (Map.toAscList mpA) (Map.toAscList mpB)
in IntervalMap $ Map.fromList [ (i, v) | (i, Just v) <- cs ]
combineAscListWith :: (Ord i, Enum i) => (Maybe a -> Maybe b -> c)
-> [(Interval i, a)] -> [(Interval i, b)] -> [(Interval i, c)]
combineAscListWith f as bs = case (as, bs) of
([], _) -> map (\(i, v) -> (i, f Nothing (Just v))) bs
(_, []) -> map (\(i, v) -> (i, f (Just v) Nothing)) as
((Interval a a', va) : as', (Interval b b', vb) : bs')
| a == b -> case () of
_ | a' == b' -> (Interval a a', f (Just va) (Just vb)) : combineAscListWith f as' bs'
_ | a' < b' -> (Interval a a', f (Just va) (Just vb)) : combineAscListWith f as' ((Interval (succ a') b', vb) : bs')
_ | a' > b' -> (Interval a b', f (Just va) (Just vb)) : combineAscListWith f ((Interval (succ b') a', va) : as') bs'
| a < b -> case () of
_ | a' < b -> ((Interval a a', f (Just va) Nothing)) :
(if succ a' == b then id else ((Interval (succ a') (pred b), f Nothing Nothing) :)) (combineAscListWith f as' bs)
_ | True -> (Interval a (pred b), f (Just va) Nothing) : combineAscListWith f ((Interval b a', va) : as') bs
| a > b -> case () of
_ | b' < a -> ((Interval b b', f Nothing (Just vb))) :
(if succ b' == a then id else ((Interval (succ b') (pred a), f Nothing Nothing) :)) (combineAscListWith f as bs')
_ | True -> (Interval b (pred a), f Nothing (Just vb)) : combineAscListWith f as ((Interval a b', vb) : bs')
showIntervalMap :: (Show i, Show a, Eq i) => IntervalMap i a -> String
showIntervalMap = intercalate "; " . map (\(i, v) -> showInterval i ++ " -> " ++ show v)
. Map.toAscList . unIntervalMap
where
showInterval (Interval (Val a) (Val b)) | a == b = "[" ++ show a ++ "]"
showInterval (Interval a b) = "[" ++ showVal a ++ " .. " ++ showVal b ++ "]"
showVal NegInf = "-inf"
showVal (Val x) = show x
showVal Inf = "inf"
main :: IO ()
main = do
let signumMap = IntervalMap $ Map.fromList [(Interval NegInf (Val $ -1), -1),
(Interval (Val 0) (Val 0), 0), (Interval (Val 1) Inf, 1)]
putStrLn $ showIntervalMap $ (*) <$> signumMap <*> pure 5
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 []
I am trying to understand "Löb and möb: strange loops in Haskell", but right now the meaning is sleaping away from me, I just don't see why it could be useful. Just to recall function loeb is defined as
loeb :: Functor f => f (f a -> a) -> f a
loeb x = go where go = fmap ($ go) x
or equivalently:
loeb x = go
where go = fmap (\z -> z go) x
In the article there is an example with [] functor and spreadsheets implementation, but it is bit foreign for me just as spreadsheets themselves (never used them).
While I'm understanding that spreadsheet thing, I think it would help a lot for me and others to have more examples, despite lists. Is there any application for loeb for Maybe or other functors?
The primary source (I think) for loeb is Dan Piponi's blog, A Neighborhood of Infinity. There he explains the whole concept in greater detail. I'll replicate a little bit of that as an answer and add some examples.
loeb implements a strange kind of lazy recursion
loeb :: Functor a => a (a x -> x) -> a x
loeb x = fmap (\a -> a (loeb x)) x
Let's imagine we have a type a, where Functor a, and an a-algebra (a function of type a x -> x). You might think of this as a way of computing a value from a structure of values. For instance, here are a few []-algebras:
length :: [Int] -> Int
(!! 3) :: [a] -> a
const 3 :: Num a => [a] -> a
\l -> l !! 2 + l !! 3 :: Num a => [a] -> a
We can see that these a-algebras can use both values stored in the Functor and the structure of the Functor itself.
Another way to think of d :: a x -> x is as a value of x which requires some context–a whole Functorized value a x–in order to be computed. Perhaps this interpretation is more clearly written as Reader (a x) x, emphasizing that this is just a value of x which is delayed, awaiting the a x context to be produced.
type Delay q x = q -> x
Using these ideas we can describe loeb as follows. We're given a f-structure containing some Delayed values, where f is a Functor
Functor f, f (Delay q x)
Naturally, if we were given a q then we could convert this into a not delayed form. In fact, there's only one (non-cheating) function that does this polymorphically:
force :: Functor f => f (Delay q x) -> q -> f x
force f q = fmap ($ q) f
What loeb does is handle the extra tricky case where q is actually force f q, the very result of this function. If you're familiar with fix, this is exactly how we can produce this result.
loeb :: Functor a => a (Delay (a x) x) -> a x
loeb f = fix (force f)
So to make an example, we simply must build a structure containing Delayed values. One natural example of this is to use the list examples from before
> loeb [ length :: [Int] -> Int
, const 3 :: [Int] -> Int
, const 5 :: [Int] -> Int
, (!! 2) :: [Int] -> Int
, (\l -> l !! 2 + l !! 3) :: [Int] -> Int
]
[5, 3, 5, 5, 10]
Here we can see that the list is full of values delayed waiting on the result of evaluating the list. This computation can proceed exactly because there are no loops in data dependency, so the whole thing can just be determined lazily. For instance, const 3 and const 5 are both immediately available as values. length requires that we know the length of the list but none of the values contained so it also proceeds immediately on our fixed-length list. The interesting ones are the values delayed waiting on other values from inside our result list, but since (!! 2) only ends up depending on the third value of the result list, which is determined by const 5 and thus can be immediately available, the computation moves forward. The same idea happens with (\l -> l !! 2 + l !! 3).
So there you have it: loeb completes this strange kind of delayed value recursion. We can use it on any kind of Functor, though. All we need to do is to think of some useful Delayed values.
Chris Kuklewicz's comment notes that there's not a lot you could do interestingly with Maybe as your functor. That's because all of the delayed values over Maybe take the form
maybe (default :: a) (f :: a -> a) :: Maybe a -> a
and all of the interesting values of Maybe (Delay (Maybe a) a) ought to be Just (maybe default f) since loeb Nothing = Nothing. So at the end of the day, the default value never even gets used---we always just have that
loeb (Just (maybe default f)) == fix f
so we may as well write that directly.
You can use it for dynamic programming. The example that comes to mind is the Smith-Waterman algorithm.
import Data.Array
import Data.List
import Control.Monad
data Base = T | C | A | G deriving (Eq,Show)
data Diff = Sub Base Base | Id Base | Del Base | Ins Base deriving (Eq,Show)
loeb x = let go = fmap ($ go) x in go
s a b = if a == b then 1 else 0
smithWaterman a' b' = let
[al,bl] = map length [a',b']
[a,b] = zipWith (\l s -> array (1,s) $ zip [1..] l) [a',b'] [al,bl]
h = loeb $ array ((0,0),(al,bl)) $
[((x,0),const 0) | x <- [0 .. al]] ++
[((0,y),const 0) | y <- [1 .. bl]] ++
[((x,y),\h' -> maximum [
0,
(h' ! (x - 1,y - 1)) + s (a ! x) (b ! y),
(h' ! (x - 1, y)) + 1,
(h' ! (x, y - 1)) + 1
]
) | x <- [1 .. al], y <- [1 .. bl]]
ml l (0,0) = l
ml l (x,0) = ml (Del (a ! x): l) (x - 1, 0)
ml l (0,y) = ml (Ins (b ! y): l) (0, y - 1)
ml l (x,y) = let
(p,e) = maximumBy ((`ap` snd) . (. fst) . (const .) . (. (h !)) . compare . (h !) . fst) [
((x - 1,y),Del (a ! x)),
((y, x - 1),Ins (b ! y)),
((y - 1, x - 1),if a ! x == b ! y then Id (a ! x) else Sub (a ! x) (b ! y))
]
in ml (e : l) p
in ml [] (al,bl)
Here is a live example where it is used for: Map String Float
http://tryplayg.herokuapp.com/try/spreadsheet.hs/edit
with loop detection and loop resolution.
This program calculates speed, time and space. Each one depends on the other two. Each cell has two values: his current entered value and the expression as a function of the other cell values/expressions. circularity is permitted.
The Cell recalculation code uses the famous loeb expression by Dan Piponi in the 2006. Until now by my knowledge there haven't been any materialization of this formula on a real working spreadsheet. this one is close to it. Since loeb enters in a infinite loop when circular expressions are used, the program counts the loops and reduces complexity by progressively substituting formulas by cell values until the expression has no loops
This program is configured for immediate recalculation on cell change, but that can be adapted to allow the modification of more than one cell before recalculation by triggering it by means of a button.
This is blog pos:
http://haskell-web.blogspot.com.es/2014/09/spreadsheet-like-program-in-browser.html
When solving system of linear equations by Tridiagonal matrix algorithm in Haskell I met following problem.
We have three vectors: a, b and c, and we want to make a third vector c' which is a combination of them:
c'[i] = c[i] / b[i], i = 0
c'[i] = c[i] / (b[i] - a[i] * c'[i-1]), 0 < i < n - 1
c'[i] = undefined, i = n - 1
Naive implementation of the formula above in Haskell is as follows:
calcC' a b c = Data.Vector.generate n f
where
n = Data.Vector.length a
f i =
| i == 0 = c!0 / b!0
| i == n - 1 = 0
| otherwise = c!i / (b!i - a!i * f (i - 1))
It looks like this function calcC' has complexity O(n2) due to recurrence. But all we actualy need is to pass to inner function f one more parameter with previously generated value.
I wrote my own version of generate with complexity O(n) and helper function mapP:
mapP f xs = mapP' xs Nothing
where
mapP' [] _ = []
mapP' (x:xs) xp = xn : mapP' xs (Just xn)
where
xn = f x xp
generateP n f = Data.Vector.fromList $ mapP f [0 .. n-1]
As one can see, mapP acts like a standard map, but also passes to mapping function previously generated value or Nothing for first call.
My question: is there any pretty standard ways to do this in Haskell? Don't I reinvent the weel?
Thanks.
There are two standard function called mapAccumL and mapAccumR that do precisely what you want.
mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
mapAccumR :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
Basically, they behave like a combination of fold and map.
map f = snd . mapAccumL (\_ x -> (() , f x) ()
foldl f b = fst . mapAccumL (\b x -> (f b x, () ) b
If you use Data.Array, which is lazy, you can express the recurrence directly by referring to c' while defining c'.
Following code seems to be the simplest implementation of formula above in my case:
import qualified Data.Vector.Generic as V
calcC' a b c = V.postscanl' f 0.0 $ V.zip3 a b c
where
f c' (a, b, c) = c / (b - a * c')
Thanks to the authors of Vector who added helpfull postscanl' method.