Polymorphism - Summation of Higher Kinds(Clojure, Ocaml, Haskell, Scala, Java).

A-sum-higher-kinds.clj

(defrecord Tree [left elm right])

(defprotocol Monoid
   (append [a b] )
   (identity [a] ))

(defprotocol Foldable
  (foldl [l f i])
  (mfirst [l]))
  
(extend-protocol Foldable
  Tree
    (foldl [l f i]
      (foldl (:right l) f (foldl (:left l) f (f i (:elm l)))))
    (mfirst [l]
      (if (= :tip (:right l)) (:elm l) (mfirst (:right l))))
  clojure.lang.IPersistentCollection
    (foldl [l f i] (reduce f i l))
    (mfirst [l] (first l))
  Object
    (foldl [l f i] i)
    (mfirst [l] nil))

(extend-protocol Monoid
  java.lang.Number
    (append [a b] (+ a b))
    (identity [a] 0)
  java.lang.String
    (append [a b] (str a b))
    (identity [a] ""))
    
(defn sum [lst]
  (let [el (mfirst lst)]
    (when el
      (foldl lst #(append %1 %2) (identity el)))))

(sum ["a" "b" "c"])
(sum [ 1 2 3 ])
(sum (Tree. (Tree. :tip 3 :tip) 4 (Tree. :tip 5 :tip)))

B-SumHigherKinds.ml

type 'a tree = Tip | Node of 'a tree * 'a * 'a tree

module type TYPE = 
    sig
      type t
    end

module type MONOID =
    sig
      type t
      val append: t -> t -> t
      val identity: t
    end

module type FOLDABLE =
    functor (M : TYPE) ->
     sig 
       type el = M.t
       and hk
       val foldm :  el -> (el -> el -> el) -> hk -> el
     end

module ListFoldable =
  functor (M : TYPE) ->
    struct
      type el = M.t
      type hk = el list
      let rec foldm (i : el) (f: el -> el -> el) (x: hk) =
        match x with
           []  -> i
         | h::t -> foldm (f i h) f t
    end

module TreeFoldable =
  functor (M : TYPE) ->
    struct
      type el = M.t
      type hk = el tree
      let rec foldm (i : el) (f: el -> el -> el) (x: hk) =
        match x with
           Tip  -> i
         | Node (l, e, r) -> foldm (foldm (f i e) f l) f r
    end  

module IntMonoid =
   struct
     type t = int
     let append = (+)
     let identity = 0
   end

module StringMonoid = 
   struct 
     type t = string
     let append x y = x^y
     let identity = ""
   end 

module Summation
    (F : FOLDABLE)
    (M : MONOID) =  
       struct 
         module FM =  F(M)
         let sum x = FM.foldm M.identity M.append x
       end

module SumLInt = Summation(ListFoldable)(IntMonoid)
module SumLString = Summation(ListFoldable)(StringMonoid)
module SumTInt = Summation(TreeFoldable)(IntMonoid)

let sumInt = SumLInt.sum [1; 2; 3; 4]       
let sumString = SumLString.sum ["1"; "2"; "3"]
let sumTree = SumTInt.sum(Node(Node(Tip, 3, Tip), 4, Node(Tip, 5, Tip)))  

C-SumHigherKinds.hs

data Tree a = Tip | Node (Tree a) a (Tree a)
     deriving Show

class Monoid a where
      append :: a -> a -> a
      identity :: a 

class FoldLeft m where 
      foldLeft :: m a -> b -> (b -> a -> b) -> b

instance FoldLeft []  where 
      foldLeft [] x f = x
      foldLeft (h:l) x f = foldLeft l (f x h) f

instance FoldLeft Tree where
      foldLeft Tip x f = x
      foldLeft (Node l e r) x f =  foldLeft r (foldLeft l (f x e) f) f

instance Monoid Int where
         append x y = x + y
         identity = 0
 
instance Monoid [a] where
         append x y = x ++ y
         identity = []
         

mysum :: (Monoid a, FoldLeft m) => m a -> a
mysum l = foldLeft l identity  append 

main :: IO ()
main = do 
              let x = [1::Int, 2, 3]
                  y = ["1", "2", "3"]
                  z = Node (Node Tip 4 Tip) (3::Int) (Node Tip 5 Tip) 
              print (mysum x)
              print (mysum y)
              print (mysum z)

D-SumHigherKinds.scala

abstract class Tree[T]
case class Tip[T] extends Tree[T]
case class Node[T](l:Tree[T], e:T, r:Tree[T]) extends  Tree[T]

trait Monoid[T] {
  def append(a: T, b: T): T
  def zero: T
}

object Monoid {
  implicit object IntMonoid extends Monoid[Int] {
    override def append(a: Int, b: Int): Int = a + b
    override def zero = 0
  }
  
  implicit object StringMonoid extends Monoid[String] {
    override def append(a: String, b: String): String = a + b
    override def zero = ""
  }
}

trait FoldLeft[F[_]] {
  def foldLeft[A, B](xs: F[A], b: B, f: (B, A) => B): B
}

object FoldLeft {
  implicit object FoldLeftList extends FoldLeft[List] {
    override def foldLeft[A, B](xs: List[A], b: B, f: (B, A) => B): B = xs.foldLeft(b)(f)
  }
  implicit object FoldLeftTree extends FoldLeft[Tree] {
    override def foldLeft[A, B](xs: Tree[A], b: B, f: (B,A)=>B): B = {
      xs match {
	case Tip() => b
	case Node(l,e,r) => foldLeft(r, foldLeft(l, f(b, e), f), f)
      }
    }
  }
}

object SumHigherKinds extends App {
  def sum[M[_], A](xs: M[A])(implicit m: Monoid[A], f: FoldLeft[M]) = f.foldLeft(xs, m.zero, m.append)
  
  val a = List(1,2,3)
  val b = List("a","b","c")
  val c = Node(Node(Tip(), 3, Tip()), 4, Node(Tip(), 5, Tip()))

  println(sum(a))
  println(sum(b))
  println(sum[Tree,Int](c))
}

E-SumHigherKinds.java

import java.util.*;

class Tree<A> {
    public Tree<A> left;
    public A elm;
    public Tree<A> right;

    public Tree(Tree<A> l, A e, Tree<A> r){
	left=l;
	elm=e;
	right=r;
    }	
}

class Monoid<A> {
    public Fn2<A,A,A> sum;
    public A zero;

    public Monoid(Fn2<A,A,A> sum, A zero){
        this.sum=sum;
        this.zero=zero;
    }

    public static Monoid<Integer> intMonoid(){
        Fn2<Integer, Integer, Integer> integerAdd=new Fn2<Integer,Integer,Integer>(){
            Integer f(Integer x, Integer y){
                return x+y;
            }
        };

        return new Monoid<Integer>(integerAdd, 0);
    }

    public static Monoid<String> stringMonoid(){
        Fn2<String, String, String> stringAdd=new Fn2<String,String,String>(){
            String f(String x, String y){
                return x+y;
            }
        };

        return new Monoid<String>(stringAdd, "");
    }
}

abstract class Fn<A,B>{
    abstract B f(A a);
}

abstract class Fn2<A,B,C>{
    abstract C f(A a, B b);
}

abstract class Foldable<T,A>{
        abstract A foldl(T l, A i, Fn2<A,A,A> f);
}

class FoldableList<A> extends Foldable<List, A>{
    A foldl(List l, A i, Fn2<A,A,A> f){
        A tmp=i;
        for(Object o : l){
            tmp=f.f(tmp,(A)o); //ewww cast
        }
        return tmp;
    }
}

class FoldableTree<A> extends Foldable<Tree, A>{
    A foldl(Tree l, A i, Fn2<A,A,A> f){
        A leftFold = l.left == null ? i : foldl(l.left, i, f);
	A efold = f.f(leftFold, (A)l.elm); //ewww cast
	A rightFold = l.right == null ? efold : foldl(l.right,efold,f); 
        return rightFold;
    }
}


public class SumHigherKinds
{
     public static <A,B>  A sum(Foldable<B,A> fold, Monoid<A> m, B l){
                 return fold.foldl(l,m.zero,m.sum);
     }

     public static void main(String args[]) {
         List<Integer> l=new ArrayList<Integer>();
         l.add(1);
         l.add(2);
         l.add(3);

         List<String> s=new ArrayList<String>();
         s.add("a");
         s.add("b");
         s.add("c");

	 Tree<Integer> t=new Tree<Integer>(new Tree<Integer>(null,3,null), 4, new Tree<Integer>(null,5,null));

         Integer x = sum(new FoldableList<Integer>(), 
			 Monoid.intMonoid(), 
			 l);
	 String y =  sum(new FoldableList<String>(), 
			 Monoid.stringMonoid(), 
			 s);
        
	 Integer z = sum(new FoldableTree<Integer>(),
			 Monoid.intMonoid(),
			 t);
         
         System.out.println(x);
         System.out.println(y);
	 System.out.println(z);
     }

}