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

[Christopher Lane Hinson]

Basically, this is the "differential equation hairball" I mentioned earlier.  You can define a set of Operators -- a modification of Mealy automata that accepts two inputs -- and any mapping of inputs to outputs within the "Operation" monad.

The Operation monad uses an existentially quantified parameter for the same purpose as the 'ST' monad, to prevent the introduction of foreign values.

Within the 'Hairball' type, (Int,Int,Int,o) means (destination address, first source address, second source address, automaton).  I don't actually use the destination address because the list is built in indexable order anyway.

'alpha' and 'beta' correspond to the two inputs that every automaton receives.  The Hairball is itself a valid automaton.

This is roughly the system I imagine people should be used when I keep saying, "don't use FRP to implement something that isn't I/O."  The whole thing is trivially readable, writable, recursive, and actually a stream processor.  On the downside you need to specify an entire interpreted DSL just to use it.

In the 'Numeric' example, 'alpha' is the variable and 'beta' is time.  Or it least it integrates alpha with respect to beta.

That's all the non-obvious stuff that comes to mind for the moment.

Friendly,
--Lane

On Thu, 29 Apr 2010, Ben wrote:

> 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
>>
>>
>>
>