[Haskell-cafe] Re: FRP for game programming / artifical life
simulation
Christopher Lane Hinson
lane at downstairspeople.org
Thu Apr 29 13:06:05 EDT 2010
On Wed, 28 Apr 2010, Ben wrote:
> thanks for the comments, i'll try to respond to them all. but to
> start off with, let me mention that my ultimate goal is to have a way
> of writing down causal and robust (restartable) computations which
> happen on infinite streams of data "in a nice way" -- by which i mean
> the declarative / whole-meal style ala Bird. loosely, these are
> functions [a] -> [b] on infinite lists; the causal constraint just
> means that the output at time (index) t only depends on the inputs for
> times (indices) <= t.
>
> the catch is the robust bit. by robust, i mean i need to be able to
> suspend the computation, and restart it where it left off (the data
> might be only sporadically or unreliably available, the computation
> needs to be able to survive machine reboots.) unfortunately the
> obvious way (to me) of writing down such suspendible computations is
> to use explicit state-machines, e.g. to reify function computation as
> data, and save that. this is unfortunately very piece-meal and
> imperative.
Ben,
Do you want this?
{-# LANGUAGE TypeFamilies, Rank2Types, GeneralizedNewtypeDeriving #-}
module Hairball (Operator(..),Hairball,Value,alpha,beta,Operation,apply,buildHairball) where
import Control.Monad
import Control.Monad.State
class Operator o where
type Domain o :: *
operation :: o -> Domain o -> Domain o -> (Domain o,o)
data Hairball o = Hairball {
hair_unique_supply :: Int,
hair_map :: [(Int,Int,Int,o)],
hair_output :: Int }
deriving (Read,Show)
data Value e = Value { address :: Int }
alpha :: Value e
alpha = Value 0
beta :: Value e
beta = Value 1
newtype Operation e o a = Operation { fromOperation :: State (Hairball o) a } deriving (Monad,MonadFix)
apply :: o -> Value e -> Value e -> Operation e o (Value e)
apply op v1 v2 =
do hair <- Operation get
Operation $ put $ hair {
hair_unique_supply = succ $ hair_unique_supply hair,
hair_map = (hair_unique_supply hair,address v1,address v2,op) : hair_map hair }
return $ Value $ hair_unique_supply hair
buildHairball :: (forall e. Operation e o (Value e)) -> Hairball o
buildHairball o = hair { hair_output = address v, hair_map = reverse $ hair_map hair }
where (v,hair) = runState (fromOperation o) (Hairball 2 [] $ error "Hairball: impossible: output value undefined")
instance Operator o => Operator (Hairball o) where
type Domain (Hairball o) = Domain o
operation hair v1 v2 = (fst $ results !! hair_output hair, hair { hair_map = drop 2 $ map snd results })
where results = (v1,undefined):(v2,undefined):flip map (hair_map hair) (\(i,s1,s2,o) ->
let (r,o') = operation o (fst $ results !! s1) (fst $ results !! s2)
in (r,(i,s1,s2,o')))
{-# LANGUAGE TypeFamilies, DoRec #-}
module Numeric () where
import Prelude hiding (subtract)
import Hairball
data Numeric n = Add | Subtract | Multiply | Delay n deriving (Read,Show)
instance (Num n) => Operator (Numeric n) where
type Domain (Numeric n) = n
operation Add x y = (x+y,Add)
operation Subtract x y = (x-y,Subtract)
operation Multiply x y = (x*y,Multiply)
operation (Delay x) x' _ = (x,Delay x')
type NumericOperation e n = Operation e (Numeric n)
type NumericHairball n = Hairball (Numeric n)
add :: Value e -> Value e -> NumericOperation e n (Value e)
add v1 v2 = apply Add v1 v2
subtract :: Value e -> Value e -> NumericOperation e n (Value e)
subtract v1 v2 = apply Subtract v1 v2
multiply :: Value e -> Value e -> NumericOperation e n (Value e)
multiply v1 v2 = apply Multiply v1 v2
delay :: n -> Value e -> NumericOperation e n (Value e)
delay initial_value v1 = apply (Delay initial_value) v1 alpha
integratorProgram :: String
integratorProgram = show $ buildHairball $
do rec prev_beta <- delay 0 beta
d_beta <- subtract beta prev_beta
add_alpha <- multiply alpha d_beta
prev_sum <- delay 0 sum
sum <- add prev_sum add_alpha
return sum
runNumericProgram :: (Read n,Show n,Num n) => String -> n -> n -> (n,String)
runNumericProgram program value time = (result,show hairball')
where hairball :: (Read n) => NumericHairball n
hairball = read program
(result,hairball') = operation hairball value time
numericStream :: (Read n,Show n,Num n) => [(n,n)] -> (n,String) -> (n,String)
numericStream [] (n,s) = (n,s)
numericStream ((a,t):ats) (_,s) = numericStream ats $ runNumericProgram s a t
More information about the Haskell-Cafe
mailing list