Anonymous user
Galton box animation: Difference between revisions
→{{header|Haskell}}: Added solution using GLOSS
(→{{header|Elm}}: Updated to work with Elm 0.17.0) |
(→{{header|Haskell}}: Added solution using GLOSS) |
||
Line 1,063:
Link to live demo: http://dc25.github.io/galtonBoxAnimationElm/ . Follow the link, enter a number and press the GO button.
=={{header|Haskell}}==
<lang haskell>import Data.Map hiding (map, filter)
import Graphics.Gloss
import Control.Monad.Random
data Ball = Ball { position :: (Int, Int), turns :: [Int] }
type World = ( Int -- number of rows of pins
, [Ball] -- sequence of balls
, Map Int Int ) -- counting bins
updateWorld :: World -> World
updateWorld (nRows, balls, bins)
| y < -nRows-5 = (nRows, map update bs, bins <+> x)
| otherwise = (nRows, map update balls, bins)
where
(Ball (x,y) _) : bs = balls
b <+> x = unionWith (+) b (singleton x 1)
update (Ball (x,y) turns)
| -nRows <= y && y < 0 = Ball (x + head turns, y - 1) (tail turns)
| otherwise = Ball (x, y - 1) turns
drawWorld :: World -> Picture
drawWorld (nRows, balls, bins) = pictures [ color red ballsP
, color black binsP
, color blue pinsP ]
where ballsP = foldMap (disk 1) $ takeWhile ((3 >).snd) $ map position balls
binsP = foldMapWithKey drawBin bins
pinsP = foldMap (disk 0.2) $ [1..nRows] >>= \i ->
[1..i] >>= \j -> [(2*j-i-1, -i-1)]
disk r pos = trans pos $ circleSolid (r*10)
drawBin x h = trans (x,-nRows-7)
$ rectangleUpperSolid 20 (-fromIntegral h)
trans (x,y) = Translate (20 * fromIntegral x) (20 * fromIntegral y)
startSimulation :: Int -> [Ball] -> IO ()
startSimulation nRows balls = simulate display white 50 world drawWorld update
where display = InWindow "Galton box" (400, 400) (0, 0)
world = (nRows, balls, empty)
update _ _ = updateWorld
main = evalRandIO balls >>= startSimulation 10
where balls = mapM makeBall [1..]
makeBall y = Ball (0, y) <$> randomTurns
randomTurns = filter (/=0) <$> getRandomRs (-1, 1)</lang>
=={{header|Icon}} and {{header|Unicon}}==
| |||