[Haskell-cafe] Re: FRP for game programming / artifical life simulation

[Ben]

Lane --

Thanks for the suggestion, I'll take a closer look shortly.  At the
moment I have to confess to not exactly understanding what your code
is doing, it's a little "hairy" for me?  Right now I'm going to focus
on what Felipe has given me, it fits in nicely with the arrow
framework, which I'm excited about.

Thanks all for your help.  I'm sure I'll have more questions soon enough!

Best, B

On Thu, Apr 29, 2010 at 10:06 AM, Christopher Lane Hinson
<lane at downstairspeople.org> wrote:
>
> 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
>
>
>