module Hopfield.Experiments.Experiment where
import Control.Monad (replicateM)
import Control.Monad.Random
import Test.QuickCheck
import Test.QuickCheck.Gen (unGen)
import Hopfield.Clusters
import Hopfield.Common
import Hopfield.Experiments.ExperimentUtil
import Hopfield.Hopfield
import Hopfield.Measurement
import Hopfield.SuperAttractors
import Hopfield.TestUtil (Type(H), patternGen)
import Hopfield.Util
genIO :: Gen a -> IO a
genIO g = do
rndInt <- randomIO
stdGen <- getStdGen
return $ unGen g stdGen rndInt
errorHeader :: String
errorHeader = "Degree\tExpected error"
basinHeader :: String
basinHeader = "Degree\tBasin size"
main :: IO ()
main = do
let n = 100
numRandoms = 8
maxDegree = 32
originPat <- genIO $ patternGen H n
let minHamming = round $ n .* (0.25 :: Double)
maxHamming = round $ n .* (0.75 :: Double)
dist = hammingDistribution n (minHamming, maxHamming)
randomPats <- replicateM numRandoms $ sampleHammingRange originPat dist
let pats = originPat:randomPats
p = length pats
originIndex = 0
degrees = powersOfTwo maxDegree
patCombiner = oneSuperAttr
putStrLn $ unwords [show n, "neurons.", "Super attractor plus", show numRandoms, "random patterns.\n"]
doErrorProb n p degrees
doHamming originPat randomPats "origin" "random"
putStrLn "Building networks..."
let nets = buildNetworks pats degrees Hebbian patCombiner
doCheckFixed (zip degrees nets) originIndex "degrees"
putStrLn "Measuring basins of attraction"
let results = measureMultiBasins measurePatternBasin nets originPat
putStrLn basinHeader
printMList results [ \r -> attachLabel [pack d, pack r] | d <- degrees ]
putStrLn "T1 experiment with 1 cluster with no average but lists"
let avgs = replicate 10 $ experimentUsingT1NoAvg Hebbian 100 10
printMList avgs (replicate 10 show)