Heres some very amateurish code:
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
module Play where
type MyReal = Float
type Date = Int
type Worth = MyReal
type FAcc = Date -> Worth
type FFlow = Date -> Date -> Worth
type FDailyFlow = Date -> Worth
data Account = SimpleA {name :: String, stdate :: Date, stbal :: Worth} |
CompoundA [Account]
bal :: Account -> FAcc
bal (SimpleA n sd sb) date
| date == sd = sb
| True = 0 -- sb + (vol (feeding (SimpleA n sd sb)) (sd) date) - (vol
(bleeding (SimpleA n sd sb)) (sd) date)
bal (CompoundA []) date = 0
bal (CompoundA al) date = balofsimpleas sl date where
sl = filter (test (CompoundA al)) allAccounts
balofsimpleas (a1:al1) d = (bal a1 date + bal (CompoundA al1) date)
test :: Account -> Account -> Bool
test (SimpleA n sd sb) (SimpleA n_ sd_ sb_) = n == n_
test (SimpleA n sd sb) (CompoundA al_) = False
test (CompoundA []) a_ = False
test (CompoundA (a:al)) a_ = test a a_ || test (CompoundA al) a_
data Flow = SimpleF {src, dest :: String, rule :: FFlow} | CompoundF [Flow]
vol :: Flow -> FFlow
vol (SimpleF src dest rule) d1 d2 = rule d1 d2
vol (CompoundF []) d1 d2 = 0
-- *** HEY, WAKE UP: Only if theyre simple and not repeated:
vol (CompoundF (f:fl)) d1 d2= (vol f d1 d2) + (vol (CompoundF fl) d1 d2)
integrate :: FDailyFlow -> FFlow
integrate daily d1 d2
| d1 == d2 = 0
| True = daily d1 + integrate daily (d1+1) d2
bleed :: Account -> Flow -> Bool
feed :: Account -> Flow -> Bool
bleed (SimpleA n sd sb) (SimpleF src dest rule) = (n == src)
feed (SimpleA n sd sb) (SimpleF src dest rule) = (n == dest)
bleed (CompoundA []) f = False
feed (CompoundA []) f = False
bleed (CompoundA (a:al)) f = (bleed a f) || (bleed (CompoundA al) f)
feed (CompoundA (a:al)) f = (feed a f) || (feed (CompoundA al) f)
bleeding :: Account -> Flow
feeding :: Account -> Flow
bleeding a = CompoundF (filter (bleed a) allFlows)
feeding a = CompoundF (filter (feed a) allFlows)
----------------------------------------
a_others, a_siemens, a_current :: Account
a_others = SimpleA "others" 0 0
a_siemens = SimpleA "siemens" 0 0
a_current = SimpleA "current" 0 0
a_me = CompoundA [a_siemens, a_current]
a_cant = CompoundA [a_siemens, a_others]
a_all = CompoundA [a_me, a_cant]
allAccounts :: [Account]
allAccounts = [a_others, a_siemens, a_current, a_me, a_cant, a_all]
f_earn, f_spend, f_getpaid, f_steal :: Flow
f_earn = SimpleF (name a_others) (name a_siemens) (integrate (\d -> 1000.0))
f_getpaid = SimpleF (name a_siemens) (name a_current) (integrate (\d -> if
(d `mod` 30 == 15) then (bal a_siemens (d - (d `mod` 30))) else 0 ))
f_spend = SimpleF (name a_current) (name a_others) (integrate (\d -> 500.0))
f_steal = SimpleF (name a_others) (name a_current) (integrate (\d -> 1.0))
-- and f_cashpoint is when a_pocket is less than 200
allFlows :: [Flow]
allFlows = [f_earn, f_getpaid, f_spend, f_steal]
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Try it on Hugs: it moans about multiple definitions of either feed or bleed,
depending on the ordering of the lines:
bleeding a = CompoundF (filter (bleed a) allFlows)
feeding a = CompoundF (filter (feed a) allFlows)
Right now it moans about feed. The wierd thing is that the two functions,
although similar, are completely independant of each other (since I
commented out the bit up top where I use them), but if I comment out
everything to do with bleed, then suddenly its quite happy about feed.
Heres the section with bits commented out:
-- bleed :: Account -> Flow -> Bool
feed :: Account -> Flow -> Bool
-- bleed (SimpleA n sd sb) (SimpleF src dest rule) = (n == src)
feed (SimpleA n sd sb) (SimpleF src dest rule) = (n == dest)
-- bleed (CompoundA []) f = False
feed (CompoundA []) f = False
-- bleed (CompoundA (a:al)) f = (bleed a f) || (bleed (CompoundA al) f)
feed (CompoundA (a:al)) f = (feed a f) || (feed (CompoundA al) f)
-- bleeding :: Account -> Flow
feeding :: Account -> Flow
-- bleeding a = CompoundF (filter (bleed a) allFlows)
feeding a = CompoundF (filter (feed a) allFlows)
Now I'd be the first to admit that I dont know much about Haskell, but this
seems pretty wierd. I was going to test it on GHC but they expect me to
install their source control just to download the thing, which is more than
I can face at this time of night.
Sorry to make you read such long winded code.
Adrian.
