λ 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);
  }
}

{-
The 'Scala exercises for beginners' set rules about what you were not permitted to use.
This is because you were permitted to use some functions, but not others. This led to
some amount of confusion (sorry). Instead, this time, I will define my own data types.
One is equivalent to Haskell's list [], although without the syntactic support and the
other is the set of natural numbers (0 onward). I will also predefine some useful
functions that you might consider using to solve each problem. That way, I needn't set
any rules; you are very much free to do what you want (Although, converting between
this type and [] is considered cheating, as you might expect ;).
 
I will consider converting the Scala exercises to use a similar strategy in a second
revision to prevent this confusion.
 
TOTAL marks:    /66
-}
 
module Exercises where
 
import Prelude hiding (sum, length, map, filter, maximum, reverse, succ, pred)
 
-- The custom list type
data List t = Nil | Cons t (List t)
 
instance (Show t) => Show (List t) where
  show = show . toList
    where
    -- unfoldr, but let's not import Data.List
    toList Nil = []
    toList (Cons h t) = h : toList t
 
-- the custom numeric type
data Natural = Zero | Succ Natural
one = Succ Zero
two = Succ one
 
instance Show Natural where
  show = show . toInt
    where
    toInt Zero = 0
    toInt (Succ x) = 1 + toInt x
 
-- functions over Natural that you may consider using
succ :: Natural -> Natural
succ = Succ
 
pred :: Natural -> Natural
pred Zero = error "bzzt. Zero has no predecessor in naturals"
pred (Succ x) = x
 
-- functions over List that you may consider using
foldRight :: (a -> b -> b) -> b -> List a -> b
foldRight _ b Nil = b
foldRight f b (Cons h t) = f h (foldRight f b t)
 
foldLeft :: (b -> a -> b) -> b -> List a -> b
foldLeft _ b Nil = b
foldLeft f b (Cons 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 (Cons h t) = foldRight f h t
 
reduceLeft :: (a -> a -> a) -> List a -> a
reduceLeft _ Nil = error "bzzt. reduceLeft on empty list"
reduceLeft f (Cons h t) = foldLeft f h t
 
unfold :: (b -> Maybe (a, b)) -> b -> List a
unfold f b = case f b of Just (a, b') -> a `Cons` unfold f b'
                         Nothing -> Nil
 
-- Exercises
 
-- Exercise 1
-- Relative Difficulty: 1
-- Correctness: 2.0 marks
-- Performance: 0.5 mark
-- Elegance: 0.5 marks
-- Total: 3
add :: Natural -> Natural -> Natural
add = 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 :: List a -> (a -> List b) -> 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"

// 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)