perceptrons

percept.hs

module Perceptron where

import Prelude hiding (and)

data Perceptron =
  Perceptron { inputs :: [Input]
             , bias :: Int } deriving (Eq, Show)

data Input = Input { value :: Bool
                   , weight :: Int } deriving (Eq, Show)

percept :: Perceptron -> Bool
percept p = dotProd (inputs p) - bias p > 0

dotProd :: [Input] -> Int
dotProd is =
  let toInt bool = if bool then 1 else 0 :: Int in
    sum $ zipWith (*) (map (toInt . value) is) (map weight is)

-- silly example network
network :: Perceptron
network =
  let p1 = percept $ Perceptron [Input True 7] 5
      p2 = percept $ Perceptron [Input True 6] 6
      p3 = percept $ Perceptron [Input True 6] 3 in
  Perceptron [Input p1 5, Input p2 1, Input p3 6] 10

nand :: Bool -> Bool -> Perceptron
nand a b =
  Perceptron [Input a (-2), Input b (-2)] (-3)

nand' :: Perceptron -> Perceptron -> Perceptron
nand' a b =
  Perceptron [Input (percept a) (-2), Input (percept b) (-2)] (-3)

and :: Bool -> Bool -> Perceptron
and a b =
  Perceptron [Input a (-2), Input b (-2)] (-5)

bitSum :: Bool -> Bool -> (Perceptron, Perceptron)
bitSum a b =
  let gate1 = a `nand` b
      gate2 = a `nand` (percept gate1)
      gate3 = b `nand` (percept gate1)
      gate4 = gate2 `nand'` gate3
      carryGate = gate1 `nand'` gate1
      in
    (carryGate, gate4)

shouldBe a b =
  if a == b then putStrLn "ok" else error "nope"

test =
  let percept1 = True `nand` False
      percept2 = True `nand` True
      percept3 = False `nand` False
      percept4 = False `nand` True in
  do putStrLn "nand"
     percept percept1 `shouldBe` True
     percept percept2 `shouldBe` False
     percept percept3 `shouldBe` True
     percept percept4 `shouldBe` True
     putStrLn "and"
     percept (True `and` True) `shouldBe` True
     percept (True `and` False) `shouldBe` True
     percept (False `and` False) `shouldBe` True
     percept (False `and` True) `shouldBe` True
     putStrLn "bitwise summing"
     both percept (True `bitSum` False) `shouldBe` one
     both percept (False `bitSum` False) `shouldBe` zero
     both percept (False `bitSum` True) `shouldBe` one
     both percept (True `bitSum` True) `shouldBe` two

both :: (a -> b) -> (a, a) -> (b, b)
both f (x, y) = (f x, f y)

-- two-bit numbers
zero = (False, False)
one = (False, True)
two = (True, False)
three = (True, True)