Note that some tasks may deliberately ask you to look at concepts or libraries that we have not yet discussed in detail. But if you are in doubt about the scope of a task, by all means ask.
Please try to write high-quality code at all times! This means in particular that you should add comments to all parts that are not immediately obvious. Please also pay attention to stylistic issues. The goal is always to submit code that does not just correctly do what was asked for, but also could be committed without further changes to an imaginary company codebase.
In this exercise, we want to explore some non-standard prisms.
Define a prism
_Natural :: Prism' Integer Natural(You can find the Natural type of arbitrary-precision natural numbers in module
Numeric.Natural in the base libraries.)
preview _Natural 42 -- Just 42
preview _Natural (-7) -- NothingDefine a function of type
_TheOne :: Eq a => a -> Prism' a ()Given an a, the resulting prism's focus should be the given element:
preview (_TheOne 'x') 'x' -- Just ()
preview (_TheOne 'x') 'y' -- Nothing
review (_TheOne 'x') () -- 'x'Let's define the following wrapper type:
newtype Checked a = Checked { unChecked :: a } deriving ShowDefine a function
_Check :: (a -> Bool) -> Prism' a (Checked a)The idea is that the prism finds only elements that fulfill
the given predicate.
(This will only be a law-abiding prism if we agree to never put an a into
the Checked-wrapper which does not satisfy the predicate.)
preview (_Check odd) 42 -- Nothing
preview (_Check odd) 17 -- Just (Checked {unChecked = 17})
review (_Check odd) (Checked 3) -- 3
Consider the following tree type:
data BinTree a = Tip | Bin (BinTree a) a (BinTree a) deriving ShowDefine three traversals
inorder, preorder, postorder :: Traversal (BinTree a) (BinTree b) a bwhich traverse the nodes in inorder (left, value, right), preorder (value, left, right) and postorder (left, right, value), respectively.
Define two functions
printNodes :: Show a => Traversal' (BinTree a) a
-> BinTree a -> IO ()
labelNodes :: Traversal (BinTree a) (BinTree (a, Int)) a (a, Int)
-> BinTree a -> BinTree (a, Int)Given a traversal, printNodes should print all values stored in the tree
in order of the traversal, whereas labelNodes should label all nodes,
starting at 1, again in the order of the given traversal.
The type constructor Delayed can be used to describe possibly non-terminating
computations in such a way that they remain "productive", i.e., that they produce
some amount of progress information after a finite amount of time.
data Delayed a = Now a | Later (Delayed a)We can now describe a productive infinite loop as follows:
loop :: Delayed a
loop = Later loopThis is productive in the sense that we can always inspect more of the result,
and get more and more invocations of Later.
We can also use Later in other computations as a measure of cost or effort.
For example, here is a version of the factorial function in the Delayed type:
factorial :: Int -> Delayed Int
factorial = go 1
where
go !acc n
| n <= 0 = Now acc
| otherwise = Later (go (n * acc) (n - 1))We can extract a result from a Delayed computation by traversing it all the
way down until we hit a Now, at the risk of looping if there never is one:
unsafeRunDelayed :: Delayed a -> a
unsafeRunDelayed (Now x) = x
unsafeRunDelayed (Later d) = unsafeRunDelayed dDefine a function
runDelayed :: Int -> Delayed a -> Maybe athat extracts a result from a delayed computation if it is guarded
by at most the given number of Later constructors, and Nothing otherwise.
The type Delayed forms a monad, where return is Now, and >>= combines
the number of Later constructors that the left and the right argument are
guarded by.
Define the Functor, Applicative, and Monad instances for Delayed.
Assume we have
tick :: Delayed ()
tick = Later (Now ())
psum :: [Int] -> Delayed Int
psum xs = sum <$> mapM (\ x -> tick >> return x) xsDescribe what psum does.
The type Delayed is actually a free monad. Define the functor DelayedF
such that Free DelayedF is isomorphic to Delayed, and provide the witnesses
of the isomorphism:
fromDelayed :: Delayed a -> Free DelayedF a
toDelayed :: Free DelayedF a -> Delayed aWe can also provide an instance of Alternative:
instance Alternative Delayed where
empty = loop
(<|>) = merge
merge :: Delayed a -> Delayed a -> Delayed a
merge (Now x) _ = Now x
merge _ (Now x) = Now x
merge (Later p) (Later q) = Later (merge p q)Define a function
firstSum :: [[Int]] -> Delayed Intthat performs psum on each of the integer lists and returns the result that
can be obtained with as few delays as possible.
Example:
runDelayed 100 $
firstSum [repeat 1, [1,2,3], [4,5], [6,7,8], cycle [5,6]]should return Just 9.
Unfortunately, firstSum will not work on infinite (outer) lists and
runDelayed 200 $
firstSum $
cycle [repeat 1, [1,2,3], [4,5], [6,7,8], cycle [5,6]]will loop.
The problem is that merge schedules each of the alternatives in a fair way.
When using merge on an infinite list, all computations are evaluated one step
before the first Later is produced. Define
biasedMerge :: Delayed a -> Delayed a -> Delayed athat works on infinite outer lists by running earlier lists slightly sooner than later lists. Write
biasedFirstSum :: [[Int]] -> Delayed Intwhich is firstSum in terms of biasedMerge. Note that biasedFirstSum will
not necessarily always find the shortest computation due to its biased nature,
but it should work on the infinite outer list example above and also in
runDelayed 200 $
biasedFirstSum $
replicate 100 (repeat 1) ++ [[1]] ++ repeat (repeat 1)to return Just 1.
Implement the following functions operating on traversals. This is quite tricky, but if you manage it, you have really understood traversals!
heading :: Traversal' s a -> Traversal' s a
tailing :: Traversal' s a -> Traversal' s a
taking :: Int -> Traversal' s a -> Traversal' s a
dropping :: Int -> Traversal' s a -> Traversal' s a
filtering :: (a -> Bool) -> Traversal' s a -> Traversal' s a
element :: Int -> Traversal' s a -> Traversal' s aIn case the names are not suggestive enough -- here are the expected result when using the various transformations:
set (heading each) "Kenya" 'x' -- "xenya"
set (tailing each) "Kenya" 'x' -- "Kxxxx"
set (taking 3 each) "Kenya" 'x' -- "xxxya"
set (dropping 3 each) "Kenya" 'x' -- "Kenxx"
set (filtering (< 'd') each) "Ulaanbaatar" 'x' -- "xlxxnxxxtxr"
set (element 1 each) "Ulaanbaatar" 'x' -- "Uxaanbaatar"Helper functions with the following signatures might be useful:
trans1 :: Applicative f => (a -> f a) -> (a -> Compose (State Bool) f a)
trans2 :: Applicative f => (a -> f a) -> (a -> Compose (State Int) f a)
trans3 :: Applicative f => (a -> Bool) -> (a -> f a) -> (a -> f a)