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

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