## Thursday, April 21, 2016

### Oh! Pascal!

I can't help but want to share my joy at coming across this pearl of a program from the "Pascal User Manual and Report" - Jensen and Wirth (circa 1974). In my edition, it's program 4.7 (graph1.pas).

This is it, rephrased in OCaml.

(* Graph of f x = exp (-x) * sin (2 * pi * x)

Program 4.7, Pascal User Manual and Report, Jensen & Wirth
*)

let round (x : float) : int =
let f, i =
let t = modf x in
(fst t, int_of_float@@ snd t) in
if f = 0.0 then i
else if i >= 0 then
if f >= 0.5 then i + 1 else i
else if -.f >= 0.5 then i - 1 else i

let graph (oc : out_channel) : unit =
(*The x-axis runs vertically...*)
let s = 32. in (*32 char widths for [y, y + 1]*)
let h = 34 in (*char position of x-axis*)
let d = 0.0625 in (*1/16, 16 lines for [x, x + 1]*)
let c = 6.28318 in (* 2pi *)
let lim = 32 in
for i = 0 to lim do
let x = d *. (float_of_int i) in
let y = exp (-.x) *. sin (c *. x) in
let n = round (s *. y) + h in
for _ = n downto 0 do output_char oc ' '; done;
output_string oc "*\n"
done

let () = print_newline (); graph stdout; print_newline ()


The output from the above is wonderful :)

                                   *
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*


## Wednesday, April 13, 2016

### Dictionaries as functions

This is an "oldie but a goodie". It's super easy.

A dictionary is a data structure that represents a map from keys to values. The question is, can this data structure and its characteristic operations be encoded using only functions?

The answer of course is yes and indeed, here's one such an encoding in OCaml.

(*The type of a dictionary with keys of type [α] and values of type
[β]*)
type (α, β) dict = α -> β option

(*The empty dictionary maps every key to [None]*)
let empty (k : α) : β option = None

(*[add d k v] is the dictionary [d] together with a binding of [k] to
[v]*)
let add (d : (α, β) dict) (k : α) (v : β) : (α, β) dict =
fun l ->
if l = k then Some v else d l

(*[find d k] retrieves the value bound to [k]*)
let find (d : (α, β) dict) (k : α) : β option = d k

Test it like this.
(*e.g.

Name                            | Age
================================+====
"Felonius Gru"                  |  53
"Dave the Minion"               | 4.54e9
"Dr. Joseph Albert Nefario"     |  80

*)
let despicable =
empty "Felonius Gru" 53
)
"Dave the Minion" (int_of_float 4.54e9)
)
"Dr. Nefario" 80

let _ =
find despicable "Dave the Minion" |>
function | Some x -> x | _ -> failwith "Not found"


Moving on, can we implement this in C++? Sure. Here's one way.

#include <pgs/pgs.hpp>

#include <functional>
#include <iostream>
#include <cstdint>

using namespace pgs;

// -- A rough and ready 'a option (given the absence of
// std::experimental::optional

struct None {};

template <class A>
struct Some {
A val;
template <class Arg>
explicit Some (Arg&& s) : val { std::forward<Arg> (s) }
{}
};

template <class B>
using option = sum_type<None, Some<B>>;

template <class B>
std::ostream& operator << (std::ostream& os, option<B> const& o) {
return o.match<std::ostream&>(
[&](Some<B> const& a) -> std::ostream& { return os << a.val; },
[&](None) -> std::ostream& { return os << "<empty>"; }
);
}

//-- Encoding of dictionaries as functions

template <class K, class V>
using dict_type = std::function<option<V>(K)>;

//empty is a dictionary constant (a function that maps any key to
//None)
template <class A, class B>
dict_type<A, B> empty =
[](A const&) {
return option<B>{ constructor<None>{} };
};

//add (d, k, v) extends d with a binding of k to v
template <class A, class B>
dict_type<A, B> add (dict_type<A, B> const& d, A const& k, B const& v) {
return [=](A const& l) {
return (k == l) ? option<B>{ constructor<Some<B>>{}, v} : d (l);
};
}

//find (d, k) searches for a binding in d for k
template <class A, class B>
option<B> find (dict_type<A, B> const& d, A const& k) {
return d (k);
}

//-- Test driver

int main () {

using dict_t = dict_type<std::string, std::int64_t>;

auto nil = empty<std::string, std::int64_t>;
dict_t(*insert)(dict_t const&, std::string const&, std::int64_t const&) = &add;

dict_t despicable =
insert (
insert (
insert (nil
, std::string {"Felonius Gru"}, std::int64_t{53})
, std::string {"Dave the Minion"}, std::int64_t{4530000000})
, std::string {"Dr. Joseph Albert Nefario"}, std::int64_t{80})
;

std::cout <<
find (despicable, std::string {"Dave the Minion"}) << std::endl;

return 0;
}


## Sunday, April 3, 2016

### C++ : Streams

In this blog post, types and functions were presented in OCaml for modeling streams. This post takes the action to C++.

First, the type definition for a stream.

struct Nil {};
template <class T> class Cons;

template <class T>
using stream = sum_type <
Nil
, recursive_wrapper<Cons<T>>
>;

The definition is in terms of the sum_type<> type from the "pretty good sum" library talked about here.

The definition of Cons<>, will be in terms of "thunks" (suspensions). They're modeled as procedures that when evaluated, compute streams.

template <class T>
using stream_thunk = std::function<stream<T>()>;

To complete the abstraction, a function that given a suspension, "thaws" it.
template <class T> inline
stream<T> force (stream_thunk<T> const& s) {
return s ();
}


The above choices made, here is the definition for Cons<>.

template <class T>
class Cons {
public:
using value_type = T;
using reference = value_type&;
using const_reference = value_type const&;
using stream_type = stream<value_type>;

private:
using stream_thunk_type = stream_thunk<value_type>;

public:
template <class U, class V>
Cons (U&& h, V&& t) :
h {std::forward<U> (h)}, t {std::forward<V> (t)}
{}

const_reference hd () const { return h; }
stream_type tl () const { return force (t); }

private:
value_type h;
stream_thunk_type t;
};


Next, utility functions for working with streams.

The function hd () gets the head of a stream and tl () gets the stream that remains when the head is stripped off.

template <class T>
T const hd (stream<T> const& s) {
return s.template match<T const&> (
[](Cons<T> const& l) -> T const& { return l.hd (); }
, [](otherwise) -> T const & { throw std::runtime_error { "hd" }; }
);
}

template <class T>
stream<T> tl (stream<T> const& l) {
return l.template match <stream<T>> (
[] (Cons<T> const& s) -> stream <T> { return s.tl (); }
, [] (otherwise) -> stream<T> { throw std::runtime_error{"tl"}; }
);
}


The function take () returns the the first $n$ values of a stream.

template <class T, class D>
D take (unsigned int n, stream <T> const& s, D dst) {
return (n == 0) ? dst :
s.template match<D>(
[&](Nil const& _) -> D { return  dst; },
[&](Cons<T> const& l) -> D {
return take (n - 1, l.tl (), *dst++ = l.hd ()); }
);
}


It's time to share a little "hack" I picked up for writing infinite lists.

• To start, forget about streams;
• Write your list using regular lists;
• Ignore the fact that it won't terminate;
• Rewrite in terms of Cons and convert the tail to a thunk.

For example, in OCaml the (non-terminating!) code

  let naturals =
let rec loop x = x :: loop (x + 1) in
next 0

leads to this definition of the stream of natural numbers.
let naturals =
let rec loop x = Cons (x, lazy (loop (x + 1))) in
loop 0


Putting the above to work, a generator for the stream of natural numbers can be written like this.

class natural_numbers_gen {
private:
using int_stream = stream<int>;

private:
int start;

private:
int_stream from (int x) const {
return int_stream{
constructor<Cons<int>>{}, x, [=]() { return this->from (x + 1); }
};
}

public:
explicit natural_numbers_gen (int start) : start (start)
{}

explicit operator int_stream() const { return from (start); }
};

The first $10$ (say) natural numbers can then be harvested like this.
std::vector<int> s;
take (10, stream<int> (natural_numbers_gen{0}), std::back_inserter (s));


The last example, a generator of the Fibonacci sequence. Applying the hack, start with the following OCaml code.

  let fibonacci_numbers =
let rec fib a b = a :: fib b (a + b) in
fib 0 1

The rewrite of this code into streams then leads to this definition.
let fibonnaci_sequence =
let rec fib a b = Cons (a, lazy (fib b (a + b))) in
fib 0 1

Finally, casting the above function into C++ yields the following.
class fibonacci_numbers_gen {
private:
using int_stream = stream<int>;

private:
int start;

private:
int_stream loop (int a, int b) const {
return int_stream{
constructor<Cons<int>>{}, a, [=]() {return this->loop (b, a + b); }
};
}

public:
explicit fibonacci_numbers_gen ()
{}

explicit operator int_stream() const { return loop (0, 1); }
};


## Rotate

This post is inspired by one of those classic "99 problems in Prolog".What we are looking for here are two functions that satisfy these signatures.

val rotate_left : int -> α list -> α list
val rotate_right : int -> α list -> α list

rotate_left n rotates a list $n$ places to the left, rotate_right n rotates a list $n$ places to the right. Examples:
# rotate_left 3 ['a';'b';'c';'d';'e';'f';'g';'h'] ;;
- : char list = ['d'; 'e'; 'f'; 'g'; 'h'; 'a'; 'b'; 'c']

# rotate_left (-2) ['a';'b';'c';'d';'e';'f';'g';'h'] ;;
- : char list = ['g'; 'h'; 'a'; 'b'; 'c'; 'd'; 'e'; 'f']

Of course, rotate_left and rotate_right are inverse functions of each other so we expect, for any int $x$ and list $l$, rotate_right x @@ rotate_left x l $=$ rotate_left x @@ rotate_right x l $=$ l.

Well, there are a variety of solutions to this problem with differing degrees of verbosity, complexity and efficiency. My own attempt at a solution resulted in this.

let rec drop (k : int) (l : α list) : α list =
match k, l with
| i, _ when i <= 0 -> l
| _, [] -> []
| _, (_ :: xs) -> drop (k - 1) xs

let rec take (k : int) (l : α list) : α list =
match k, l with
| i, _ when i <= 0 -> []
| _, [] -> []
| _, (x :: xs)  -> x :: take (k - 1) xs

let split_at (n : int) (l : α list) : α list * α list =
(take n l), (drop n l)

let rec rotate_left (n : int) (l : α list) : α list =
match n with
| _ when n = 0 -> l
| _ when n < 0 ->  rotate_right (-n) l
| _ ->
let m : int = List.length l in
let k : int = n mod m in
let (l : α list), (r : α list) = split_at k l in
r @ l

and rotate_right (n : int) (l : α list) : α list =
match n with
| _ when n = 0 -> l
| _ when n < 0 ->  rotate_left (-n) l
| _ ->
let m : int = List.length l in
let k : int = m - n mod m in
let (l : α list), (r : α list) = split_at k l in
r @ l


So far so good, but then I was shown the following solution in Haskell.

rotateLeft n xs
| n >= 0     = take (length xs) $drop n$ concat $repeat xs | otherwise = rotateLeft (length xs + n) xs rotateRight n = rotateLeft (-n)  I found that pretty nifty! See, in the function rotateLeft, repeat xs creates an infinite list of lists, (each a copy of xs), "joins" that infinite list of lists into one infinite list, then the first$n$elements are dropped from that the list and we take the next length xs which gets us the original list rotated left$n$places. I felt compelled to attempt to emulate the program above in OCaml. The phrasing "works" in Haskell due to the feature of lazy evaluation. OCaml on the other hand is eagerly evaluated. Lazy evaluation is possible in OCaml however, you just need to be explicit about it. Here's a type for "lazy lists" aka "streams". type α stream = Nil | Cons of α * α stream Lazy.t  A value of type α Lazy.t is a deferred computation, called a suspension that has the result type α. The syntax lazy$(expr)$makes a suspension of$expr$, without yet evaluating$expr$. "Forcing" the suspension (using Lazy.force) evaluates$expr$and returns its result. Next up, functions to get the head and tail of a stream. let hd = function | Nil -> failwith "hd" | Cons (h, _) -> h let tl = function | Nil -> failwith "tl" | Cons (_, t) -> Lazy.force t  Also useful, a function to lift an α list to an α stream. let from_list (l : α list) : α stream = List.fold_right (fun x s -> Cons (x, lazy s)) l Nil  Those are the basic building blocks. Now we turn attention to implementing repeat x to create infinite lists of the repeated value$x\$.

let rec repeat (x : α) : α stream = Cons (x, lazy (repeat x))


Now to implement concat (I prefer to call this function by its alternative name flatten).

The characteristic operation of flatten is the joining together of two lists. For eager lists, we can write a function join that appends two lists like this.

let rec join l m =
match l with
| [] -> m
| h :: t -> h :: (join t m)

This generalizes naturally to streams.
let rec join (l : α stream) (m : α stream) =
match l with
| Nil -> m
| Cons (h, t) -> Cons (h, lazy (join (Lazy.force t) m))

For eager lists, we can write flatten in terms of join.
let rec flatten : α list list -> α list = function
| [] -> []
| (h :: tl) -> join h (flatten tl)

Emboldened by our earlier success we might try to generalize it to streams like this.
let rec flatten (l : α stream stream) : α stream =
match l with
| Nil -> lazy Nil
| Cons (l, r) ->  join l (flatten (Lazy.force r))

Sadly, no. This definition is going to result in stack overflow. There is an alternative phrasing of flatten we might try.
let rec flatten = function
| [] -> []
| [] :: t -> flatten t
| (x :: xs) :: t -> x :: (flatten (xs :: t))

Happy to say, this one generalizes and gets around the eager evaluation problem that causes the unbounded recursion.
let rec flatten : α stream stream -> α stream = function
| Nil -> Nil
| Cons (Nil, t) -> flatten (Lazy.force t)
| Cons (Cons (x, xs), t) ->
Cons (x, lazy (flatten (Cons (Lazy.force xs, t))))


take and drop are straight forward generalizations of their eager counterparts.

let rec drop (n : int) (lst : α stream ) : α stream =
match (n, lst) with
| (n, _) when n < 0 -> invalid_arg "negative index in drop"
| (n, xs) when n = 0 -> xs
| (_, Nil) -> Nil
| (n, Cons (_, t)) -> drop (n - 1) (Lazy.force t)

let rec take (n : int) (lst : α stream) : α list =
match (n, lst) with
| (n, _) when n < 0 -> invalid_arg "negative index in take"
| (n, _) when n = 0 -> []
| (_, Nil) -> []
| (n, Cons (h, t)) -> h :: (take (n - 1) (Lazy.force t))


Which brings us to the lazy version of rotate expressed in about the same number of lines of code!

let rec rotate_left (k : int) (l : α list) : α list =
let n = List.length l in
if k >= 0 then
l |> from_list |> repeat |> flatten |> drop k |> take n
else rotate_left (n + k) l

let rotate_right (n : int) : α list -> α list = rotate_left (-n)