|
1 |
| -import Data.Array (Array, bounds, listArray, (!)) |
| 1 | +import Data.Array (Array, bounds, elems, listArray, (!)) |
2 | 2 | import Data.List (intercalate)
|
3 | 3 | import System.Random
|
4 | 4 |
|
5 | 5 | data Point = Point Double Double
|
6 | 6 |
|
7 |
| -chaosGame :: RandomGen g => g -> Int -> [Double] -> Array Int (Point -> Point) -> [Point] |
8 |
| -chaosGame g n probabilities hutchinson = take n points |
| 7 | +chaosGame :: RandomGen g => g -> Int -> Array Int (Double, (Point -> Point)) -> [Point] |
| 8 | +chaosGame g n hutchinson = take n points |
9 | 9 | where
|
10 | 10 | (x, g') = random g
|
11 | 11 | (y, g'') = random g'
|
12 | 12 |
|
13 |
| - picks = randomRs (0, 1) g'' |
14 |
| - cumulProbabilities = scanl1 (+) probabilities |
15 |
| - to_choice x = (+ 1) $ length $ takeWhile (x >) cumulProbabilities |
| 13 | + cumulProbabilities = scanl1 (+) $ map fst $ elems hutchinson |
| 14 | + to_choice x = length $ takeWhile (x >) cumulProbabilities |
16 | 15 |
|
17 |
| - points = Point x y : zipWith (hutchinson !) (map to_choice picks) points |
| 16 | + picks = map to_choice $ randomRs (0, 1) g'' |
| 17 | + step = fmap snd hutchinson |
| 18 | + |
| 19 | + points = Point x y : zipWith (step !) picks points |
| 20 | + |
| 21 | +affine :: (Double, Double, Double, Double) -> (Double, Double) -> Point -> Point |
| 22 | +affine (xx, xy, yx, yy) (a, b) (Point x y) = Point (a + xx * x + xy * y) (b + yx * x + yy * y) |
| 23 | + |
| 24 | +showPoint :: Point -> String |
| 25 | +showPoint (Point x y) = show x ++ "\t" ++ show y |
18 | 26 |
|
19 | 27 | main :: IO ()
|
20 | 28 | main = do
|
21 | 29 | g <- newStdGen
|
22 |
| - |
23 |
| - let affine [xx, xy, yx, yy] [a, b] (Point x y) = |
24 |
| - Point (a + xx * x + xy * y) (b + yx * x + yy * y) |
25 |
| - barnsley = |
| 30 | + let barnsley = |
26 | 31 | listArray
|
27 |
| - (1, 4) |
28 |
| - [ affine [0, 0, 0, 0.16] [0, 0], |
29 |
| - affine [0.85, 0.04, -0.04, 0.85] [0, 1.6], |
30 |
| - affine [0.2, -0.26, 0.23, 0.22] [0, 1.6], |
31 |
| - affine [-0.15, 0.28, 0.26, 0.24] [0, 0.44] |
| 32 | + (0, 3) |
| 33 | + [ (0.01, affine (0, 0, 0, 0.16) (0, 0)), |
| 34 | + (0.85, affine (0.85, 0.04, -0.04, 0.85) (0, 1.6)), |
| 35 | + (0.07, affine (0.2, -0.26, 0.23, 0.22) (0, 1.6)), |
| 36 | + (0.07, affine (-0.15, 0.28, 0.26, 0.24) (0, 0.44)) |
32 | 37 | ]
|
33 |
| - probabilities = [0.01, 0.85, 0.07, 0.07] |
34 |
| - points = chaosGame g 100000 probabilities barnsley |
35 |
| - showPoint (Point x y) = show x ++ "\t" ++ show y |
| 38 | + points = chaosGame g 100000 barnsley |
36 | 39 |
|
37 | 40 | writeFile "out.dat" $ intercalate "\n" $ map showPoint points
|
0 commit comments