Skip to content

Commit 2996c53

Browse files
author
Trevor L. McDonell
committed
Add building simulator benchmark in Haskell
1 parent 7c8435c commit 2996c53

File tree

4 files changed

+382
-0
lines changed

4 files changed

+382
-0
lines changed

‎.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,3 +11,4 @@ DerivedData
1111
*.swp
1212
main
1313
SwiftBenchmark
14+
Benchmarks/BuildingSimulation/Haskell/dist-newstyle

‎Benchmarks/BuildingSimulation/Haskell/app/Main.hs‎

Lines changed: 318 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,318 @@
1+
{-# LANGUAGE BangPatterns #-}
2+
{-# LANGUAGE TypeFamilies #-}
3+
{-# LANGUAGE DuplicateRecordFields #-}
4+
{-# LANGUAGE OverloadedRecordDot #-}
5+
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
6+
7+
module Main where
8+
9+
import Numeric.AD.Double
10+
import Criterion.Main
11+
import Control.Monad
12+
import Prelude hiding (init)
13+
14+
import GHC.IsList
15+
16+
17+
data SimParams a = SimParams
18+
{ tube :: !(Tube a)
19+
, slab :: !(Slab a)
20+
, quanta :: !(Quanta a)
21+
, tank :: !(Tank a)
22+
, startingTemp :: !a
23+
}
24+
deriving Show
25+
26+
instance Fractional a => Init (SimParams a) where
27+
init = SimParams init init init init 33.3
28+
29+
data Tube a = Tube
30+
{ spacing :: !a -- m
31+
, diameter :: !a -- m
32+
, thickness :: !a -- m
33+
, resistivity :: !a -- (K/W)m
34+
}
35+
deriving Show
36+
37+
instance Fractional a => Init (Tube a) where
38+
init = Tube 0.50292 0.019 0.019 2.43
39+
40+
instance IsList (Tube a) where
41+
type Item (Tube a) = a
42+
toList (Tube a b c d) = [a,b,c,d]
43+
fromList [a,b,c,d] = Tube a b c d
44+
fromList _ = undefined
45+
46+
data Slab a = Slab
47+
{ temp :: !a -- °C
48+
, area :: !a -- m³
49+
, cp :: !a -- ws / (kg K)
50+
, density :: !a -- kg / m³
51+
, thickness :: !a -- m
52+
}
53+
deriving Show
54+
55+
instance Fractional a => Init (Slab a) where
56+
init = Slab 21.1111111 100.0 0.2 2242.58 0.101
57+
58+
instance IsList (Slab a) where
59+
type Item (Slab a) = a
60+
toList (Slab a b c d e) = [a,b,c,d,e]
61+
fromList [a,b,c,d,e] = Slab a b c d e
62+
fromList _ = undefined
63+
64+
data Quanta a = Quanta
65+
{ power :: !a -- Watt
66+
, temp :: !a -- °C
67+
, flow :: !a -- m³ / sec
68+
, density :: !a -- kg / m³
69+
, cp :: !a -- ws / (kg K)
70+
}
71+
deriving Show
72+
73+
instance Fractional a => Init (Quanta a) where
74+
init = Quanta 0.0 60.0 0.0006309 1000.0 4180.0
75+
76+
instance IsList (Quanta a) where
77+
type Item (Quanta a) = a
78+
toList (Quanta a b c d e) = [a,b,c,d,e]
79+
fromList [a,b,c,d,e] = Quanta a b c d e
80+
fromList _ = undefined
81+
82+
data Tank a = Tank
83+
{ temp :: !a -- °C
84+
, volume :: !a -- m³
85+
, cp :: !a -- ws / (kg K)
86+
, density :: !a -- kg / m³
87+
, mass :: !a -- kg
88+
}
89+
deriving Show
90+
91+
instance Fractional a => Init (Tank a) where
92+
init = Tank 70.0 0.0757082 4180.000 1000.000 75.708
93+
94+
instance IsList (Tank a) where
95+
type Item (Tank a) = a
96+
toList (Tank a b c d e) = [a,b,c,d,e]
97+
fromList [a,b,c,d,e] = Tank a b c d e
98+
fromList _ = undefined
99+
100+
data QuantaAndPower a = QuantaAndPower
101+
{ quanta :: !(Quanta a)
102+
, power :: !a
103+
}
104+
deriving Show
105+
106+
data TankAndQuanta a = TankAndQuanta
107+
{ tank :: !(Tank a)
108+
, quanta :: !(Quanta a)
109+
}
110+
deriving Show
111+
112+
113+
{-# SPECIALIZE computeResistance :: Slab Float -> Tube Float -> Quanta Float -> Float #-}
114+
{-# SPECIALIZE computeResistance :: Slab Double -> Tube Double -> Quanta Double -> Double #-}
115+
computeResistance
116+
:: Floating a
117+
=> Slab a
118+
-> Tube a
119+
-> Quanta a
120+
-> a
121+
computeResistance floor tube quanta =
122+
let geometry_coeff = 10.0
123+
-- f_coff = 0.3333333
124+
125+
tubingSurfaceArea = (floor.area / tube.spacing) * pi * tube.diameter
126+
resistance_abs = tube.resistivity * tube.thickness / tubingSurfaceArea
127+
128+
resistance_corrected = resistance_abs * geometry_coeff -- * (quanta.flow * f_coff)
129+
in
130+
resistance_corrected
131+
132+
133+
{-# SPECIALIZE computeLoadPower :: Slab Float -> Tube Float -> Quanta Float -> QuantaAndPower Float #-}
134+
{-# SPECIALIZE computeLoadPower :: Slab Double -> Tube Double -> Quanta Double -> QuantaAndPower Double #-}
135+
computeLoadPower
136+
:: Floating a
137+
=> Slab a
138+
-> Tube a
139+
-> Quanta a
140+
-> QuantaAndPower a
141+
computeLoadPower floor tube quanta =
142+
let resistance_abs = computeResistance floor tube quanta
143+
144+
conductance = 1 / resistance_abs
145+
dTemp = floor.temp - quanta.temp
146+
updatedPower = dTemp * conductance
147+
148+
-- TLM: We could simplify a lot of these by either (a) dropping duplicate
149+
-- record fields; or (b) allowing overloaded record update.
150+
loadPower = -updatedPower
151+
updatedQuanta = Quanta { power = updatedPower
152+
, temp = quanta.temp
153+
, flow = quanta.flow
154+
, density = quanta.density
155+
, cp = quanta.cp
156+
}
157+
in
158+
QuantaAndPower { quanta = updatedQuanta, power = loadPower }
159+
160+
161+
{-# SPECIALIZE updateQuanta :: Quanta Float -> Quanta Float #-}
162+
{-# SPECIALIZE updateQuanta :: Quanta Double -> Quanta Double #-}
163+
updateQuanta
164+
:: Floating a
165+
=> Quanta a
166+
-> Quanta a
167+
updateQuanta quanta =
168+
let workingVolume = (quanta.flow * dTime)
169+
workingMass = (workingVolume * quanta.density)
170+
workingEnergy = quanta.power * dTime
171+
dTemp = workingEnergy / quanta.cp / workingMass
172+
173+
updatedQuanta = Quanta { power = 0
174+
, temp = quanta.temp + dTemp
175+
, flow = quanta.flow
176+
, density = quanta.density
177+
, cp = quanta.cp
178+
}
179+
in
180+
updatedQuanta
181+
182+
183+
{-# SPECIALIZE updateBuildingModel :: Float -> Slab Float -> Slab Float #-}
184+
{-# SPECIALIZE updateBuildingModel :: Double -> Slab Double -> Slab Double #-}
185+
updateBuildingModel
186+
:: Floating a
187+
=> a
188+
-> Slab a
189+
-> Slab a
190+
updateBuildingModel power floor =
191+
let floorVolume = floor.area * floor.thickness
192+
floorMass = floorVolume * floor.density
193+
194+
updatedFloor = Slab { temp = floor.temp + ((power * dTime) / floor.cp / floorMass)
195+
, area = floor.area
196+
, cp = floor.cp
197+
, density = floor.density
198+
, thickness = floor.thickness
199+
}
200+
in
201+
updatedFloor
202+
203+
204+
{-# SPECIALIZE updateSourceTank :: Tank Float -> Quanta Float -> TankAndQuanta Float #-}
205+
{-# SPECIALIZE updateSourceTank :: Tank Double -> Quanta Double -> TankAndQuanta Double #-}
206+
updateSourceTank
207+
:: Floating a
208+
=> Tank a
209+
-> Quanta a
210+
-> TankAndQuanta a
211+
updateSourceTank store quanta =
212+
let massPerTime = quanta.flow * quanta.density
213+
dTemp = store.temp - quanta.temp
214+
updatedPower = dTemp * massPerTime * quanta.cp
215+
216+
updatedQuanta = Quanta { power = updatedPower
217+
, temp = quanta.temp
218+
, flow = quanta.flow
219+
, density = quanta.density
220+
, cp = quanta.cp
221+
}
222+
223+
tankMass = store.volume * store.density
224+
dTempTank = (updatedPower * dTime) / store.cp / tankMass
225+
updatedStore = Tank { temp = store.temp + dTempTank
226+
, volume = store.volume
227+
, cp = store.cp
228+
, density = store.density
229+
, mass = store.mass
230+
}
231+
in
232+
TankAndQuanta updatedStore updatedQuanta
233+
234+
235+
{-# SPECIALIZE lossCalc :: Float -> Float -> Float #-}
236+
{-# SPECIALIZE lossCalc :: Double -> Double -> Double #-}
237+
lossCalc :: Num a => a -> a -> a
238+
lossCalc pred gt =
239+
let diff = pred - gt
240+
in abs diff
241+
242+
243+
{-# SPECIALIZE simulate :: SimParams Float -> Float #-}
244+
{-# SPECIALIZE simulate :: SimParams Double -> Double #-}
245+
simulate :: Floating a => SimParams a -> a
246+
simulate (SimParams pexTube slab0 quanta0 tank0 temp0) =
247+
let
248+
slab0' = Slab temp0 slab0.area slab0.cp slab0.density slab0.thickness
249+
250+
go !i !slab !tank !quanta
251+
| i >= timesteps = slab.temp
252+
| otherwise =
253+
let TankAndQuanta tank' quanta' = updateSourceTank tank quanta
254+
QuantaAndPower quanta'' powerToBuilding = computeLoadPower slab pexTube (updateQuanta quanta')
255+
slab' = updateBuildingModel powerToBuilding slab
256+
in
257+
go (i+1) slab' tank' (updateQuanta quanta'')
258+
in
259+
go 0 slab0' tank0 quanta0
260+
261+
262+
fullPipe :: Floating a => SimParams a -> a
263+
fullPipe params =
264+
let pred = simulate params
265+
loss = lossCalc pred 27.344767
266+
in
267+
loss
268+
269+
270+
271+
-- TLM: could probably at least make this a vector? The pack operation becomes
272+
-- more tedious however...
273+
unpack :: SimParams a -> [a]
274+
unpack (SimParams tube slab quanta tank startingTemp) =
275+
toList tube <> toList slab <> toList quanta <> toList tank <> [startingTemp]
276+
277+
pack :: [a] -> SimParams a
278+
pack x0 =
279+
let (tube, x1) = splitAt 4 x0
280+
(slab, x2) = splitAt 5 x1
281+
(quanta, x3) = splitAt 5 x2
282+
(tank, x4) = splitAt 5 x3
283+
[startingTemp] = x4
284+
in
285+
SimParams (fromList tube) (fromList slab) (fromList quanta) (fromList tank) startingTemp
286+
287+
288+
-- Simulation Parameters -------------------------------------------------------
289+
290+
dTime :: Fractional a => a
291+
dTime = 0.1
292+
293+
timesteps :: Int
294+
timesteps = 1000
295+
296+
printGradToCompare :: Bool
297+
printGradToCompare = True
298+
299+
main :: IO ()
300+
main = do
301+
let params = init :: SimParams Double
302+
params' = unpack params
303+
fullPipe' = grad (fullPipe . pack)
304+
305+
when printGradToCompare $
306+
print (pack (fullPipe' params'))
307+
308+
defaultMain
309+
[ bench "primal" $ nf fullPipe params
310+
, bench "adjoint" $ nf fullPipe' params'
311+
]
312+
313+
314+
-- Helpers ---------------------------------------------------------------------
315+
316+
class Init a where
317+
init :: a
318+

‎Benchmarks/BuildingSimulation/Haskell/building-simulation.cabal‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
cabal-version: 3.0
2+
name: building-simulation
3+
version: 0.1.0.0
4+
-- synopsis:
5+
-- description:
6+
-- license: BSD-3-Clause
7+
-- license-file: LICENSE
8+
author: Trevor L. McDonell
9+
maintainer: [email protected]
10+
-- copyright:
11+
build-type: Simple
12+
-- extra-doc-files: README.md CHANGELOG.md
13+
-- extra-source-files:
14+
15+
executable building-simulation
16+
default-language: Haskell2010
17+
hs-source-dirs: app
18+
19+
main-is: Main.hs
20+
-- other-modules:
21+
22+
ghc-options:
23+
-O2
24+
-Wall
25+
26+
build-depends:
27+
base ^>= 4.20
28+
, ad ^>= 4.5
29+
, criterion ^>= 1.6
30+
31+
-- vim: nospell

‎Benchmarks/BuildingSimulation/README.md‎

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -81,6 +81,38 @@ and then run the benchmark by going to the `TensorFlow` subdirectory here and us
8181
python3 TensorFlowSimulator.py
8282
```
8383

84+
### Haskell
85+
86+
For this benchmark we used the GHC Haskell compiler executing on the CPU. If you
87+
have a Haskell environment set up already you can jump ahead to running the
88+
benchmark. To set up such an environment I recommend to use the GHCup tool which
89+
can be found [here](https://www.haskell.org/ghcup/).
90+
91+
Once that is installed and in your path you can either use the interactive mode
92+
to select and install the version you want with:
93+
94+
```bash
95+
ghcup tui
96+
```
97+
98+
and follow the on-screen instructions, or simply:
99+
100+
```bash
101+
ghcup install ghc
102+
ghcup install cabal
103+
```
104+
105+
and it will install the currently recommended version for you.
106+
107+
Once you have both the compiler `ghc` and the package manager `cabal` installed,
108+
you can run the benchmark by going to the `Haskell` subdirectory and using the
109+
command:
110+
111+
```bash
112+
cabal run
113+
```
114+
115+
84116
## Current Results
85117

86118
### 2024-07-30

0 commit comments

Comments
 (0)