I will explain how I re-implemented a monad, and even used it without knowing about it. And I am sure you have done the same, at some point, too!

Let’s start with the famous question: What is a Monad?

I’ll try to use as little mathematical definitions as possible, though at some point we’ll definitely need them.

For now, all we need to know, in terms of programming, is that **a Monad is all about being explicit over some piece of code and the result it produces**, by “grouping” different types of “calculations” in such a way that **composing these calculations “makes sense”**. Because being explicit is important, as it tells a lot about our program structure.

To show one example, let’s start by considering the following DSL:

```
data Expr =
Val Float
| Mul Expr Expr
| Div Expr Expr
deriving (Show)
```

Perfect, a small little language that can represent float division and multiplication. How would an `eval`

function look like? Here’s one possibility:

```
eval :: Expr -> Float
eval (Val x) = x
eval (Mul x y) = eval x * eval y
eval (Div x y) = eval x / eval y
```

Cool, we give it an `Expr`

and we always end up with a number. Or do we?

```
> eval (Mul (Val 1) (Val 3))
3.0
> eval (Mul (Val 1) (Val 0))
0.0
> eval (Div (Val 1) (Val 0))
Infinity
```

No worries. We will slightly modify our `eval`

function:

```
eval :: Expr -> Float
eval (Val x) = x
eval (Mul x y) = eval x * eval y
eval (Div x y) =
let x' = eval x in let y' = eval y in
if y' == 0
then error "Division by zero!"
else x' / y'
```

Now we get:

```
> eval (Div (Val 1) (Val 0))
*** Exception: Division by zero!
```

But, this error halts the program completely, and we have no way to catch it and respond to it.

`Either`

to the rescue! We have to rewrite our function… again…

When we get a value that is not erroneous, we will use `Right`

, otherwise, use `Left`

.

```
eval :: Expr -> Either String Float
eval (Val x) = Right x
eval (Mul x y) =
let x' = eval x
y' = eval y in go x' y' where
go (Right x) (Right y) = Right $ x * y
go (Left x) _ = Left x
go _ (Left x) = Left x
eval (Div x y) =
let x' = eval x
y' = eval y in go x' y' where
go (Right x) (Right 0) = Left "Division by zero!"
go (Right x) (Right y) = Right $ x / y
go (Left x) _ = Left x
go _ (Left x) = Left x
```

Perfect little function. We can now use it as follows:

```
> eval (Div (Val 1) (Val 0))
Left "Division by zero!"
> eval (Div (Val 1) (Val 5))
Right 0.2
```

Great, it works! But…

Having to add all those `go`

s for each pattern matching case is a bit tedious… can we somehow make it better? What is common between the first `go`

and the second `go`

?

```
go (Right x) (Right y) = Right $ x * y
go (Left x) _ = Left x
go _ (Left x) = Left x
--
go (Right x) (Right y) = Right $ x / y
go (Left x) _ = Left x
go _ (Left x) = Left x
```

Let’s try to come up with a more generic `go`

. Instead of accepting a value as the second parameter, let’s make it accept a function so that we can either multiply, or divide, or whatever:

```
go (Right x) f = f x
go (Left x) _ = Left x
```

And that’s it. We just implemented a monad for the `Either`

data type. Something similar to this is what I had in my code:

```
whenRight :: Either a t -> (t -> Either a b) -> Either a b
whenRight (Right x) f = f x
whenRight (Left x) _ = Left x
eval :: Expr -> Either String Float
eval (Val x) = Right x
eval (Mul x y) =
let x' = eval x
y' = eval y in whenRight x' (\x'' -> whenRight y' (\y'' -> Right $ x'' * y''))
eval (Div x y) =
let x' = eval x
y' = eval y in whenRight x' (\x'' -> whenRight y' (\y'' -> if y'' == 0 then Left "Division by zero!" else Right $ x'' / y''))
```

Then, the great community at #haskell@libera.chat told me that `whenRight`

is basically Monad’s `bind`

function (`>>=`

):

```
eval :: Expr -> Either String Float
eval (Val x) = Right x
eval (Mul x y) =
let x' = eval x
y' = eval y in x' >>= (\x'' -> y' >>= (\y'' -> Right $ x'' * y''))
eval (Div x y) =
let x' = eval x
y' = eval y in x' >>= (\x'' -> y' >>= (\y'' -> if y'' == 0 then Left "Division by zero!" else Right $ x'' / y''))
```

We can further improve it by using the `do`

notation, even though it’s really just syntactic sugar; `<-`

is `>>=`

and `return`

is `Right`

. In any case, it does help with readability.

```
eval :: Expr -> Either String Float
eval (Val x) = Right x
eval (Mul x y) = do
x' <- eval x
y' <- eval y
Right $ x' * y'
eval (Div x y) = do
x' <- eval x
y' <- eval y
if y' == 0
then Left "Division by zero!"
else Right $ x' / y'
```

Let’s do a quick recap.

We started with a function of type signature `Expr -> Float`

, and then we changed it to `Either String Float`

. This change made things more explicit at the type level, that is, it tells much more what’s going on inside the function, whereas, for `Expr -> Float`

, we didn’t even know that `error`

was being used. By adding this graceful error handling, whoever uses our code can choose how to handle the return value of `Either`

, and they* have* the option to choose, whereas simply using `error`

does not give them that option.

So, we first took a piece of functionality (in this case, simple error handling) and abstracted it using a monad (`whenRight`

). This abstraction helped us make this specific calculation more explicit.

In any case, `Either`

is just one monad. There are many other monads. One interesting bit is how you can combine these monads, say, `IO`

with `Either`

. Monad’s bind function is not commutative so `(io >>= either) :: IO (Either x ())`

is different from, e.g. `(either >>= io) :: Either x (IO ())`

. In any case, whatever way they are combined, the explicitness is preserved.

Given an array of integers, count the number of continuous subsequences, such that elements of every subsequence are arranged in strictly increasing order.

The optimal solution to this puzzle is to use the dynamic programming (DP) technique. But, in order to apply this technique, we first need to express the solution through a recurrent formula. So, I will start first by expressing it in Haskell, and then translate the implementation to PHP.

Before we try to express the problem in terms of a recurrent formula, it’d be good to look at a few examples.

**Example 1**: Consider the array `[0, 1, 2, 3, 15]`

. We can construct the following continuous subsequences such that all elements are in strictly increasing order:

`[0], [1], [2], [3], [15]`

– This list is easy, just the singleton of each element. But, in addition, we have: `[0, 1], [0, 1, 2], [0, 1, 2, 3], [0, 1, 2, 3, 15]`

, where the starting element is 0. And, also: `[1, 2], [1, 2, 3], [1, 2, 3, 15]`

, … and then `[2, 3], [2, 3, 15], [3, 15]`

… which adds to exactly 15 different subsequences.

**Example 2**: Considering the array `[10, 10, 10]`

we end up with `[[10], [10], [10]]`

– a rather trivial example.

This is probably the hardest bit of every DP challenge – coming up with the correct recurrent formula. I don’t know of an easy way to find a formula fast, other than that it is usually a trial & error process – mostly playing around with the examples might give you a hint as to what the formula should look like.

After a while, I figured that the function works pretty well, where is an array and is a list of previous elements (if any). Thus, will represent the current calculation, given as state an array of numbers and another array of previous elements.

Instead of counting, we’ll be building the actual lists – this might help with debugging to see if we actually got the right subsequences constructed. After you figured the original idea out, transforming from building a list to counting numbers is easy, because both operations form a Monoid: .

Let’s start with the most trivial cases – whenever either the list of numbers or the list of previous elements is empty, just return the current known elements:

```
-- in the case of empty array, just return the
-- previous elements
f [] prev = [prev]
-- a singleton array is same as returning [[x]]
f [x] [] = f [] [x]
```

This makes sense, because the subsequences of any singleton list is just that singleton itself (recall the `[10, 10, 10]`

example).

Next, in case there are no previous elements to work with, we just start building the tree by both including and excluding the current element.

```
-- calculate the subsequences of both x included and
-- excluded
f (x:xs) [] = f xs [x] ++ f xs []
```

Why are we doing this? Consider `f [1, 2] []`

. We need to process both `f [2] [1]`

and `f [2] []`

. In the first case, the `1`

needs to be included in the list of previous elements for it to be considered at least as a singleton. In the second case, we test the assumption that it is smaller than the processing element (`2`

in this case) in attempt to include the subsequence `[1, 2]`

.

This reasoning brings us to the next definition:

```
-- if the last element in the previous list is smaller
-- than the current one, include the previous list
-- and in addition the previous list with the current
-- element combined
f (x:xs) prev | last prev < x =
f [] prev ++ f xs (prev ++ [x])
```

In the case the last element in the previous list is smaller than the current processing element, we continue constructing the (continuous) subsequence (e.g. `[1, 2, ...]`

), but also including the current state of previous list, because it’s a valid subsequence (e.g. `[1, 2]`

).

And the final pattern match, in case the last element in the previous list is not smaller than the current processing element:

```
-- otherwise just return the previous list
f (x:xs) prev = f [] prev
```

Trying it out:

```
> f [0, 1, 2, 3, 15] []
[[0],[0,1],[0,1,2],[0,1,2,3],[0,1,2,3,15],[1],[1,2],[1,2,3],[1,2,3,15],[2],[2,3],[2,3,15],[3],[3,15],[15]]
> length $ f [0, 1, 2, 3, 15] []
15
```

Looks correct!

Given what we now have, we can easily move to numbers by replacing `[prev]`

with `1`

(the base case) and `++`

with `+`

(numbers instead of lists):

```
g [] prev = 1
g [x] [] = g [] [x]
g (x:xs) [] = g xs [x] + g xs []
g (x:xs) prev | last prev < x = g [] prev + g xs (prev ++ [x])
g (x:xs) prev = g [] prev
```

In this case, we are just counting and not showing any subsequences, so it kinda makes to make `prev`

be the last number, instead of a list of numbers, but that’s fine.

Trying it out:

```
> g [0, 1, 2, 3, 15] []
15
```

Now that we have an idea of how this problem really works, we can move to our favourite non-FP language: PHP.

We’ll do this in an iterative fashion; we’ll start with a direct translation from Haskell to PHP:

```
function countDecreasingSubarrays( $arr, $prev = [] ) {
// In the case of empty array, just return the previous element (1)
if ( empty( $arr ) || ( 1 == count( $arr ) && empty( $prev ) ) ) {
return 1;
}
// Process the subsequences with both current element included and excluded
if ( empty( $prev ) ) {
return countDecreasingSubarrays( array_slice( $arr, 1 ), [] )
+ countDecreasingSubarrays( array_slice( $arr, 1 ), [ $arr[0] ] );
}
// Prev is non empty and smaller, so we have a count and other stuff to process with it included
if ( end( $prev ) < $arr[0] ) {
return 1 + countDecreasingSubarrays( array_slice( $arr, 1 ), array_merge( $prev, [ $arr[0] ] ) );
}
return 1;
}
```

While this function works (you can try it out), it’s not the most optimal one. We keep slicing an array (which is expensive), so we can improve it by modifying the state space from `$prev`

to `$i, $prev`

where `$i`

will represent the current processing index:

```
function countDecreasingSubarrays_2( $arr, $i = 0, $prev = null ) {
// In the case of empty array, just return the previous element (1)
if ( ! isset( $arr[ $i ] ) || ( $i + 1 == count( $arr ) && is_null( $prev ) ) ) {
return 1;
}
// Process the subsequences with both current element included and excluded
if ( is_null( $prev ) ) {
return countDecreasingSubarrays_2( $arr, $i + 1, null )
+ countDecreasingSubarrays_2( $arr, $i + 1, $arr[ $i ] );
}
// Prev is non empty and smaller, so we have a count and other stuff to process with it included
if ( $prev < $arr[ $i ] ) {
return 1 + countDecreasingSubarrays_2( $arr, $i + 1, $arr[ $i ] );
}
return 1;
}
```

Finally, we can implement memoization for this function, but I’ll leave it at that. Trying it out:

```
php > $x = [0, 1, 2, 3, 15];
php > var_dump( countDecreasingSubarrays_3( $x ) ); // 15
int(15)
php > $x = [10, 10, 10];
php > var_dump( countDecreasingSubarrays_3( $x ) ); // 3
int(3)
php > $x = [9, 8, 7, 6, 5];
php > var_dump( countDecreasingSubarrays_3( $x ) ); // 5
int(5)
```

As stated and as we saw, once we got the right recurrent formula and we were able to express it clearly using the language of mathematics (Haskell), it was pretty easy to convert it to a imperative programming language.

Does it work the other way around (converting from imperative to mathematical)? Probably, but with more effort, at least for me, personally.

But, why bother translating to PHP, or any imperative language for that matter? One thing I found about Haskell is that, while it’s great at expressing mathematical stuff, it’s not so easy (at least for me) to optimize functions. It probably requires more in-depth knowledge around how things work internally, but you could say the same for PHP or any imperative language, I guess. It’s probably that I just have more experience with dealing with algorithms and optimizations in these languages.

In any case, you should now go and learn some Haskell!

]]>In this post we’ll provide an implementation of these systems in Haskell.

On page 181 the symbols of the system are listed. We can map them nicely in Haskell:

```
data PropCalc =
P | Q | R
| Not PropCalc
| And PropCalc PropCalc
| Or PropCalc PropCalc
| Imp PropCalc PropCalc
deriving (Show, Eq)
```

We will slightly rewrite this to make it more generic. This will allow us to later embed this system in other systems.

```
data VarEg = P | Q | R deriving (Show, Eq)
data PropCalc a =
PropVar a
| Not (PropCalc a)
| And (PropCalc a) (PropCalc a)
| Or (PropCalc a) (PropCalc a)
| Imp (PropCalc a) (PropCalc a)
deriving (Show, Eq)
```

In the book, what follows after this is a list of formation rules. For example, here’s how we can implement and-intro and and-elim:

```
-- And intro
ruleJoin :: PropCalc a -> PropCalc a -> PropCalc a
ruleJoin x y = And x y
-- And elim l
ruleSepL :: PropCalc a -> PropCalc a
ruleSepL (And x y) = x
ruleSepL x = x
-- And elim r
ruleSepR :: PropCalc a -> PropCalc a
ruleSepR (And x y) = y
ruleSepR x = x
```

That is, we just lift the values from the object level to Haskell’s level, and Haskell’s neat type system takes care of everything else.

Perhaps the most powerful rule is the implication-intro. Here’s its implementation:

```
-- Imp intro
ruleCarryOver :: (PropCalc a -> PropCalc a) -> PropCalc a -> PropCalc a
ruleCarryOver f x = Imp x (f x)
```

We rely on Haskell’s machinery for functions (lambda calculus) to take care of it. Now we can prove neat stuff, such as :

```
> ruleCarryOver (\pq -> ruleJoin (ruleSepR pq) (ruleSepL pq)) (ruleJoin (PropVar P) (PropVar Q))
Imp (And (PropVar P) (PropVar Q)) (And (PropVar Q) (PropVar P))
```

Another proof that :

```
> ruleCarryOver (\x -> ruleCarryOver (\y -> ruleJoin x y) (PropVar Q)) (PropVar P)
Imp (PropVar P) (Imp (PropVar Q) (And (PropVar P) (PropVar Q)))
```

Neat!

One of the rules is about double negation, which the author refers to as the double-tilde rule, meaning that and are interchangeable. Their implementation in Haskell is simple:

```
-- Not intro
ruleDoubleTildeIntro :: PropCalc a -> PropCalc a
ruleDoubleTildeIntro x = Not (Not x)
-- Not elim
ruleDoubleTildeElim :: PropCalc a -> PropCalc a
ruleDoubleTildeElim (Not (Not x)) = x
ruleDoubleTildeElim x = x
```

So now we can do stuff like:

```
> ruleDoubleTildeIntro (PropVar Q)
Not (Not (PropVar Q))
```

However, how do we apply this rule to within ? Our current implementation doesn’t allow for that, because it only accepts a full formula and doesn’t know how to do replacements in its subformulas. Let’s fix this.

The idea is to create a function that will accept a “path” (which subformula we want to work on), a rule that will be applied to this subformula, and a formula.

```
data Pos = GoLeft | GoRight
type Path = [Pos]
applyPropRule :: Path -> (PropCalc a -> PropCalc a) -> PropCalc a -> PropCalc a
applyPropRule [] f x = f x
applyPropRule (GoLeft:xs) f (Not x) = Not (applyPropRule xs f x)
applyPropRule (GoLeft:xs) f (And x y) = And (applyPropRule xs f x) y
applyPropRule (GoLeft:xs) f (Or x y) = Or (applyPropRule xs f x) y
applyPropRule (GoLeft:xs) f (Imp x y) = Imp (applyPropRule xs f x) y
applyPropRule (GoRight:xs) f (Not x) = Not (applyPropRule xs f x)
applyPropRule (GoRight:xs) f (And x y) = And x (applyPropRule xs f y)
applyPropRule (GoRight:xs) f (Or x y) = Or x (applyPropRule xs f y)
applyPropRule (GoRight:xs) f (Imp x y) = Imp x (applyPropRule xs f y)
applyPropRule _ _ x = x
```

Of course, going left or right doesn’t make much sense for unary operators, so our implementation will just drill down in the `Not`

operator if it finds either a left or a right. But, left and right do make sense for binary operators – we drill on the left and the right argument respectively.

Now we can use it to apply the double negation rule to within as follows:

```
> applyPropRule [GoRight, GoRight] ruleDoubleTildeIntro (And (PropVar P) (Or (PropVar Q) (PropVar R)))
And (PropVar P) (Or (PropVar Q) (Not (Not (PropVar R))))
```

Neat! We now have our logic defined. The full code of this logic is available here.

Starting on page 204, a description of a number theoretic system is given which implements Peano’s axioms, under the name TNT – Typographical Number Theory. Further, the logic we defined earlier is embedded into this system.

Let’s start by writing the Haskell implementation for TNT.

For the arithmetical part, we have variables, zero, and the operations successor, addition, multiplication.

```
data Vars = A | B | C | D | E deriving (Show, Eq)
data Arith =
Var Vars
| Z
| S Arith
| Plus Arith Arith
| Mult Arith Arith
deriving (Show, Eq)
```

Now we can represent things like as follows:

```
> Plus Z (Mult (S Z) (Var A))
Plus Z (Mult (S Z) (Var A))
```

The next step is to implement the components from first-order logic (quantifiers and arithmetical equations):

```
data FOL =
Eq Arith Arith
| ForAll Vars (PropCalc FOL)
| Exists Vars (PropCalc FOL)
deriving (Show, Eq)
```

We can now encode Peano’s axioms as follows:

```
-- forall a, not (S a = 0)
axiom1 = PropVar (ForAll A (Not (PropVar (Eq (S (Var A)) Z))))
-- forall a, (a + 0) = a
axiom2 = PropVar (ForAll A (PropVar (Eq (Plus (Var A) Z) (Var A))))
-- forall a, forall b, a + Sb = S(a + b)
axiom3 = PropVar (ForAll A (PropVar (ForAll B (PropVar (Eq (Plus (Var A) (S (Var B))) (S (Plus (Var A) (Var B))))))))
-- forall a, (a * 0) = 0
axiom4 = PropVar (ForAll A (PropVar (Eq (Mult (Var A) Z) Z)))
-- forall a, forall b, a * Sb = (a * b + a)
axiom5 = PropVar (ForAll A (PropVar (ForAll B (PropVar (Eq (Mult (Var A) (S (Var B))) (Plus (Mult (Var A) (Var B)) (Var A)))))))
```

Neat. We will only list a few of the rules here, for the sake of example:

```
-- Rule of interchange: forall x !y -> ! exists x, y
ruleInterchangeL :: PropCalc FOL -> PropCalc FOL
ruleInterchangeL (PropVar (ForAll x (Not y))) = Not (PropVar $ Exists x y)
ruleInterchangeL x = x
-- Rule of symmetry: a = b == b == a
ruleSymmetry :: PropCalc FOL -> PropCalc FOL
ruleSymmetry (PropVar (Eq a b)) = PropVar (Eq b a)
ruleSymmetry x = x
```

Similarly to `applyPropRule`

, we construct `applyFOLRule`

:

```
-- Might be useful for some rules that may require drilling, like `ruleInterchangeL`
applyFOLRule :: Path -> (PropCalc FOL -> PropCalc FOL) -> PropCalc FOL -> PropCalc FOL
applyFOLRule [] f x = f x
applyFOLRule (_:xs) f (PropVar (ForAll x y)) = PropVar (ForAll x (applyFOLRule xs f y))
applyFOLRule (_:xs) f (PropVar (Exists x y)) = PropVar (Exists x (applyFOLRule xs f y))
applyFOLRule (_:xs) f (Not x) = Not (applyFOLRule xs f x)
applyFOLRule (GoLeft:xs) f (And x y) = And (applyFOLRule xs f x) y
applyFOLRule (GoRight:xs) f (And x y) = And x (applyFOLRule xs f y)
applyFOLRule (GoLeft:xs) f (Or x y) = Or (applyFOLRule xs f x) y
applyFOLRule (GoRight:xs) f (Or x y) = Or x (applyFOLRule xs f y)
applyFOLRule (GoLeft:xs) f (Imp x y) = Imp (applyFOLRule xs f x) y
applyFOLRule (GoRight:xs) f (Imp x y) = Imp x (applyFOLRule xs f y)
applyFOLRule _ _ x = x
```

Now we can proceed with an example proof:

```
> step1 = applyFOLRule [] ruleInterchangeL axiom1
Not (PropVar (Exists A (PropVar (Eq (S (Var A)) Z))))
> step2 = applyFOLRule [GoRight, GoRight] ruleSymmetry step1
Not (PropVar (Exists A (PropVar (Eq Z (S (Var A))))))
> step3 = applyFOLRule [GoRight, GoRight] ruleDoubleTildeIntro step2 -- apply from Gentzen
Not (PropVar (Exists A (Not (Not (PropVar (Eq Z (S (Var A))))))))
```

That is, from , we proved that follows, which is awesome Note how we applied a rule from the embedded system (Gentzen) within the current system (TNT).

This wraps our number theoretical system. The full code of this system is available here.

Not sure what to conclude here, other than that I had fun implementing this.

For the nth time, I was amazed by Haskell’s machinery to encode systems like these. With this implementation, I think I really got to see how powerful Haskell is for tasks like this.

I could have probably used Racket (Scheme) for this, but implementing all the rules and the `applyXrule`

functions was a breeze given Haskell’s type-checking mechanism.

We are given two arrays, one with adjectives and another one with nouns . A combined list is which is the Cartesian product between the two arrays. We want to build a performant way to get specific a subarray of of arbitrary size at a specific page.

Consider the list of adjectives together with the list of nouns – note that the values are ordered. Here are the combinations: .

Considering the page size to be 2, we have the following options:

```
Page #0: A 1, A 2
Page #1: A 3, B 1
Page #2: B 2, B 3
```

Considering the page size to be 3, we have the following options:

```
Page #0: A 1, A 2, A 3
Page #1: B 1, B 2, B 3
```

The question is, is there a way to produce a programmatic and performant solution for this?

We can directly translate the mathematical description into code and see where that leads us.

We implement the functions `generateCombinations`

and `getPage`

as follows:

```
<?php
function generateCombinations( $adjs, $nouns ) {
$list = array();
foreach ( $adjs as $adj ) {
foreach ( $nouns as $noun ) {
$list[] = $adj . ' ' . $noun;
}
}
return $list;
}
function getPage( $combinations, $pageIndex, $pageSize ) {
return array_slice( $combinations, $pageIndex * $pageSize, $pageSize );
}
```

So, for example, the following code produces the output:

```
$combinations = generateCombinations( array( 'A', 'B' ), array( '1', '2', '3' ) );
var_dump( getPage( $combinations, 0, 2 ) );
var_dump( getPage( $combinations, 1, 2 ) );
var_dump( getPage( $combinations, 2, 2 ) );
// A 1, A 2
// A 3, B 1
// B 2, B 3
```

Things look good so far. However, note that `generateCombinations`

takes of processing time, so if we use it on large lists we would have to wait for a long time…

Well, for one thing, this problem is very easy to solve in a language that has support for lazy evaluation, because we want to avoid generating *all* possible combinations, and generate only those that we need – that will be used in the pagination.

Consider the following (two lines of) code in Haskell:

```
generateCombinations :: [String] -> [String] -> [String]
generateCombinations adjs nouns = [ adj ++ " " ++ noun | adj <- adjs, noun <- nouns ]
getPage :: [String] -> Int -> Int -> [String]
getPage combinations pageIndex pageSize = take pageSize $ drop (pageIndex * pageSize) combinations
```

Haskell will perform this blazingly fast, even when both of the lists of adjectives and nouns are of size 10k (which sum to 100 million combinations)..

But how can we make this faster in PHP?

We want to get around `generateCombinations`

somehow. One way to do it is to calculate the exact page indices we want to use and only extract those, instead of generating all combinations and going through those. Calculating page indices and sizes of a single-dimensional array is quite simple; in PHP, this is basically `getPage`

that we saw earlier. But, in the case of two-dimensional arrays, it’s a bit trickier.

So, we want to calculate exactly which indices/offsets we need to pick from `$adjs`

and `$nouns`

(depending on page index and page size), and only calculate the values for those. This is possible to achieve, because the calculation `$list[] = $adj . ' ' . $noun;`

does not depend on any previous state. So, essentially we’re doing lazy evaluation by hand in PHP, whereas in Haskell it’s done automatically for us.

So how do we approach this? Let’s consider an example, and we’ll build from there. Consider, as before, the list of adjectives together with the list of nouns . Recall that this is what we get for different page sizes:

Page size 2: , or, in indices:

So the starting adjective indices are 0, 0, and 1 respectively for page index 0, 1, 2. Similarly, the noun indices are 0, 2, 1 respectively.

Page size 3: , or, in indices:

For simplicity, consider the page size to be equal to . Now, If we multiply the page size by the page index, we will get the position/offset of the starting element in the list of generated combinations. For example page index = 1, page size = 3, thus 1 * 3 gives us 3 which is the starting position of (i.e. ) on the second page. Another example is page index = 0, page size = 3, thus 0 * 3 gives us 0 which is the starting position of (i.e. ) on the first page. Since every adjective will have nouns, we can divide by to get the starting index of the adjective. Thus, the general formula is: . Now, if the page size is not equal to , we’ll need to use floor to get to the nearest index, so here’s the final formula: .

Similarly, we can determine to get the coordinate of the noun at the specific index.

Here’s the complete code:

```
function getPage_2( $adjs, $nouns, $pageIndex, $pageSize ) {
$adjsLen = count( $adjs );
$nounsLen = count( $nouns );
$adjIndex = floor( $pageIndex * $pageSize / $nounsLen );
$nounIndex = $pageIndex * $pageSize - $adjIndex * $nounsLen;
$list = array();
for ( $cnt = 0; $cnt < $pageSize; $cnt++, $nounIndex++ ) {
if ( $nounIndex == $nounsLen ) {
$nounIndex = 0;
$adjIndex++;
}
if ( ! isset( $adjs[ $adjIndex ] ) ) {
break;
}
$list[] = $adjs[ $adjIndex ] . ' ' . $nouns[ $nounIndex ];
}
return $list;
}
```

Things like this are always interesting to me, how programming languages affect our thoughts.

In Haskell, it’s enough to think mathematically for cases like this, whereas in PHP you have to dig deep into the specifics of the calculation.

I guess that is the beauty of knowing multiple programming paradigms, but you need to be prepared to do a mental shift depending on which environment you work

]]>What is an imperative programming language? Well, nowadays they run the world. C, Python, JavaScript, PHP – you name it – we all write code in them using imperative style; that is, we command the computer and tell it what to do and how to do it. The mathematical language is very unlike this – it is more declarative rather than imperative – it doesn’t care about the how.

I’ve always been fascinated by mathematical proofs, especially the mechanical part around them because computers are directly involved in this case. Hoare logic is one of those systems that allows us to mechanically reason about computer programs.

We will implement a small imperative language together with (a very simple) Hoare Logic that will allow us to reason about programs in this imperative language.

If you haven’t gone through Logical Foundations, I strongly suggest you do. It’s programming at a different level – even if you know some Haskell already (and if you don’t know Haskell, you should learn it, too). If Logical Foundations seems too much, you can start with my book first, which is a gentler introduction.

If you’ve gone through Logical Foundations, congratulations! In any case, there’s still something to learn from this blog post. In Logical Foundations, we use the dependently typed programming language Coq. There are some advantages and disadvantages in this case. The obvious disadvantage is that all programs must be total and must terminate. As the authors from Logical Foundations say:

In a traditional functional programming language like OCaml or Haskell we could add the while case as follows:

…

Coq doesn’t accept such a definition (“Error: Cannot guess decreasing argument of fix”) because the function we want to define is not guaranteed to terminate.

The advantage is that we can mathematically reason about all such programs.

Implementing an imperative language in Haskell is more concerned about playing at the value level (and to some extent at the type level), whereas in Coq, we’re completely playing at the type level.

Let’s start by implementing a very small arithmetic language: one that can do addition, subtraction and multiplication:

```
data Aexp =
ANum Integer
| APlus Aexp Aexp
| AMinus Aexp Aexp
| AMult Aexp Aexp
deriving (Show)
aeval :: Aexp -> Integer
aeval (ANum n) = n
aeval (APlus a1 a2) = aeval a1 + aeval a2
aeval (AMinus a1 a2) = aeval a1 - aeval a2
aeval (AMult a1 a2) = aeval a1 * aeval a2
```

That was easy. A simple evaluation:

```
> aeval (APlus (ANum 1) (ANum 3))
4
```

While the previous language dealt with numbers, we now want a language that will deal with boolean expressions.

```
data Bexp =
BTrue
| BFalse
| BEq Aexp Aexp
| BLe Aexp Aexp
| BNot Bexp
| BAnd Bexp Bexp
deriving (Show)
beval :: Bexp -> Bool
beval BTrue = True
beval BFalse = False
beval (BEq a1 a2) = aeval a1 == aeval a2
beval (BLe a1 a2) = aeval a1 <= aeval a2
beval (BNot b1) = not (beval b1)
beval (BAnd b1 b2) = beval b1 && beval b2
```

Note that this language depends on `aeval`

for some calculations, but it’s still its own language.

```
> beval $ BEq (APlus (ANum 1) (ANum 0)) (APlus (ANum 0) (ANum 1))
True
```

Perfect.

We now turn to the main point, and start implementing a small imperative language.

```
data Command =
CSkip -- NOP
| CAss Char Aexp -- X := Y
| CSeq Command Command -- A; B
| CIfElse Bexp Command Command -- If A then B else C
| CWhile Bexp Command -- While A { B }
deriving (Show)
```

Note that in the `CAss`

(assignment) case, we use chars to denote variables (`'A'`

, `'B'`

, …). So our language supports expressions like `X := 3`

(which is `CAss 'X' (ANum 3)`

). Great!

Hmm, what about `X := Y`

? It seems that we need to bring variables at the arithmetic level.

We modify our arithmetic language to supports variables.

```
data Aexp =
ANum Integer
| AId Char -- This is new.
| APlus Aexp Aexp
| AMinus Aexp Aexp
| AMult Aexp Aexp
deriving (Show)
```

Now for the eval function:

```
aeval :: Aexp -> Integer
aeval (AId v) = ???
aeval (ANum n) = n
aeval (APlus a1 a2) = aeval a1 + aeval a2
aeval (AMinus a1 a2) = aeval a1 - aeval a2
aeval (AMult a1 a2) = aeval a1 * aeval a2
```

Whoops. We’re stuck for the `AId`

case. Where do we read this variable from? We turn to contexts (or environments). A context is just a map of chars (variables) to integers (results in our arithmetic language).

```
import qualified Data.Map as M
type Context = M.Map Char Integer
aeval :: Context -> Aexp -> Integer
aeval ctx (AId v) = ctx M.! v -- careful: element may not exist
aeval ctx (ANum n) = n
aeval ctx (APlus a1 a2) = aeval ctx a1 + aeval ctx a2
aeval ctx (AMinus a1 a2) = aeval ctx a1 - aeval ctx a2
aeval ctx (AMult a1 a2) = aeval ctx a1 * aeval ctx a2
```

A few simple evaluations:

```
> aeval (M.fromList [('X', 3)]) (AId 'X')
3
> aeval (M.fromList [('X', 3)]) (APlus (AId 'X') (ANum 1))
4
```

Recall that the boolean language was dependent on the arithmetic language, so naturally, the changes in the arithmetic language would impact the boolean language as well. It’s just a matter of passing contexts around.

```
beval :: Context -> Bexp -> Bool
beval ctx BTrue = True
beval ctx BFalse = False
beval ctx (BEq a1 a2) = aeval ctx a1 == aeval ctx a2
beval ctx (BLe a1 a2) = aeval ctx a1 <= aeval ctx a2
beval ctx (BNot b1) = not (beval ctx b1)
beval ctx (BAnd b1 b2) = beval ctx b1 && beval ctx b2
```

Neat.

It looks like we have everything we need now. So we turn to the evaluation function:

```
eval :: Context -> Command -> Context
eval ctx CSkip = ctx
eval ctx (CAss c v) = M.insert c (aeval ctx v) ctx
eval ctx (CSeq c1 c2) = let ctx' = eval ctx c1 in eval ctx' c2
eval ctx (CIfElse b c1 c2) = eval ctx $ if beval ctx b then c1 else c2
eval ctx (CWhile b c) = if beval ctx b
then let ctx' = eval ctx c in eval ctx' (CWhile b c)
else ctx
```

The evaluation function basically accepts a context (or state, or environment), a command, and then returns a modified context (or state, or environment).

`CSkip`

is like the NOP (no operation) of imperative programs. Think of it as the empty statement.`CAss`

will insert a variable to the context.`CSeq`

will join two commands and evaluate them both (this allows us to evaluate commands in sequence).`CIfElse`

accepts a boolean, and depending on its value either executes one command, or another`CWhile`

keeps executing a command as long as the boolean is true

Let’s now try to represent factorial in our language. In pseudo-code, it would be:

```
Z := X
Y := 1
while (~Z = 0)
Y := Y * Z
Z := Z - 1
```

This program will store the factorial of `X`

in `Y`

, that is, `Y = X!`

.

And here’s the same algorithm represented in our imperative programming language:

```
fact_X =
let l1 = CAss 'Z' (AId 'X')
l2 = CAss 'Y' (ANum 1)
l3 = CWhile (BNot (BEq (AId 'Z') (ANum 0))) (CSeq l4 l5)
l4 = CAss 'Y' (AMult (AId 'Y') (AId 'Z'))
l5 = CAss 'Z' (AMinus (AId 'Z') (ANum 1))
in CSeq l1 (CSeq l2 l3)
```

Fancy.

```
> eval (M.fromList [('X', 5)]) fact_X
fromList [('X',5),('Y',120),('Z',0)]
```

It calculated that `5! = 120`

. Looks good to me. So much for the imperative language.

We now want a way to verify properties about our program. There are two ways we can do this:

- At the meta level: Very easy, we just implement a function in Haskell
- At the object level (inside the imperative language): A bit trickier, but still easy

Here’s the straight-forward implementation:

```
assert :: Context -> Bexp -> Command -> Bexp -> Bool
assert ctx boolPre cmd boolPost =
beval ctx boolPre &&
beval (eval ctx cmd) boolPost
```

Together with an example proof that `5! = 120`

:

```
fact_Proof = assert
(M.fromList [('X', 5)]) -- Initial context
(BEq (ANum 5) (AId 'X')) -- Before: X == 5
fact_X
(BEq (ANum 120) (AId 'Y')) -- After: Y == 120 (Y = X!)
```

Trying it out:

```
> fact_Proof
True
```

It proved it!

This change will affect our programming language in several ways. We have to do a bunch of changes here and there.

First, let’s import `Data.Either`

– we’ll see in a moment why we need it:

```
import Data.Either
```

Next, let’s slightly modify our `Command`

:

```
data Command =
...
| CAssert Bexp Command Bexp
...
```

The new `eval'`

function will not always return a context. It can now return an error as well (`String`

) – this will happen in the case when the assertion was not fulfilled at runtime. Here’s the new function:

```
eval' :: Context -> Command -> Either String Context
eval' ctx CSkip = Right ctx
eval' ctx (CAss c v) = Right $ M.insert c (aeval ctx v) ctx
eval' ctx (CSeq c1 c2) = let ctx' = eval' ctx c1 in whenRight ctx' (\ctx'' -> eval' ctx'' c2)
eval' ctx (CIfElse b c1 c2) = eval' ctx $ if beval ctx b then c1 else c2
eval' ctx (CWhile b c) = if beval ctx b
then let ctx' = eval' ctx c in whenRight ctx' (\ctx'' -> eval' ctx'' (CWhile b c))
else Right ctx
whenRight :: Either a t -> (t -> Either a b) -> Either a b
whenRight (Right x) f = f x
whenRight (Left x) _ = Left x
whenLeft :: Either t b -> (t -> Either a b) -> Either a b
whenLeft (Left x) f = f x
whenLeft (Right x) _ = Right x
```

Nothing new going on, we just added handling to propagate the error in case it happens. The real deal is in handling the case for the `CAssert`

command:

```
eval' ctx (CAssert b1 c b2) =
if beval ctx b1
then whenRight (eval' ctx c)
(\ctx'' -> if beval ctx'' b2
then Right ctx''
else Left "Post-condition does not match!")
else Left "Pre-condition does not match!"
```

Few evaluations:

```
> eval' (M.fromList [('X', 0)]) (CAssert (BEq (AId 'X') (ANum 0)) CSkip (BEq (AId 'X') (ANum 0)))
Right (fromList [('X',0)])
> eval' (M.fromList [('X', 0)]) (CAssert (BEq (AId 'X') (ANum 1)) CSkip (BEq (AId 'X') (ANum 0)))
Left "Pre-condition does not match!"
> eval' (M.fromList [('X', 0)]) (CAssert (BEq (AId 'X') (ANum 0)) CSkip (BEq (AId 'X') (ANum 1)))
Left "Post-condition does not match!"
```

In the previous chapter, we implemented assertions at the run-time level. The biggest disadvantage of that is we have to do a full evaluation in order to conclude some proposition. For example, consider `fact_Proof`

– it had to actually evaluate the factorial to conclude that `X = 120`

.

You know how some languages like Python don’t have a compile step? Well, our implementation is kind of equivalent to that. But some languages do have a compile step, like C or Haskell. And this compilation step can be very useful. It can do a lot of checks, e.g. type checks (mathematical proofs!). That’s what we’ll try to do here – implement a “compile”-time check.

Compile-time, run-time, whatever-time is all about having evaluations at different levels. There is still computation going on, but e.g. the computation strategies at the compile-time level may be different from those at the run-time level.

For example, evaluating `Command`

can be expensive, and sometimes even not terminate (our language is _not_ strongly normalizing); consider the evaluation of `CWhile BTrue CSkip`

. But, still, we want to deduce propositions without going through all evaluations. e.g. deduce something about without evaluating .

The way to achieve this, just as a proof of concept, is to implement a subset of Hoare Logic. This sounds easy but is actually quite complicated. To start with, I found some useful slides. The mathematical formulas for Hoare logic can be found there, and even though they look simple, implementing them is a completely different thing. The implementation details cover stuff like “what expressions do we want to support”, “are we working with a strongly normalizing language”, “what’s the language that will represent propositions”, etc. while mathematics does not care about these deals.

What’s a Hoare triple? It’s a command, having a pre-condition (`Bexp`

) and a post-condition (`Bexp`

). In this case, we decided that pre/post-conditions will be in the language of `Bexp`

, but they can also be in a different language (regardless of that `Bexp`

is used in `Command`

).

```
data HoareTriple =
HoareTriple Bexp Command Bexp
deriving (Show)
```

We’ll start by implementing a small subset of Hoare assignment. Given an assignment command `V := E`

, it will produce the triple where the precondition is `Q[E/V]`

and the postcondition is `Q`

, for any `Q`

(p. 15 of the slides).

```
hoareAssignment :: Command -> Bexp -> Maybe HoareTriple
hoareAssignment (CAss v e) q = Just $ HoareTriple (substAssignment q e v) (CAss v e) q
hoareAssginment _ _ = Nothing
```

What about `substAssignment`

? This is another case where we have to make a design decision – how far do we want to go. There are several ways:

- One way to do it is to do full-blown
`Bexp`

/`Aexp`

evaluation (since those are strongly normalizing, compared to`Command`

) but this evaluation can still take some time. - Another way is to specify a language (a subset of
`Aexp`

/`Bexp`

) that only has some certain properties and is faster to evaluate. - The third way is to specify some concrete set of “optimizations” (or mathematical rewrites) that we will support, based on our original language (
`Aexp`

/`Bexp`

).

We’ll go with the third way.

```
substAssignment :: Bexp -> Aexp -> Char -> Bexp
substAssignment q@(BEq (AId x) y) e v
| x == v = BEq e y
| otherwise = q
substAssignment q@(BEq x (AId y)) e v
| y == v = BEq e (AId y)
| otherwise = q
substAssignment q _ _ = q
```

In this case, we just implement replacing when either the expression on the left or on the right is a variable. Our program can now “prove” some real cool properties, such as:

```
> hoareAssignment (CAss 'X' (ANum 3)) (BEq (AId 'X') (ANum 3))
Just (HoareTriple (BEq (ANum 3) (ANum 3)) (CAss 'X' (ANum 3)) (BEq (AId 'X') (ANum 3)))
```

That is, given the pre-condition that `3 = 3`

, the assignment `X := 3`

implies that `X = 3`

. Note how we don’t check the validity of the pre-condition (since that would require evaluating `Aexp`

/`Bexp`

). We just say that assuming this pre-condition, this command produces that post-condition. Pretty cool!

We can also implement `hoareSkip`

as follows:

```
hoareSkip :: Command -> Bexp -> Maybe HoareTriple
hoareSkip (CSkip) q = Just $ HoareTriple q CSkip q
hoareSkip _ _ = Nothing
```

Now, in addition, the following Hoare triple can be produced:

```
> hoareSkip CSkip (BEq (AId 'X') (ANum 3))
Just (HoareTriple (BEq (AId 'X') (ANum 3)) CSkip (BEq (AId 'X') (ANum 3)))
```

Finally, we will implement the Hoare sequence rule.

Start by adding `deriving Eq`

to both `Aexp`

and `Bexp`

– we will need this to be able to compare expressions from either of those languages.

```
hoareSequence :: HoareTriple -> HoareTriple -> Maybe HoareTriple
hoareSequence (HoareTriple p c1 q1) (HoareTriple q2 c2 r)
| q1 == q2 = Just $ HoareTriple p (CSeq c1 c2) r
| otherwise = Nothing
```

We can now sequence our programs as follows:

```
> import Data.Maybe (fromJust)
> let first = hoareAssignment (CAss 'X' (ANum 3)) (BEq (AId 'X') (ANum 3)) in let second = hoareSkip CSkip (BEq (AId 'X') (ANum 3)) in hoareSequence (fromJust first) (fromJust second)
Just (HoareTriple (BEq (ANum 3) (ANum 3)) (CSeq (CAss 'X' (ANum 3)) CSkip) (BEq (AId 'X') (ANum 3)))
```

Which is awesome!

The final code can be found at https://github.com/bor0/hoare-imp/.

This was a cool small research project that I did. I always enjoy tackling languages, mathematical proofs, and programs. The beautiful thing is that Hoare’s logic combines all of these. And tackling them is fun because they lie at the heart of Computer Science.

]]>In this post, weâ€™ll tackle the 13th problem of AoC2020,Â Shuttle Search.

This part was straight-forward. We ignore the `x`

in the list, so e.g. `[7,13,x,x,59,x,31,19]`

becomes `[7,13,59,31,19]`

. For this list and a given stamp of 939, to find the departure we need to find all earliest departures after 939, so the list becomes `[945,949,944,961,950]`

. Earliest is 944 (bus ID 59), so we have 944 – 939 = 5 minutes before it departs, and so 5 * 59 = 295.

In code:

```
findEarliestBus busIds stamp = ( fst nearestStampId - stamp ) * snd nearestStampId where
stampIds = map (\x -> (x * (1 + stamp `div` x), x)) busIds
nearestStampId = minimum stampIds
```

And an example:

```
Main> map (\x -> (x * (1 + 939 `div` x), x)) [7,13,59,31,19]
[(945,7),(949,13),(944,59),(961,31),(950,19)]
Main> findEarliestBus [7,13,59,31,19] 939
295
```

This part is a little bit trickier. The naive, straight-forward solution is brute force.

If in the previous part we ignored the `x`

s, now they turn to `1`

s.

We start by implementing a predicate such that it will test if all bus ids leave at a given timestamp:

```
-- This is O(n)
busesDepart busIds stamp = go busIds stamp 0 where
go [] _ _ = True
go (x:xs) stamp cnt = 0 == (cnt + stamp) `mod` x && go xs stamp (cnt + 1)
```

Giving it a few tries:

```
Main> busesDepart [17,1,13,19] 3417
True
Main> busesDepart [17,1,13,19] 3418
False
Main> busesDepart [67,7,59,61] 754018
True
```

I had already found 3417 and 754018, but the real problem that we need to solve is finding these numbers, not just checking if they are valid. Bruteforcing:

```
findEarliestTimestamp busIds = go busIds 0 where
go busIds stamp = if busesDepart busIds stamp then stamp else go busIds (stamp + 1)
```

Trying it out on a few examples:

```
Main> findEarliestTimestamp [17,1,13,19] -- takes a few secs
3417
Main> findEarliestTimestamp [67,7,59,61] -- takes a few secs
754018
Main> findEarliestTimestamp [67,1,7,59,61] -- takes a little longer
779210
Main> findEarliestTimestamp [67,7,1,59,61] -- takes a little longer
1261476
Main> findEarliestTimestamp [1789,37,47,1889] -- too long
```

Each processing (`busesDepart`

) takes `O(n)`

and we are trying this out until we find an answer, which, depending on the answer can get quite long. Given that the input is even larger than the last example, we need to think of a different way to attack this.

The bruteforce solution gave me an insight of the problem we are trying to solve, namely, for the list [17,1,13,19] we need to find `cnt`

such that:

```
0 == cnt `mod` 17
0 == cnt + 1 `mod` 1
0 == cnt + 2 `mod` 13
0 == cnt + 3 `mod` 19
<->
cnt = 0 (mod 17)
cnt + 1 = 0 (mod 1)
cnt + 2 = 0 (mod 13)
cnt + 3 = 0 (mod 19)
```

The first thing I immediately noticed is that the bus ids are all prime numbers. If they are all prime numbers, then they are all coprime numbers to each other (not having common divisors with each other). So every number will be coprime with every other number (filtering the 1s out). I searched for some neat properties on the Wikipedia page about Coprime integers, and found out the following property:

```
Given a, b are coprime: Every pair of congruence relations for an unknown integer x, of the form x = k (mod a) and x = m (mod b), has a solution (Chinese Remainder Theorem); in fact the solutions are described by a single congruence relation modulo ab.
```

What do we do from here? We will slightly convert the formulas by using a property from Wikipediaâ€™s page on Modular arithmetic, namely that if a = b (mod n) then a + k = b + k (mod n). We end up with:

```
cnt = 0 (mod 17)
cnt = 1 (mod 1)
cnt = 11 (mod 13)
cnt = 16 (mod 19)
```

Now, itâ€™s obvious how we can apply the Chinese Remainder Theorem. Namely, e.g. for the numbers 17 and 13 from the example, we have that thereâ€™s a `cnt`

such that `cnt = 0 (mod 17)`

and `cnt = 11 (mod 13)`

. How do we find this `cnt`

by computation? We proceed with reading the Computation section on Wikipediaâ€™s page about the theorem.

In other words, we have that the solution belongs to the arithmetic progression a1, a1 + n1, a1 + 2n1, â€¦, that is, 0, 17, 2*17, â€¦, n*17.

Now, in this specific case, the solution is in 0 + k*17, for some k. The first such number is 6*17, because (6*17) `mod`

13 = 11. That is, we found `k = 6`

, i.e. the answer 102. With the previous (brute force) algorithm this would take 102 steps. Note that the theorem has exponential complexity, but it seems that weâ€™re working well enough within its supporting range.

```
Main> crt [(0,17)]
(0,17)
Main> crt [(0,17),(11,13)]
(102,221)
```

Thus, we have solved a system of equations using only two congruences. The idea applies further for multiple equations:

```
Main> crt [(0,17),(1,1),(11,13),(16,19)]
(3417,4199)
```

Now it makes sense how we can use the theorem to solve the problem. We start with the implementation of it, first:

```
-- Copy paste `crt` from https://stackoverflow.com/questions/35529211/chinese-remainder-theorem-haskell
crt :: (Integral a, Foldable t) => t (a, a) -> (a, a)
crt = foldr go (0, 1)
where
go (r1, m1) (r2, m2) = (r `mod` m, m)
where
r = r2 + m2 * (r1 - r2) * (m2 `inv` m1)
m = m2 * m1
-- Modular Inverse
a `inv` m = let (_, i, _) = gcd a m in i `mod` m
-- Extended Euclidean Algorithm
gcd 0 b = (b, 0, 1)
gcd a b = (g, t - (b `div` a) * s, s)
where (g, s, t) = gcd (b `mod` a) a
```

Then, the solution is just to simply use the property that if a = b (mod n) then a + k = b + k (mod n) and convert the list before applying the theorem:

```
findEarliestTimestamp' busIds = fst $ crt zipped where
zipped = map (\(x,y) -> ((x - y) `mod` x, x)) $ zip busIds [0..]
```

Trying it out:

```
Main> findEarliestTimestamp' [17,1,13,19] -- fast
3417
Main> findEarliestTimestamp' [67,7,59,61] -- fast
754018
Main> findEarliestTimestamp' [67,1,7,59,61] -- fast
779210
Main> findEarliestTimestamp' [67,7,1,59,61] -- fast
1261476
Main> findEarliestTimestamp' [1789,37,47,1889] -- fast
1202161486
```

This was interesting to tackle, required some research of mathematical properties but then once we found what we need to use, applying them was easy.

]]>In order to learn about memoization in Haskell, I did a quick Google and it led me the Memoization article on the Haskell Wiki. That article is good, but it only explains the how, not the why. I will cover both how and why in this blog post.

The usual example to start with is the following:

slow_fib::Int->Integer slow_fib 0=0 slow_fib 1=1 slow_fib n=slow_fib (n-2) + slow_fib (n-1)

Why is this a slow implementation? It’s easy to see if you try to calculate `slow_fib 5`

by hand:

slow_fib 5 = slow_fib 3 + slow_fib 4 slow_fib 4 = slow_fib 2 + slow_fib 3 slow_fib 3 = slow_fib 1 + slow_fib 2 slow_fib 2 = slow_fib 0 + slow_fib 1 slow_fib 1 = 1 slow_fib 0 = 0

Note how `slow_fib 5`

calls `slow_fib 3`

and `slow_fib 4`

but both of those call `slow_fib 2`

– so there are some computations that are happening multiple times which slows down the whole process.

When trying to rewrite a recursive function like that to its memoized version in Haskell, the first step is to make the function a bit more general. That is:

slow_fib' :: (Int -> Integer) -> Int -> Integer slow_fib' f 0=0 slow_fib' f 1=1 slow_fib' f n=f (n-2) + f (n-1)

Why is this more general? Because we can pass something else other than `slow_fib'`

as `f`

and it will compute something different. We can consume this function as follows:

```
Main> let f = (\x -> slow_fib' f x) in f 10
55
```

There is a common abstraction for `let f (\x -> slow_fib' f x)`

– a neater way to make the same call is using `fix`

, where `fix f = f (fix f)`

:

```
Main> :t fix
fix :: (a -> a) -> a
Main> let f = fix slow_fib' in f 10
55
```

At this point, we have a more generalized `slow_fib`

but itâ€™s still as slow as the previous implementation – try running both on the input `100`

. This is the part where the magic happens.

Before we start implementing the memoized version of `slow_fib`

, we will spend some time explaining how memoization works in Haskell by inspecting the evaluation model.

Consider the following piece of code:

```
f x + f y + f x
```

In this example, there will be one evaluation for `f x`

, one for `f y`

, and another evaluation for `f x`

. So, `f x`

was evaluated twice. However, thereâ€™s a trick we can use. Consider the next code:

```
let x = map (+1) [0..] in (x !! 0, x !! 0)
```

Executing it means we are mapping the function `(+1)`

on the infinite list, and this happens lazily – it will only get evaluated when we need it. Now, when we actually retrieve the first element `x !! 0`

, it is like computing `0 + 1`

. Note that we are doing that twice in the tuple. However, Haskell will only evaluate `0 + 1`

once, even though it sees â€śtwoâ€ť `0 + 1`

.

The reason for this is that in general, when Haskell sees `let f = ... f ...`

, i.e. `f`

referencing itself in the body, it will **share** the value of `f`

instead of recalculating it. The rationale is: If you name it, you can share it. This allows Haskell to skip the recomputation of values – avoid duplicate computation.

You can test this; If you create a file namedÂ `test.hs`

Â with the following contents, you will be able to see when the evaluation happens:

```
import Debug.Trace
test = let x = trace "forced" (map (+1) [0..]) in (x !! 0, x !! 0)
```

It will produce:

```
Main> test
(forced
1,1)
```

However, if you run this expression directly in the REPL you will get different results:

```
Main> let x = trace "forced" (map (+1) [0..]) in (x !! 0, x !! 0)
(forced
1,forced
1)
```

The reason for that is that GHC optimized the expression by *inlining* it – it replaced `(x !! 0, x !! 0)`

with `("forced" `trace` 1, "forced" `trace` 1)`

. The primary optimization mechanism in GHC is inlining, inlining and inlining.

However, note that this problem occurs just for this specific example, and memoization is not affected by it. The reason for that is GHC will not inline recursive things.

For some reason, GHC thought that it should inline this expression. We can disable that behavior as shown in the following example:

```
Main> :set -XMonomorphismRestriction
Main> let x = trace "forced" (map (+1) [0..]) in (x !! 0, x !! 0)
(forced
1,1)
Main>
```

You might be wondering, why on earth did this happen? We start to dig a little into the internals of Haskell but I will keep it short.

A function with a polymorphic type is `t a`

. A function with a monomorphic type is `[Int]`

(or `List Int`

) – so monomorphic is the opposite of polymorphic, itâ€™s like a particular instance of a polymorphic.

If we consider the expressionÂ `x = 4`

Â with a type ofÂ `Num a => a`

Â then it requires re-computation every time it will be used. The reason for that is Haskell canâ€™t be certain of whatÂ `x`

Â really is, becauseÂ `x :: Int`

Â is different fromÂ `x :: Double`

.

This will not happen with monomorphic types since their values are static and can be cached, so thatâ€™s whyÂ `-XMonomorphismRestriction`

Â fixes the problem. I donâ€™t know about GHC internals much, but maybe it could use a map ofÂ `(Type, Value)`

Â to cache values of polymorphic types? Shrug.

From the Haskell docs, the following `memoize`

function is shown:

```
memoize :: (Int -> a) -> (Int -> a)
memoize f = (map f [0 ..] !!) -- not using eta-reduction may affect performance
```

Note how this function *shar*es values, so it will avoid recomputation. Now, finally, we have:

```
Main> fix (memoize . slow_fib') 10
55
Main> fix (memoize . slow_fib') 100
573147844013817084101
```

Works pretty fast on the two example inputs.

We learned a lot about the Haskell evaluation model and how it allows us to cache/memoize computation. We also learned how complex the compiler is and how some of the assumptions it makes defeats our intentions (e.g. inlining is intended for optimization but it produced wrong results w.r.t. our expectations).

I would like to thank dminuoso and monochrom from #haskell@freenode for explaining the evaluation model to me. Thanks to u/rifasaurous for pointing at a typo and for hinting how complex the Haskell compiler is.

]]>In this post weâ€™ll tackle the 8th problem of AoC2020, Handheld Halting.

As usual, we start with the dependencies.

```
import System.IO
import Control.Monad
import qualified Data.Map as Map
import Data.List.Utils
```

Now, we need to implement a simple evaluator that accepts three commands: `acc`

, `jmp`

, and `not`

. Here are the data types for that:

```
data Instruction = Nop | Acc | Jmp deriving (Show)
data Command = I Instruction Int deriving (Show)
type Program = [Command]
```

Additionally, the program has state – the accumulator.

```
type Context = Map.Map String Int
```

In addition to the accumulator weâ€™ll keep the instruction pointer. Hereâ€™s a function to get the initial state:

```
getEmptyCtx :: Context
getEmptyCtx = Map.fromList [ ("acc", 0), ("IP", 0) ]
```

We can now proceed to the evaluation, handling every case from the `Instruction`

data type:

```
eval :: Context -> Command -> Context
eval ctx (I Nop n) = incIP 1 ctx
eval ctx (I Acc n) = let acc = ctx Map.! "acc"
in Map.insert "acc" (acc + n) $ incIP 1 ctx
eval ctx (I Jmp n) = incIP n ctx
```

We need to keep increasing the instruction pointer with each evaluation, so the helper `incIP`

is defined as following:

```
incIP :: Int -> Context -> Context
incIP n ctx = let ip = ctx Map.! "IP" in Map.insert "IP" (ip + n) ctx
```

Here are a few examples of evaluation:

```
Main> eval getEmptyCtx $ I Acc 1
fromList [("IP",1),("acc",1)]
Main> eval getEmptyCtx $ I Acc 10
fromList [("IP",1),("acc",10)]
Main> eval getEmptyCtx $ I Nop 10
fromList [("IP",1),("acc",0)]
```

Now, `eval`

just executes a single command, so we need a function to run a program (execute a list of commands). Hereâ€™s the function type:

```
run :: Program -> Either (Context, [Int]) (Context, [Int])
```

This function will return a `Left`

when it does not terminate, and `Right`

otherwise. Additionally, it will contain a list of the previously executed instruction pointers – this will be used for part two because it will show the last line before the infinite loop happened so we know where it happens.

The task defined terminating programs in such a way (command being executed more than once) that this solution is applicable. In general, itâ€™s not a good definition for what a terminating program is.

```
run cmds = go cmds getEmptyCtx [] where
go cs ctx prevIPs = let ip = ctx Map.! "IP" in go' ip where
go' ip
| ip >= length cs = Right (ctx, prevIPs) -- if the instruction pointer out of bounds, the program terminated
| ip `elem` prevIPs = Left (ctx, prevIPs) -- if the instruction pointer was already executed, conclude infinite loop
| otherwise = let newctx = eval ctx (cs !! ip) in
go cs newctx (ip:prevIPs)
```

Hereâ€™s an example:

```
Main> run [I Acc 10]
Right (fromList [("IP",1),("acc",10)],[0])
Main> run [I Acc 10, I Acc 5]
Right (fromList [("IP",2),("acc",15)],[1,0])
Main> run [I Acc 10, I Acc 5, I Jmp (-1)]
Left (fromList [("IP",1),("acc",15)],[2,1,0])
```

In the first and the second case, it returned `Right`

because the program terminated. Also note how the state changed (`acc`

is 10 and 15 respectively). However, in the third case, we get a `Left`

because an infinite loop happened. The last executed instruction pointers were `[2,1,0]`

so IP 2 was executed twice.

We proceed with writing the parsing function:

```
parseLine :: String -> Command
parseLine s = let [cmd, number] = split " " s in go cmd number where
go "jmp" number = I Jmp $ readNumber number
go "acc" number = I Acc $ readNumber number
go "nop" _ = I Nop 0
readNumber ('+':n) = read n
readNumber number = read number
```

Together with usual `main`

to read from file, parse it and execute it:

```
main = do
handle <- openFile "input.txt" ReadMode
contents <- hGetContents handle
let program = map parseLine $ lines contents
print $ run program
hClose handle
```

An example `input.txt`

file:

```
acc 10
nop 123
jmp -1
```

Running `main`

on that example file returns `Left (fromList [("IP",1),("acc",10)],[2,1,0])`

.

The course starts with a few definitions, the main ones being:

- Stereotypes – beliefs we have of specific groups
- Prejudice – negative feelings we have towards specific groups
- Discrimination – we treat specific groups differently

Other important concepts were In-groups and Out-groups – the former being a group an individual belongs to, and the latter being a group that an individual doesn’t belong to. The discussion then led to the Minimal group paradigm, in which psychologists found the minimal settings of a group such that members belonging to it are biased.

Interestingly, for the minimal group paradigm, the minimum criteria are trivial. For example, people may be biased just by their color preference, e.g. blue or red color. This method made me realize the connection with Closures in mathematics. In general, it seems interesting how we can map most of the ideas discussed in the course to the language of mathematics. I’d assume that Mathematical psychology is on its rise as a field? The reason for that is I guess we have more tools now, than we ever had, with social media platforms and all the data we have online which allow us to do further researches in social psychology, but I digress.

Here are some cool strategies for resolving unconscious bias:

- Contact theory – Make contact
- Common ingroup – Find a common ingroup (e.g. we’re both humans, etc.)
- Stereotype replacement
- Be aware when you make a stereotypical judgement
- Think why it happened
- Replace

- Perspective taking – empathy
- Remind yourself of superheroes -> bias useless (e.g. Neil deGrasse Tyson)

In any case, I really enjoyed the course and highly suggest for anyone working in a multicultural environment to give it a try.

]]>What can we do with the previous statement, other than generalize it and try to prove a mathematical fact about it?

The fact that we will prove is that if a month has days, then there is one Sunday in the range . So for example October has 31 days, but we can be sure that there will be one Sunday in . So **some date from 25th through 31st of October will contain a Sunday**, and this is true for every year.

First, we will prove that there is one Sunday in the range . For this, we can use proof by cases where each case will be a day of the week. Thus, the day is one of:

- Sunday: Thus, is Sunday.
- Saturday: Thus, is Sunday.
- Friday: Thus, is Sunday.
- Thursday: Thus, is Sunday.
- Wednesday: Thus, is Sunday.
- Tuesday: Thus, is Sunday.
- Monday: Thus, is Sunday.

In any case, for any , there is one Sunday in the range . Now, if we replace with , we get that if a month has days, then we can be sure that there is one Sunday in . The proof can be generalized for any day, not just Sunday.

Let’s prove the same in Dafny now.

We start by providing the datatypes for days and naturals (we need to map days to numbers):

datatype Day = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday datatype Nat = S (Nat) | Z

Now we will provide a neat method that converts a natural number to a day:

function method nat_to_day (n: Nat) : Day decreases n { match n { case Z => Monday case S(Z) => Tuesday case S(S(Z)) => Wednesday case S(S(S(Z))) => Thursday case S(S(S(S(Z)))) => Friday case S(S(S(S(S(Z))))) => Saturday case S(S(S(S(S(S(Z)))))) => Sunday case S(S(S(S(S(S(S(k))))))) => nat_to_day(k) } }

Finally, the proof just uses similar technique to the case analysis we did earlier:

lemma {:induction n} proof (n : Nat) ensures nat_to_day(n) == Sunday ==> nat_to_day(n) == Sunday ensures nat_to_day(n) == Saturday ==> nat_to_day(S(n)) == Sunday ensures nat_to_day(n) == Friday ==> nat_to_day(S(S(n))) == Sunday ensures nat_to_day(n) == Thursday ==> nat_to_day(S(S(S(n)))) == Sunday ensures nat_to_day(n) == Wednesday ==> nat_to_day(S(S(S(S(n))))) == Sunday ensures nat_to_day(n) == Tuesday ==> nat_to_day(S(S(S(S(S(n)))))) == Sunday ensures nat_to_day(n) == Monday ==> nat_to_day(S(S(S(S(S(S(n))))))) == Sunday {}

So we proved that for every natural number , one of will be a Sunday.

Disregarding the usefulness (uselessness) of this proof, the post demonstrates a few things:

- We modeled a simple real-world fact into the world of mathematics, and we proved some stuff about that fact
- We translated the problem from the language of mathematics to the programming language Dafny, and we proved some stuff about it