λ Tony’s blog λ

sealed trait List[+A] {
  override def toString = {
    def toScalaList(t: List[A]): scala.List[A] = t match {
      case Empty => Nil
      case Cons(h, t) => h :: toScalaList(t)
    }
    toScalaList(this).toString
  }
}
final case object Empty extends List[Nothing]
final case class Cons[A](h: A, t: List[A]) extends List[A]
 
object List {
  def foldRight[A, B](as: List[A], b: B, f: (A, B) => B): B = as match {
    case Empty => b
    case Cons(h, t) => f(h, foldRight(t, b, f))
  }
 
  def foldLeft[A, B](as: List[A], b: B, f: (B, A) => B): B = as match {
    case Empty => b
    case Cons(h, t) => foldLeft(t, f(b, h), f)
  }
 
  def reduceRight[A](as: List[A], f: (A, A) => A): A = as match {
    case Empty => error("bzzt. reduceRight on empty list")
    case Cons(h, t) => foldRight(t, h, f)
  }
 
  def reduceLeft[A](as: List[A], f: (A, A) => A): A = as match {
    case Empty => error("bzzt. reduceLeft on empty list")
    case Cons(h, t) => foldLeft(t, h, f)
  }
 
  def unfold[A, B](b: B, f: B => Option[(A, B)]): List[A] = f(b) match {
    case Some((a, b)) => Cons(a, unfold(b, f))
    case scala.None => Empty
  }
}
 
sealed trait Natural {
  override def toString = {
    def toInt(n: Natural): Int = n match {
      case Zero => 0
      case Succ(x) => 1 + toInt(x)
    }
    toInt(this).toString
  }
}
final case object Zero extends Natural
final case class Succ(c: Natural) extends Natural
 
object Exercises {
 
// Exercise 1
// Relative Difficulty: 1
// Correctness: 2.0 marks
// Performance: 0.5 mark
// Elegance: 0.5 marks
// Total: 3
def add(x: Natural, y: Natural): Natural = error("todo")
 
// Exercise 2
// Relative Difficulty: 2
// Correctness: 2.5 marks
// Performance: 1 mark
// Elegance: 0.5 marks
// Total: 4
def sum(is: List[Int]): Int = error("todo")
 
// Exercise 3
// Relative Difficulty: 2
// Correctness: 2.5 marks
// Performance: 1 mark
// Elegance: 0.5 marks
// Total: 4
def length[A](as: List[A]): Int = error("todo")
 
// Exercise 4
// Relative Difficulty: 5
// Correctness: 4.5 marks
// Performance: 1.0 mark
// Elegance: 1.5 marks
// Total: 7
def map[A, B](as: List[A], f: A => B): List[B] = error("todo")
 
// Exercise 5
// Relative Difficulty: 5
// Correctness: 4.5 marks
// Performance: 1.5 marks
// Elegance: 1 mark
// Total: 7
def filter[A](as: List[A], f: A => Boolean): List[A] = error("todo")
 
// Exercise 6
// Relative Difficulty: 5
// Correctness: 4.5 marks
// Performance: 1.5 marks
// Elegance: 1 mark
// Total: 7
def append[A](x: List[A], y: List[A]): List[A] = error("todo")
 
// Exercise 7
// Relative Difficulty: 5
// Correctness: 4.5 marks
// Performance: 1.5 marks
// Elegance: 1 mark
// Total: 7
def flatten[A](as: List[List[A]]): List[A] = error("todo")
 
// Exercise 8
// Relative Difficulty: 7
// Correctness: 5.0 marks
// Performance: 1.5 marks
// Elegance: 1.5 mark
// Total: 8
def flatMap[A, B](as: List[A], f: A => List[B]): List[B] = error("todo")
 
// Exercise 9
// Relative Difficulty: 8
// Correctness: 3.5 marks
// Performance: 3.0 marks
// Elegance: 2.5 marks
// Total: 9
def maximum(is: List[Int]): Int = error("todo")
 
// Exercise 10
// Relative Difficulty: 10
// Correctness: 5.0 marks
// Performance: 2.5 marks
// Elegance: 2.5 marks
// Total: 10
def reverse[A](as: List[A]): List[A] = error("todo")
}

/**
 * Parallel Fibonacci numbers.
 * Based on a Haskell example by Don Stewart.
 * Author: Runar
 */
public class Fibs {
 
  private static final int CUTOFF = 35;
 
  public static void main(final String[] args) throws Exception {
    if (args.length < 1)
      throw error("This program takes an argument: number_of_threads");
 
    final int threads = Integer.parseInt(args[0]);
    final ExecutorService pool = Executors.newFixedThreadPool(threads);
    final Strategy<Unit> su = Strategy.executorStrategy(pool);
    final Strategy<Promise<Integer>> spi = Strategy.executorStrategy(pool);
 
    final Actor<List<Integer>> out = actor(su, { List<Integer> fs => {
      int i = 0;
      for (List<Integer> ns = fs; ns.isNotEmpty(); ns = ns.tail()) {
        System.out.println(MessageFormat.format("n={0}=>{1}", i, ns.head()));
        i++;
      }
      pool.shutdown();
    }});
 
    System.out.println("Calculating Fibonacci sequence in parallel...");
 
    final F<Integer, Promise<Integer>> fib = { Integer n => (n < CUTOFF) ?
        promise(su, P.p(serialFib(n))) :
        fib.f(n - 1).bind(join(su, P1.curry(fib).f(n - 2)), { int a => { int b => a + b }} ) };
 
    join(su, fmap(Promise.<Integer>sequence(su)).f(spi.parMap(fib).f(range(0, 46)))).to(out);
  }
 
  public static int serialFib(final int n) {
    if (n < 2)
      return n;
    else return serialFib(n - 1) + serialFib(n - 2);
  }
}

-- + Complete the 10 exercises below by filling out the function bodies.
--   The code currently compiles, but none of the tests pass (the test function).
--   Replace the function bodies (error "todo") with an appropriate solution.
-- + These exercises may be done in any order, however:
--   Exercises are generally increasing in difficulty, though some people may find later exercise easier.
--   The tests are written to execute in the order 1 to 10, so you need to have Exercise n passing before Exercise (n+1) passes.
-- + Note the existence of the library function max :: Int -> Int -> Int which will help you with Exercise 9.
-- + Bonus for using the provided functions or for using one exercise solution to help solve another.
-- + Approach with your best available intuition; just dive in and do what you can!
 
-- TOTAL marks:    /66
 
module L02.List where
 
import Prelude hiding (sum, length, map, filter, maximum, reverse)
 
-- BEGIN Helper functions and data types
 
-- The custom list type
data List t = Nil | t :| List t deriving Eq
 
-- Right-associative
infixr 5 :|
 
instance (Show t) => Show (List t) where
  show = show . foldRight (:) []
 
-- functions over List that you may consider using
foldRight :: (a -> b -> b) -> b -> List a -> b
foldRight _ b Nil      = b
foldRight f b (h :| t) = f h (foldRight f b t)
 
foldLeft :: (b -> a -> b) -> b -> List a -> b
foldLeft _ b Nil      = b
foldLeft f b (h :| t) = let b' = f b h in b' `seq` foldLeft f b' t
 
reduceRight :: (a -> a -> a) -> List a -> a
reduceRight _ Nil      = error "bzzt. reduceRight on empty list"
reduceRight f (h :| t) = foldRight f h t
 
reduceLeft :: (a -> a -> a) -> List a -> a
reduceLeft _ Nil      = error "bzzt. reduceLeft on empty list"
reduceLeft f (h :| t) = foldLeft f h t
 
-- END Helper functions and data types
 
-- BEGIN Exercises
 
-- Exercise 1
-- Relative Difficulty: 1
-- Correctness: 2.0 marks
-- Performance: 0.5 mark
-- Elegance: 0.5 marks
-- Total: 3
headOr :: List a -> a -> a
headOr = error "todo"
 
-- Exercise 2
-- Relative Difficulty: 2
-- Correctness:   2.5 marks
-- Performance: 1 mark
-- Elegance: 0.5 marks
-- Total: 4
sum :: List Int -> Int
sum = error "todo"
 
-- Exercise 3
-- Relative Difficulty: 2
-- Correctness: 2.5 marks
-- Performance: 1 mark
-- Elegance: 0.5 marks
-- Total: 4
length :: List a -> Int
length = error "todo"
 
-- Exercise 4
-- Relative Difficulty: 5
-- Correctness: 4.5 marks
-- Performance: 1.0 mark
-- Elegance: 1.5 marks
-- Total: 7
map :: (a -> b) -> List a -> List b
map = error "todo"
 
-- Exercise 5
-- Relative Difficulty: 5
-- Correctness: 4.5 marks
-- Performance: 1.5 marks
-- Elegance: 1 mark
-- Total: 7
filter :: (a -> Bool) -> List a -> List a
filter = error "todo"
 
-- Exercise 6
-- Relative Difficulty: 5
-- Correctness: 4.5 marks
-- Performance: 1.5 marks
-- Elegance: 1 mark
-- Total: 7
append :: List a -> List a -> List a
append = error "todo"
 
-- Exercise 7
-- Relative Difficulty: 5
-- Correctness: 4.5 marks
-- Performance: 1.5 marks
-- Elegance: 1 mark
-- Total: 7
flatten :: List (List a) -> List a
flatten = error "todo"
 
-- Exercise 8
-- Relative Difficulty: 7
-- Correctness: 5.0 marks
-- Performance: 1.5 marks
-- Elegance: 1.5 mark
-- Total: 8
flatMap :: (a -> List b) -> List a -> List b
flatMap = error "todo"
 
-- Exercise 9
-- Relative Difficulty: 8
-- Correctness: 3.5 marks
-- Performance: 3.0 marks
-- Elegance: 2.5 marks
-- Total: 9
maximum :: List Int -> Int
maximum = error "todo"
 
-- Exercise 10
-- Relative Difficulty: 10
-- Correctness: 5.0 marks
-- Performance: 2.5 marks
-- Elegance: 2.5 marks
-- Total: 10
reverse :: List a -> List a
reverse = error "todo"
 
-- END Exercises
 
-- BEGIN Tests for Exercises
 
test :: IO ()
test =
  let showNil = show (Nil :: List Int)
      results =
        [
        -- headOr
        ("headOr",
         show (headOr (1 :| 2 :| 3 :| Nil) 7)
       , show 1),
 
        ("headOr",
         show (headOr Nil 8)
       , show 8),
 
        -- sum
        ("sum",
         show (sum (1 :| 2 :| 3 :| Nil))
       , show 6),
 
        ("sum",
         show (sum Nil)
       , show 0),
 
        -- length
        ("length",
         show (length ('a' :| 'b' :| 'c' :| Nil))
       , show 3),
 
        ("length",
         show (length Nil)
       , show 0),
 
        -- map
        ("map",
         show (map (+1) (1 :| 2 :| 3 :| Nil))
       , show (2 :| 3 :| 4 :| Nil)),
 
        ("map",
         show (map (+1) Nil)
       , showNil),
 
        -- filter
        ("filter",
         show (filter even (1 :| 2 :| 3 :| Nil))
       , show (2 :| Nil)),
 
        ("filter",
         show (filter even Nil)
       , showNil),
 
        -- append
        ("append",
         show (append (1 :| 2 :| 3 :| Nil) (4 :| Nil))
       , show (1 :| 2 :| 3 :| 4 :| Nil)),
 
        ("append",
         show (append (1 :| 2 :| 3 :| Nil) Nil)
       , show (1 :| 2 :| 3 :| Nil)),
 
        -- flatten
        ("flatten",
         show (flatten ((1 :| 2 :| Nil) :| ((3 :| 4 :| Nil) :| Nil)))
       , show (1 :| 2 :| 3 :| 4 :| Nil)),
 
        -- flatMap
        ("flatMap",
         show (flatMap (\n -> (n+1) :| (n+2) :| Nil) (1 :| 2 :| 3 :| Nil))
       , show (2 :| 3 :| 3 :| 4 :| 4 :| 5 :| Nil)),
 
        -- maximum
        ("maximum",
         show (maximum (3 :| 1 :| 2 :| Nil))
       , show 3),
 
        -- reverse
        ("reverse",
         show (reverse (1 :| 2 :| 3 :| Nil))
       , show (3 :| 2 :| 1 :| Nil))
        ]
      check (n, a, b) = do print ("=== " ++ n ++ " ===")
                           print (if a == b then "PASS" else "FAIL Expected: " ++ b ++ " Actual: " ++ a)
 
  in mapM_ check results
 
-- END Tests for Exercises
 
-- Utility
 
all ::
  (a -> Bool)
  -> List a
  -> Bool
all p =
  foldRight (&&) True . map p
 
isEmpty ::
  List a
  -> Bool
isEmpty Nil    = True
isEmpty (_:|_) = False
 
contains ::
  Eq a =>
  List a
  -> a
  -> Bool
contains Nil    _ = False
contains (h:|t) e = h == e || contains t e

// You are not permitted to use these List methods:
// * length
// * map
// * filter
// * ::: (and variations such as ++)
// * flatten
// * flatMap
// * reverse (and variations i.e. reverseMap, reverse_:::)
// This also means you are not permitted to use for-comprehensions on Lists.
// You are permitted to use the functions you write yourself. For example, Exercise 2 may use Exercise 1 or Exercise 3.
// Using permitted existing methods where appropriate will attract marks for elegance.
 
// TOTAL marks:    /66
 
object Exercises {
  def succ(n: Int) = n + 1
  def pred(n: Int) = n - 1
 
  // Exercise 1
  // Relative Difficulty: 1
  // Correctness: 2.0 marks
  // Performance: 0.5 mark
  // Elegance: 0.5 marks
  // Total: 3
  def add(x: Int, y: Int): Int = error("todo: Assume x and y are 0 or positive. Do not use + or - on Int. Only permitted to use succ/pred (above).")
 
  // Exercise 2
  // Relative Difficulty: 2
  // Correctness: 2.5 marks
  // Performance: 1 mark
  // Elegance: 0.5 marks
  // Total: 4
  def sum(x: List[Int]): Int = error("todo")
 
  // Exercise 3
  // Relative Difficulty: 2
  // Correctness: 2.5 marks
  // Performance: 1 mark
  // Elegance: 0.5 marks
  // Total: 4
  def length[A](x: List[A]): Int = error("todo")
 
  // Exercise 4
  // Relative Difficulty: 5
  // Correctness: 4.5 marks
  // Performance: 1.0 mark
  // Elegance: 1.5 marks
  // Total: 7
  def map[A, B](x: List[A], f: A => B): List[B] = error("todo")
 
  // Exercise 5
  // Relative Difficulty: 5
  // Correctness: 4.5 marks
  // Performance: 1.5 marks
  // Elegance: 1 mark
  // Total: 7
  def filter[A](x: List[A], f: A => Boolean): List[A] = error("todo")
 
  // Exercise 6
  // Relative Difficulty: 5
  // Correctness: 4.5 marks
  // Performance: 1.5 marks
  // Elegance: 1 mark
  // Total: 7
  def append[A](x: List[A], y: List[A]): List[A] = error("todo")
 
  // Exercise 7
  // Relative Difficulty: 5
  // Correctness: 4.5 marks
  // Performance: 1.5 marks
  // Elegance: 1 mark
  // Total: 7
  def concat[A](x: List[List[A]]): List[A] = error("todo")
 
  // Exercise 8
  // Relative Difficulty: 7
  // Correctness: 5.0 marks
  // Performance: 1.5 marks
  // Elegance: 1.5 mark
  // Total: 8
  def concatMap[A, B](x: List[A], f: A => List[B]): List[B] = error("todo")
 
  // Exercise 9
  // Relative Difficulty: 8
  // Correctness: 3.5 marks
  // Performance: 3.0 marks
  // Elegance: 2.5 marks
  // Total: 9
  def maximum(x: List[Int]): Int = error("todo")
 
  // Exercise 10
  // Relative Difficulty: 10
  // Correctness: 5.0 marks
  // Performance: 2.5 marks
  // Elegance: 2.5 marks
  // Total: 10
  def reverse[A](x: List[A]): List[A] = error("todo")
}

{-# LANGUAGE RankNTypes #-}
 
data Monad' m = Monad' {
  unit :: (forall a. a -> m a),
  bind :: (forall a b. m a -> (a -> m b) -> m b)
}

listMonad = Monad' (return :: a -> [a]) (>>=)
maybeMonad = Monad' (return :: a -> Maybe a) (>>=)

sequence' monad [] = unit monad []
sequence' monad (x:xs) = let (>>>=) = bind monad in x >>>= \y -> sequence' monad xs >>>= \ys -> unit monad (y:ys)
 
mapM' monad f as = ... etc. etc.

listSequence = sequence' listMonad
maybeSequence = sequence' maybeMonad
 
listMapM = mapM' listMonad
... and so on.

int i = c; // where c is of type char

trait Unit[U[_]] {
  def unit[A](a: A): U[A]
}
 
trait Bind[M[_]] {
  def bind[A, B](ma: M[A], f: A => M[B]): M[B]
}
 
case class Monad[M[_]](u: Unit[M], b: Bind[M])
 
object Monad {
  val listMonad = Monad[List](new Unit[List] {
    def unit[A](a: A) = List(a) }, new Bind[List] {
    def bind[A, B](ma: List[A], f: A => List[B]) = ma flatMap f
  })
 
  def sequence[M[_], A](m: Monad[M], as: List[M[A]]): M[List[A]] = as match {
    case Nil => m.u.unit(Nil)
    case x :: xs => m.b.bind(x, (y: A) => m.b.bind(sequence[M, A](m, xs), (ys: List[A]) => m.u.unit(y::ys)))
  }
 
  def listSequence[A](as: List[List[A]]) = sequence[List, A](listMonad, as)
  def optionSequence[A](as: List[List[A]]) = sequence[Option, A](optionMonad, as)
  // etc. etc. O(n)!
}

class Applicative f where
  pure :: a -> f a
  (<*>) :: f (a -> b) -> f a -> f b

 
object ApplicativeLaws {
  def identity[A[_], X](implicit a: Applicative[A],
                                 aax: Arbitrary[A[X]],
                                 e: Equal[A[X]]) =
    prop((apx: A[X]) => apx === a(a.unit((x: X) => x), apx))
 
  def composition[A[_], X, Y, Z](implicit a: Applicative[A],
                                aayz: Arbitrary[A[Y => Z]],
                                aaxy: Arbitrary[A[X => Y]],
                                aax: Arbitrary[A[X]],
                                e: Equal[A[Z]]) =
    prop((apyz: A[Y => Z], apxy: A[X => Y], apx: A[X]) =>
            a(apyz, a(apxy, apx)) ===
            a(a(a(a.unit((f: Y => Z) => (g: X => Y) => f compose g), apyz), apxy), apx))
 
  def homomorphism[A[_], X, Y](implicit a: Applicative[A],
                                        ax: Arbitrary[X],
                                        axy: Arbitrary[X => Y],
                                        e: Equal[A[Y]]) =
    prop((f: X => Y, x: X) => a(a.unit(f), a.unit(x)) === a.unit(f(x)))
 
  def interchange[A[_], X, Y](implicit a: Applicative[A],
                                       ax: Arbitrary[X],
                                       apxy: Arbitrary[A[X => Y]],
                                       e: Equal[A[Y]]) =
    prop((f: A[X => Y], x: X) =>
      a(f, a.unit(x)) === a(a.unit((f: X => Y) => f(x)), f))
}

List(identity[List, Int],
     composition[List, Int, Long, String],
     homomorphism[List, Int, String],
     interchange[List, Int, String]).
  foreach(p => summary println p)