Monoids

folds.rb

class Monoid
  attr_accessor :value
  def initialize(value)
    @value = value
  end

  def self.base
    new(const_get(:BASE))
  end

  def append(x)
    self.class.new(self.class.const_get(:F).call(@value, x.value))
  end
end

def make_monoid(base, &f)
  Class.new(Monoid).tap do |m|
    m.const_set(:BASE, base)
    m.const_set(:F, f)
  end
end

Product = make_monoid(1) { |x, y| x * y }
All = make_monoid(true) { |x, y| x && y }
Any = make_monoid(false) { |x, y| x || y }
Sum = make_monoid(0) { |x, y| x + y }

class EmptyList
  def sum
    Sum.base.value
  end

  def product
    Product.base.value
  end

  def any?(&block)
    Any.base.value
  end

  def all?(&block)
    All.base.value
  end

  def fold(monoid)
    monoid.base
  end

  def map
    EmptyList.new
  end
end

class ConsList
  def initialize(value, rest)
    @value = value
    @rest = rest
  end

  def sum
    fold(Sum).value
  end

  def product
    fold(Product).value
  end

  def any?(&block)
    map(&block).fold(Any).value
  end

  def all?(&block)
    map(&block).fold(All).value
  end

  def fold(monoid)
    f = lambda { |e, acc| acc.append(e) }
    f.call(monoid.new(@value), @rest.fold(monoid))
  end

  def map(&block)
    ConsList.new(block.call(@value), @rest.map(&block))
  end
end

class List
  def initialize(array)
    @array = array
  end

  def sum
    fold(Sum).value
  end

  def fold(monoid)
    @array.inject(monoid.base) do |acc, e|
      acc.append(monoid.new(e))
    end
  end
end

list = ConsList.new(5, ConsList.new(2, ConsList.new(20, ConsList.new(1, EmptyList.new))))

p list.sum
p list.product
p list.any? { |x| x % 2 == 0 }
p list.all? { |x| x % 2 == 0 }

l = List.new([1,2,3,4])
p l.sum
p l.fold(Product).value

full.rb

# encoding: utf-8

class EmptyList
  def ==(other)
    other.is_a?(EmptyList)
  end

  def inspect
    "⟂"
  end

  def map
    self
  end

  def ap(xs)
    self
  end

  def append(x)
    x
  end

  def fold(monoid)
    monoid.empty
  end

  def foldMap(monoidal_factory)
    monoidal_factory.empty
  end

  def bind
    self
  end

  def concat
    self
  end
end

class ConsList
  attr_reader :first, :rest

  def initialize(first, rest)
    @first = first
    @rest = rest
  end

  def ==(other)
    other.is_a?(ConsList) && other.first == @first && other.rest == @rest
  end

  def inspect
    "(#{@first.inspect}, #{@rest.inspect})"
  end

  def map(&f)
    foldMap(Mapper.new(method(:List), EmptyList.new, f))
  end

  def ap(xs)
    xs.map { |x| @first.call(x) }.append(@rest.ap(xs))
  end

  def append(x)
    ConsList.new(@first, @rest.append(x))
  end

  def fold(monoid)
    @rest.fold(monoid).append(@first)
  end

  def foldMap(monoidal_factory)
    rest = @rest.foldMap(monoidal_factory)
    folded_value = monoidal_factory.new(@first)

    folded_value.append(rest)
  end

  def bind(&f)
    map(&f).concat
  end

  def concat
    @first.append(@rest.concat)
  end
end

def List(*array)
  array.reverse.inject(EmptyList.new) do |acc, e|
    ConsList.new(e, acc)
  end
end

module List
  def self.empty
    EmptyList.new
  end

  def self.return(x)
    List(x)
  end
end

class Mapper
  def initialize(singleton, empty, f)
    @singleton = singleton
    @empty = empty
    @f = f
  end

  def new(value)
    @value = value
    self
  end

  def empty
    @empty
  end

  def append(x)
    v = @singleton.call(@f.call(@value))
    v.append(x)
  end
end

class Product
  def self.empty
    new(1)
  end

  attr_reader :value
  def initialize(value)
    @value = value
  end

  def ==(other)
    other.is_a?(Product) && other.value == @value
  end

  def append(x)
    self.class.new(@value * x.value)
  end
end

class Sum
  def self.empty
    new(0)
  end

  attr_reader :value
  def initialize(value)
    @value = value
  end

  def ==(other)
    other.is_a?(Sum) && other.value == @value
  end

  def append(x)
    self.class.new(@value + x.value)
  end
end

class Any
  def self.empty
    new(false)
  end

  attr_reader :value
  def initialize(value)
    @value = value
  end

  def ==(other)
    other.is_a?(Any) && other.value == @value
  end

  def append(x)
    self.class.new(@value || x.value)
  end
end

class All
  def self.empty
    new(true)
  end

  attr_reader :value
  def initialize(value)
    @value = value
  end

  def ==(other)
    other.is_a?(All) && other.value == @value
  end

  def append(x)
    self.class.new(@value && x.value)
  end
end

class Endo
  def self.empty
    Endo.new(lambda { |x| x })
  end

  attr_reader :value
  def initialize(value)
    @value = value
  end

  def append(g)
    Endo.new(lambda { |x| @value.call(g.value.call(x)) })
  end
end

class Nothing
  def ==(other)
    other.is_a?(Nothing)
  end

  def map
    self
  end

  def ap(x)
    self
  end

  def append(x)
    x
  end

  def foldMap(monoidal_factory)
    monoidal_factory.empty
  end

  def bind
    self
  end
end

class Just
  attr_reader :value

  def initialize(value)
    @value = value
  end

  def ==(other)
    other.is_a?(Just) && other.value == value
  end

  def map(&f)
    Just.new(f.call(@value))
  end

  def ap(something)
    something.map(&@value)
  end

  def append(x)
    if x.is_a?(Nothing)
      self
    else
      Just.new(@value.append(x.value))
    end
  end

  def foldMap(monoidal_factory)
    monoidal_factory.new(@value)
  end

  def bind(&f)
    f.call(@value)
  end
end

module Maybe
  def self.empty
    Nothing.new
  end

  def self.return(x)
    Just.new(x)
  end
end

class Failure
  attr_reader :value
  def initialize(value)
    @value = value
  end

  def ==(other)
    other.is_a?(Failure) && other.value == @value
  end

  def map
    self
  end

  def ap(x)
    self
  end

  def foldMap(monoidal_factory)
    monoidal_factory.empty
  end

  def bind
    self
  end
end

class Success
  attr_reader :value
  def initialize(value)
    @value = value
  end

  def ==(other)
    other.is_a?(Success) && other.value == @value
  end

  def map(&f)
    Success.new(f.call(@value))
  end

  def ap(r)
    r.map(&@value)
  end

  def foldMap(monoidal_factory)
    monoidal_factory.new(@value)
  end

  def bind(&f)
    f.call(@value)
  end
end

module Either
  def self.return(x)
    Success.new(x)
  end
end

class EmptyNode
  def ==(other)
    other.is_a?(EmptyNode)
  end

  def inspect
    "⟂"
  end

  def map
    self
  end

  def ap(ts)
    self
  end

  def append(x)
    x
  end

  def fold(monoid)
    monoid.empty
  end

  def foldMap(monoidal_functor)
    monoidal_functor.empty
  end
end

class Node
  attr_reader :left, :value, :right
  def initialize(left, value, right)
    @left = left
    @value = value
    @right = right
  end

  def ==(other)
    other.is_a?(Node) &&
      @left == other.left &&
      @value == other.value &&
      @right == other.right
  end

  def inspect
    left = @left.inspect
    value = @value.inspect
    right = @right.inspect
    left = left == '' ? nil : left
    right = right == '' ? nil : right
    output = [value, left, right].compact
    "Tree(#{output.join(', ')})"
  end

  def map(&f)
    foldMap(Mapper.new(method(:Tree), EmptyNode.new, f))
  end

  def ap(ts)
    ts.map { |t| @value.call(t) }.append(@left.ap(ts)).append(@right.ap(ts))
  end

  def append(x)
    Node.new(@left, @value, @right.append(x))
  end

  def fold(monoid)
    @left.fold(monoid).append(@right.fold(monoid)).append(@value)
  end

  def foldMap(monoidal_factory)
    left = @left.foldMap(monoidal_factory)
    right = @right.foldMap(monoidal_factory)
    folded_value = monoidal_factory.new(@value)

    folded_value.append(left).append(right)
  end
end

def Tree(value, left = EmptyNode.new, right = EmptyNode.new)
  Node.new(left, value, right)
end

module Tree
  def self.empty
    EmptyNode.new
  end
end

class Io
  attr_reader :action
  def initialize(&action)
    @action = action
  end

  def self.return(x)
    new { x }
  end

  def bind(&f)
    Io.new do
      result = @action.call
      f.call(result)
    end
  end

  def map(&f)
    Io.new do
      result = @action.call
      f.call(result)
    end
  end

  def ap(i)
    Io.new do
      f = @action.call
      f.call(i.main)
    end
  end

  def main
    result = @action.call
    if result.is_a?(Io)
      result.main
    else
      result
    end
  end
end

def get_line(io = $stdin)
  Io.new { io.gets }
end

def put_line(s, io = $stdout)
  Io.new { io.puts s }
end

class Proc
  def map(&g)
    lambda { |x| self.call(g.call(x)) }
  end

  def self.pure(v)
    lambda { |_| v }
  end

  def ap(&g)
    lambda do |x|
      r = g.call(x)
      self.call(x).call(r)
    end
  end
end

require 'rspec'

describe 'functors' do
  it 'maps over a list' do
    list = List(1, 3, 6, 9)
    mapped = list.map { |x| x + 1 }
    mapped.should == List(2, 4, 7, 10)
  end

  it 'maps over something' do
    something = Just.new(5)
    mapped = something.map { |x| x + 1 }
    mapped.should == Just.new(6)
  end

  it 'maps over nothing' do
    nothing = Nothing.new
    mapped = nothing.map { |x| x + 1 }
    mapped.should == Nothing.new
  end

  it 'maps over failure' do
    left = Failure.new(5)
    mapped = left.map { |x| x + 1 }
    mapped.should == Failure.new(5)
  end

  it 'maps over success' do
    right = Success.new(5)
    mapped = right.map { |x| x + 1 }
    mapped.should == Success.new(6)
  end

  it 'maps over a tree' do
    tree = Tree(5, Tree(2), Tree(10, EmptyNode.new, Tree(13)))
    mapped = tree.map { |x| x + 1 }
    mapped.should == Tree(6, EmptyNode.new, Tree(3, EmptyNode.new, Tree(11, EmptyNode.new, Tree(14))))
  end

  it 'maps over IO' do
    buffer = StringIO.new("hello")
    io = get_line(buffer)
    mapped = io.map { |x| x.reverse }
    mapped.bind { |s| put_line(s, buffer) }.main
    buffer.rewind
    buffer.read.should == "helloolleh\n"
  end

  it 'maps over functions of one argument' do
    function = lambda { |x| x * 3 }
    mapped = function.map { |x| x + 100 }
    mapped.call(2).should == 306
  end
end

describe 'applicatives' do
  let(:add1) { lambda { |x| x + 1 } }
  let(:times100) { lambda { |x| x * 100 } }

  it 'applies over lists' do
    functions = List(add1, times100)
    values = List(1,2)
    applied = functions.ap(values)
    applied.should == List(2, 3, 100, 200)
  end

  it 'applies over a longer list' do
    functions = List(add1, times100)
    values = List(1, 2, 3)
    applied = functions.ap(values)
    applied.should == List(2, 3, 4, 100, 200, 300)
  end

  it 'applies over a shorter list' do
    functions = List(add1, times100)
    values = List(1)
    applied = functions.ap(values)
    applied.should == List(2, 100)
  end

  it 'applies over multiple lists' do
    functions = List(lambda { |x| lambda {|y| x + y } },
                     lambda { |x| lambda {|y| x * y } })
    values1 = List(1, 2, 3)
    values2 = List(7, 8, 9)
    applied1 = functions.ap(values1)
    applied2 = applied1.ap(values2)
    applied2.should == List(8,9,10,9,10,11,10,11,12,7,8,9,14,16,18,21,24,27)
  end

  it 'applies over somethings' do
    function = Just.new(lambda {|x| lambda {|y| x + y }})
    applied = function.ap(Just.new(5)).ap(Just.new(6))
    applied.should == Just.new(11)
  end

  it 'applies over nothing' do
    function = Nothing.new
    applied = function.ap(Just.new(5)).ap(Just.new(6))
    applied.should == Nothing.new
  end

  it 'applies to nothing' do
    function = Just.new(lambda {|x| lambda {|y| x + y }})
    applied = function.ap(Just.new(5)).ap(Nothing.new)
    applied.should == Nothing.new
  end

  it 'applies over failure' do
    function = Failure.new(add1)
    applied = function.ap(Success.new(6))
    applied.should == Failure.new(add1)
  end

  it 'applies over success' do
    function = Success.new(add1)
    applied = function.ap(Success.new(6))
    applied.should == Success.new(7)
  end

  it 'applies over trees' do
    function = Tree(add1, Tree(times100))
    values = Tree(5, Tree(4))
    applied = function.ap(values)
    applied.should == Tree(6, EmptyNode.new, Tree(5, EmptyNode.new, Tree(500, EmptyNode.new, Tree(400))))
  end

  it 'applies over IO' do
    buffer = StringIO.new("hello\nworld\n")
    function = Io.new do
      lambda { |str1| lambda { |str2| put_line("#{str1} #{str2}", buffer) } }
    end
    values = Io.new { get_line(buffer) }
    applied = function.ap(values).ap(values)
    applied.main
    buffer.rewind
    buffer.read.should == "hello\nworld\nhello\n world\n"
  end

  it 'applies over functions of one argument' do
    add = lambda { |x| lambda { |y| x + y } }
    adder = Proc.pure(add)
    add3 = lambda {|x| x + 3 }
    applied = adder.ap(&add3).ap(&times100)
    applied.call(5).should == 508
  end
end

describe 'monoids' do
  it 'appends lists' do
    List.empty.append(List(1,2)).should == List(1,2)
    List(1,2).append(List.empty).should == List(1,2)
    List(1,2).append(List(3,4)).should == List(1,2,3,4)
    List(1,2).append(List(3,4).append(List(5,6))).should ==
      List(1,2).append(List(3,4)).append(List(5,6))
  end

  it 'appends products' do
    Product.empty.append(Product.new(5)).should == Product.new(5)
    Product.new(5).append(Product.empty).should == Product.new(5)
    Product.new(5).append(Product.new(2)).should == Product.new(10)
    Product.new(5).append(Product.new(2).append(Product.new(3))).should ==
      Product.new(5).append(Product.new(2)).append(Product.new(3))
  end

  it 'appends sums' do
    Sum.empty.append(Sum.new(5)).should == Sum.new(5)
    Sum.new(5).append(Sum.empty).should == Sum.new(5)
    Sum.new(5).append(Sum.new(2)).should == Sum.new(7)
    Sum.new(5).append(Sum.new(2).append(Sum.new(3))).should ==
      Sum.new(5).append(Sum.new(2)).append(Sum.new(3))
  end

  it 'appends any' do
    Any.empty.append(Any.new(true)).should == Any.new(true)
    Any.new(true).append(Any.empty).should == Any.new(true)
    Any.new(true).append(Any.new(true)).should == Any.new(true)
    Any.new(true).append(Any.new(false)).should == Any.new(true)
    Any.new(false).append(Any.new(false)).should == Any.new(false)
    Any.new(true).append(Any.new(true).append(Any.new(true))).should ==
      Any.new(true).append(Any.new(true)).append(Any.new(true))
  end

  it 'appends all' do
    All.empty.append(All.new(true)).should == All.new(true)
    All.new(true).append(All.empty).should == All.new(true)
    All.new(true).append(All.new(true)).should == All.new(true)
    All.new(true).append(All.new(false)).should == All.new(false)
    All.new(false).append(All.new(false)).should == All.new(false)
    All.new(true).append(All.new(true).append(All.new(true))).should ==
      All.new(true).append(All.new(true)).append(All.new(true))
  end

  it 'appends maybes' do
    Maybe.empty.append(Just.new(5)).should == Just.new(5)
    Just.new(5).append(Maybe.empty).should == Just.new(5)
    Just.new(List(5)).append(Just.new(List(4))).should == Just.new(List(5,4))
    Just.new(List(5)).append(Just.new(List(6)).append(Just.new(List(7)))).should ==
      Just.new(List(5)).append(Just.new(List(6))).append(Just.new(List(7)))
  end

  it 'appends trees' do
    Tree.empty.append(Tree(5)).should == Tree(5)
    Tree(5).append(Tree.empty).should == Tree(5)
    Tree(5).append(Tree(6)).should == Tree(5, Tree.empty, Tree(6))
    Tree(5).append(Tree(6).append(Tree(7))).should ==
      Tree(5).append(Tree(6)).append(Tree(7))
  end

  it 'appends endofunctors' do
    f = Endo.new(lambda { |x| x + 1 })
    g = Endo.new(lambda { |x| x * 100 })
    f.append(g).value.call(5).should == 501
    Endo.empty.append(f).value.call(5).should == 6
    f.append(Endo.empty).value.call(5).should == 6
  end
end

describe 'foldable' do
  it 'appends the list of sums into a sum' do
    list = List(Sum.new(1), Sum.new(2), Sum.new(3))
    list.fold(Sum).should == Sum.new(6)
  end

  it 'appends a list into a sum' do
    list = List(1, 2, 3)
    list.foldMap(Sum).should == Sum.new(6)
  end

  it 'appends something into a sum' do
    something = Just.new(5)
    something.foldMap(Sum).should == Sum.new(5)
  end

  it 'appends nothing into a base sum' do
    nothing = Nothing.new
    nothing.foldMap(Sum).should == Sum.empty
  end

  it 'appends failure into a base sum' do
    left = Failure.new(5)
    left.foldMap(Sum).should == Sum.empty
  end

  it 'appends success into a sum' do
    right = Success.new(5)
    right.foldMap(Sum).should == Sum.new(5)
  end

  it 'appends a tree of sums into a sum' do
    tree = Tree(Sum.new(5), Tree(Sum.new(2)), Tree(Sum.new(10), EmptyNode.new, Tree(Sum.new(13))))
    tree.fold(Sum).should == Sum.new(30)
  end

  it 'appends a tree into a sum' do
    tree = Tree(5, Tree(2), Tree(10, EmptyNode.new, Tree(13)))
    tree.foldMap(Sum).should == Sum.new(30)
  end
end

describe 'monad' do
  it 'turns a list into nondeterministic computations' do
    list = List(1, 2, 3)
    result = list.bind { |e| List(e, -e) }
    result.should == List(1,-1,2,-2,3,-3)
  end

  it 'turns an empty list into empty computations' do
    EmptyList.new.bind { |e| List(e) }.should == List()
  end

  it 'is lawful to use a list monad' do
    f = lambda { |e| List(e, -e) }
    g = lambda { |e| List(e*2, -e*2) }
    List.return(1).bind(&f).should == f.call(1)
    List(1,2).bind { |e| List.return(e) }.should == List(1,2)
    (List(1,2).bind(&f)).bind(&g).should == List(1,2).bind(&f).bind(&g)
  end

  it 'applies a function over something' do
    result = Just.new(5).bind { |e| Just.new(e+1) }
    result.should == Just.new(6)
  end

  it 'applies no function over nothing' do
    result = Nothing.new.bind { |e| Just.new(e+1) }
    result.should == Nothing.new
  end

  it 'is lawful to use a maybe monad' do
    f = lambda { |e| Just.new(e+1) }
    g = lambda { |e| Just.new(e*2) }
    Maybe.return(1).bind(&f).should == f.call(1)
    Just.new(1).bind { |e| Maybe.return(e) }.should == Just.new(1)
    (Just.new(1).bind(&f)).bind(&g).should == Just.new(1).bind(&f).bind(&g)
  end

  it 'applies a function over success' do
    result = Success.new(6).bind { |e| Success.new(e+1) }
    result.should == Success.new(7)
  end

  it 'applies no function over failure' do
    result = Failure.new(6).bind { |e| Success.new(e+1) }
    result.should == Failure.new(6)
  end

  it 'is lawful to use an either monad' do
    f = lambda { |e| Success.new(e+1) }
    g = lambda { |e| Success.new(e*2) }
    Either.return(1).bind(&f).should == f.call(1)
    Success.new(1).bind { |e| Either.return(e) }.should == Success.new(1)
    (Success.new(1).bind(&f)).bind(&g).should == Success.new(1).bind(&f).bind(&g)
  end

  it 'combines IO actions' do
    buffer = StringIO.new("hello\nworld\n")
    action = get_line(buffer).bind { |s| put_line(s, buffer) }
    action.main
    buffer.rewind
    buffer.read.should == "hello\nhello\n"
  end

  xit 'is lawful to use an IO monad' do
    f = lambda { |s| Io.new { "#{s} world" } }
    buffer = StringIO.new("hello\nworld\n")

    pass_action = Io.return("yo").bind(&f)
    pass_action.action.call.action.call.should == f.call("yo").action.call

    id_action = get_line(buffer).bind { |s| Io.return(s) }.bind { |s| put_line(s, buffer) }
    id_action.main
    buffer.rewind
    buffer.read.should == "hello\nhello\n"
  end
end