@explorable-viz/fluid 0.0.23
Sign up to get free protection for your applications and to get access to all the features.
- package/LICENSE +21 -0
- package/README.md +36 -0
- package/dist/article/app.js +40580 -0
- package/dist/article/css/styles.css +191 -0
- package/dist/article/css/view-styles.css +141 -0
- package/dist/article/fluid/dataset/renewables-restricted.fld +139 -0
- package/dist/article/fluid/example/arithmetic.fld +1 -0
- package/dist/article/fluid/example/array.fld +2 -0
- package/dist/article/fluid/example/compose.fld +2 -0
- package/dist/article/fluid/example/desugar/list-comp-1.fld +1 -0
- package/dist/article/fluid/example/desugar/list-comp-10.fld +1 -0
- package/dist/article/fluid/example/desugar/list-comp-2.fld +1 -0
- package/dist/article/fluid/example/desugar/list-comp-3.fld +1 -0
- package/dist/article/fluid/example/desugar/list-comp-4.fld +1 -0
- package/dist/article/fluid/example/desugar/list-comp-5.fld +1 -0
- package/dist/article/fluid/example/desugar/list-comp-6.fld +1 -0
- package/dist/article/fluid/example/desugar/list-comp-7.fld +1 -0
- package/dist/article/fluid/example/desugar/list-comp-8.fld +1 -0
- package/dist/article/fluid/example/desugar/list-comp-9.fld +1 -0
- package/dist/article/fluid/example/desugar/list-enum.fld +1 -0
- package/dist/article/fluid/example/dicts.fld +11 -0
- package/dist/article/fluid/example/div-mod-quot-rem.fld +4 -0
- package/dist/article/fluid/example/factorial.fld +6 -0
- package/dist/article/fluid/example/filter.fld +1 -0
- package/dist/article/fluid/example/first-class-constr.fld +1 -0
- package/dist/article/fluid/example/flatten.fld +12 -0
- package/dist/article/fluid/example/foldr-sumSquares.fld +1 -0
- package/dist/article/fluid/example/graphics/background.fld +7 -0
- package/dist/article/fluid/example/graphics/grouped-bar-chart.fld +9 -0
- package/dist/article/fluid/example/graphics/line-chart.fld +13 -0
- package/dist/article/fluid/example/graphics/small-barchart.fld +5 -0
- package/dist/article/fluid/example/graphics/stacked-bar-chart.fld +3 -0
- package/dist/article/fluid/example/include-input-into-output.fld +1 -0
- package/dist/article/fluid/example/length.fld +1 -0
- package/dist/article/fluid/example/lexicalScoping.fld +3 -0
- package/dist/article/fluid/example/lib/some-constants.fld +1 -0
- package/dist/article/fluid/example/linked-inputs/energyscatter.fld +24 -0
- package/dist/article/fluid/example/linked-inputs/mini-energyscatter.fld +30 -0
- package/dist/article/fluid/example/linked-inputs/mini-non-renewables.fld +3 -0
- package/dist/article/fluid/example/linked-inputs/mini-renewables.fld +6 -0
- package/dist/article/fluid/example/linked-inputs/non-renewables.fld +67 -0
- package/dist/article/fluid/example/linked-inputs/renewables.fld +301 -0
- package/dist/article/fluid/example/linked-outputs/bar-chart-line-chart.expect.fld +0 -0
- package/dist/article/fluid/example/linked-outputs/bar-chart-line-chart.fld +26 -0
- package/dist/article/fluid/example/linked-outputs/convolution-data.fld +5 -0
- package/dist/article/fluid/example/linked-outputs/convolution.fld +12 -0
- package/dist/article/fluid/example/linked-outputs/line-chart.fld +13 -0
- package/dist/article/fluid/example/linked-outputs/moving-average-data.fld +9 -0
- package/dist/article/fluid/example/linked-outputs/moving-average.fld +15 -0
- package/dist/article/fluid/example/linked-outputs/pairs-data.fld +1 -0
- package/dist/article/fluid/example/linked-outputs/pairs.fld +3 -0
- package/dist/article/fluid/example/linked-outputs/renewables.fld +100 -0
- package/dist/article/fluid/example/linked-outputs/stacked-bar-chart-scatter-plot.fld +38 -0
- package/dist/article/fluid/example/lookup.fld +15 -0
- package/dist/article/fluid/example/map.fld +1 -0
- package/dist/article/fluid/example/mergeSort.fld +22 -0
- package/dist/article/fluid/example/normalise.fld +3 -0
- package/dist/article/fluid/example/nub.fld +1 -0
- package/dist/article/fluid/example/pattern-match.fld +12 -0
- package/dist/article/fluid/example/range.fld +4 -0
- package/dist/article/fluid/example/record-lookup.fld +3 -0
- package/dist/article/fluid/example/records.fld +11 -0
- package/dist/article/fluid/example/reverse.fld +1 -0
- package/dist/article/fluid/example/scratchpad.fld +6 -0
- package/dist/article/fluid/example/slicing/add.expect.fld +1 -0
- package/dist/article/fluid/example/slicing/add.fld +1 -0
- package/dist/article/fluid/example/slicing/array/array.expect.fld +2 -0
- package/dist/article/fluid/example/slicing/array/array.fld +4 -0
- package/dist/article/fluid/example/slicing/array/dims.expect.fld +3 -0
- package/dist/article/fluid/example/slicing/array/dims.fld +3 -0
- package/dist/article/fluid/example/slicing/array/lookup.expect.fld +3 -0
- package/dist/article/fluid/example/slicing/array/lookup.fld +5 -0
- package/dist/article/fluid/example/slicing/convolution/edgeDetect.expect.fld +1 -0
- package/dist/article/fluid/example/slicing/convolution/edgeDetect.fld +1 -0
- package/dist/article/fluid/example/slicing/convolution/emboss-wrap.fld +1 -0
- package/dist/article/fluid/example/slicing/convolution/emboss.expect.fld +1 -0
- package/dist/article/fluid/example/slicing/convolution/emboss.fld +1 -0
- package/dist/article/fluid/example/slicing/convolution/filter/edge-detect.fld +5 -0
- package/dist/article/fluid/example/slicing/convolution/filter/emboss.fld +5 -0
- package/dist/article/fluid/example/slicing/convolution/filter/gaussian.fld +5 -0
- package/dist/article/fluid/example/slicing/convolution/gaussian.expect.fld +1 -0
- package/dist/article/fluid/example/slicing/convolution/gaussian.fld +1 -0
- package/dist/article/fluid/example/slicing/convolution/test-image.fld +7 -0
- package/dist/article/fluid/example/slicing/dict/create.expect.fld +1 -0
- package/dist/article/fluid/example/slicing/dict/create.fld +1 -0
- package/dist/article/fluid/example/slicing/dict/difference.expect.fld +3 -0
- package/dist/article/fluid/example/slicing/dict/difference.fld +3 -0
- package/dist/article/fluid/example/slicing/dict/disjointUnion.expect.fld +1 -0
- package/dist/article/fluid/example/slicing/dict/disjointUnion.fld +1 -0
- package/dist/article/fluid/example/slicing/dict/foldl.expect.fld +1 -0
- package/dist/article/fluid/example/slicing/dict/foldl.fld +1 -0
- package/dist/article/fluid/example/slicing/dict/fromRecord.expect.fld +2 -0
- package/dist/article/fluid/example/slicing/dict/fromRecord.fld +1 -0
- package/dist/article/fluid/example/slicing/dict/get.expect.fld +3 -0
- package/dist/article/fluid/example/slicing/dict/get.fld +2 -0
- package/dist/article/fluid/example/slicing/dict/intersectionWith.expect.fld +2 -0
- package/dist/article/fluid/example/slicing/dict/intersectionWith.fld +4 -0
- package/dist/article/fluid/example/slicing/dict/map.expect.fld +6 -0
- package/dist/article/fluid/example/slicing/dict/map.fld +5 -0
- package/dist/article/fluid/example/slicing/divide.expect.fld +1 -0
- package/dist/article/fluid/example/slicing/divide.fld +1 -0
- package/dist/article/fluid/example/slicing/dtw/average-series.expect.fld +8 -0
- package/dist/article/fluid/example/slicing/dtw/average-series.fld +8 -0
- package/dist/article/fluid/example/slicing/dtw/compute-dtw.expect.fld +6 -0
- package/dist/article/fluid/example/slicing/dtw/compute-dtw.fld +6 -0
- package/dist/article/fluid/example/slicing/filter.expect.fld +4 -0
- package/dist/article/fluid/example/slicing/filter.fld +6 -0
- package/dist/article/fluid/example/slicing/intersperse-1.expect.fld +4 -0
- package/dist/article/fluid/example/slicing/intersperse-2.expect.fld +4 -0
- package/dist/article/fluid/example/slicing/intersperse.fld +5 -0
- package/dist/article/fluid/example/slicing/length.expect.fld +1 -0
- package/dist/article/fluid/example/slicing/length.fld +1 -0
- package/dist/article/fluid/example/slicing/linked-outputs/bar-chart-line-chart.expect.fld +0 -0
- package/dist/article/fluid/example/slicing/linked-outputs/bar-chart-line-chart.fld +26 -0
- package/dist/article/fluid/example/slicing/linked-outputs/renewables.fld +100 -0
- package/dist/article/fluid/example/slicing/linked-outputs/stacked-bar-scatter-plot.expect.fld +0 -0
- package/dist/article/fluid/example/slicing/linked-outputs/stacked-bar-scatter-plot.fld +38 -0
- package/dist/article/fluid/example/slicing/list-comp-1.expect.fld +6 -0
- package/dist/article/fluid/example/slicing/list-comp-2.expect.fld +6 -0
- package/dist/article/fluid/example/slicing/list-comp.fld +8 -0
- package/dist/article/fluid/example/slicing/lookup.expect.fld +6 -0
- package/dist/article/fluid/example/slicing/lookup.fld +14 -0
- package/dist/article/fluid/example/slicing/map.expect.fld +1 -0
- package/dist/article/fluid/example/slicing/map.fld +1 -0
- package/dist/article/fluid/example/slicing/matrix-update.expect.fld +5 -0
- package/dist/article/fluid/example/slicing/matrix-update.fld +10 -0
- package/dist/article/fluid/example/slicing/multiply.expect.fld +1 -0
- package/dist/article/fluid/example/slicing/multiply.fld +1 -0
- package/dist/article/fluid/example/slicing/nth.expect.fld +1 -0
- package/dist/article/fluid/example/slicing/nth.fld +1 -0
- package/dist/article/fluid/example/slicing/output-not-source.expect.fld +2 -0
- package/dist/article/fluid/example/slicing/output-not-source.fld +1 -0
- package/dist/article/fluid/example/slicing/section-5-example-1.expect.fld +10 -0
- package/dist/article/fluid/example/slicing/section-5-example-2.expect.fld +10 -0
- package/dist/article/fluid/example/slicing/section-5-example-3.expect.fld +10 -0
- package/dist/article/fluid/example/slicing/section-5-example.fld +14 -0
- package/dist/article/fluid/example/slicing/zeros-1.expect.fld +3 -0
- package/dist/article/fluid/example/slicing/zeros-2.expect.fld +3 -0
- package/dist/article/fluid/example/slicing/zeros.fld +4 -0
- package/dist/article/fluid/example/slicing/zipWith-1.expect.fld +4 -0
- package/dist/article/fluid/example/slicing/zipWith.fld +4 -0
- package/dist/article/fluid/example/text.fld +27 -0
- package/dist/article/fluid/lib/convolution.fld +16 -0
- package/dist/article/fluid/lib/dtw.fld +47 -0
- package/dist/article/fluid/lib/fnum.fld +22 -0
- package/dist/article/fluid/lib/graphics.fld +221 -0
- package/dist/article/fluid/lib/moving-average.fld +35 -0
- package/dist/article/fluid/lib/nombre.fld +14 -0
- package/dist/article/fluid/lib/prelude.fld +246 -0
- package/dist/article/index.html +44 -0
- package/fluid.js +46 -0
- package/package.json +80 -0
@@ -0,0 +1,10 @@
|
|
1
|
+
let map f [] = [];
|
2
|
+
map f (x : xs) = ⸨(f x : map f xs)⸩ in
|
3
|
+
let data = [{energyType : "Bio", output : 6.2}
|
4
|
+
, {energyType : ⸨"Hydro"⸩, output : 260}
|
5
|
+
, {energyType : "Solar", output : 19.9}
|
6
|
+
, {energyType : "Wind", output : 91}
|
7
|
+
, {energyType : "Geo", output : 14.4}
|
8
|
+
];
|
9
|
+
output = ⸨[row.output|type <- [⸨"Hydro"⸩, "Solar", "Geo"], row <- data, row.energyType == type]⸩ in
|
10
|
+
map (fun x = floor ((x / sum output) * 100)) output
|
@@ -0,0 +1,10 @@
|
|
1
|
+
let map f [] = [];
|
2
|
+
map f (x : xs) = (f x : map f xs) in
|
3
|
+
let data = [{energyType : "Bio", output : 6.2}
|
4
|
+
, {energyType : "Hydro", output : ⸨260⸩}
|
5
|
+
, {energyType : "Solar", output : ⸨19.9⸩}
|
6
|
+
, {energyType : "Wind", output : 91}
|
7
|
+
, {energyType : "Geo", output : ⸨14.4⸩}
|
8
|
+
];
|
9
|
+
output = [row.output|type <- ["Hydro", "Solar", "Geo"], row <- data, row.energyType == type] in
|
10
|
+
map (fun x = floor ((x / sum output) * ⸨100⸩)) output
|
@@ -0,0 +1,10 @@
|
|
1
|
+
let map f [] = [];
|
2
|
+
map f (x : xs) = ⸨(f x : map f xs)⸩ in
|
3
|
+
let data = [{energyType : "Bio", output : 6.2}
|
4
|
+
, {energyType : "Hydro", output : 260}
|
5
|
+
, {energyType : "Solar", output : 19.9}
|
6
|
+
, {energyType : "Wind", output : 91}
|
7
|
+
, {energyType : ⸨"Geo"⸩, output : 14.4}
|
8
|
+
];
|
9
|
+
output = ⸨[row.output|type <- ["Hydro", "Solar", ⸨"Geo"⸩], row <- data, row.energyType == type]⸩ in
|
10
|
+
map (fun x = floor ((x / sum output) * 100)) output
|
@@ -0,0 +1,14 @@
|
|
1
|
+
let map f [] = [];
|
2
|
+
map f (x : xs) = f x : map f xs;
|
3
|
+
let data = [
|
4
|
+
{ energyType: "Bio", output: 6.2 },
|
5
|
+
{ energyType: "Hydro", output: 260 },
|
6
|
+
{ energyType: "Solar", output: 19.9 },
|
7
|
+
{ energyType: "Wind", output: 91 },
|
8
|
+
{ energyType: "Geo", output: 14.4 }
|
9
|
+
];
|
10
|
+
output = [
|
11
|
+
row.output | type <- ["Hydro", "Solar", "Geo"],
|
12
|
+
row <- data, row.energyType == type
|
13
|
+
] in
|
14
|
+
map (fun x -> floor (x / sum output * 100)) output
|
@@ -0,0 +1,27 @@
|
|
1
|
+
let totalFor c rows =
|
2
|
+
sum [ row.output | row <- rows, row.country == c ];
|
3
|
+
let lookupOutput name type dataset = (head [ row | row <- dataset, row.country == name, row.energyType == type]).output;
|
4
|
+
let data2015 = [ row | row <- renewables, row.year == 2015 ];
|
5
|
+
countryData = [ { x: c, bars: [ { y: "output", z: totalFor c data2015 } ] }
|
6
|
+
| c <- ["China", "USA", "Germany"] ];
|
7
|
+
germany = lookupOutput "Germany" "Bio" data2015;
|
8
|
+
usa = lookupOutput "USA" "Bio" data2015;
|
9
|
+
china = lookupOutput "China" "Bio" data2015
|
10
|
+
in MultiView {|
|
11
|
+
"bar-chart" :=
|
12
|
+
BarChart {
|
13
|
+
caption: "Total output by country",
|
14
|
+
data: countryData
|
15
|
+
},
|
16
|
+
"one" :=
|
17
|
+
LinkedText( ["The total for the USA is: "
|
18
|
+
, numToStr (totalFor "USA" data2015)
|
19
|
+
, ", compared to that of China, which is actually: "
|
20
|
+
, numToStr (totalFor "China" data2015) ] ),
|
21
|
+
"two" :=
|
22
|
+
LinkedText( ["By inspecting the data, we can see that Germany produced "
|
23
|
+
, gradedLeqP germany usa
|
24
|
+
, " Bio energy than the USA (for the year 2015), whilst the USA produced "
|
25
|
+
, gradedLeqP usa china
|
26
|
+
, " than China." ] )
|
27
|
+
|}
|
@@ -0,0 +1,16 @@
|
|
1
|
+
let zero n = const n;
|
2
|
+
wrap n n_max = ((n - 1) `mod` n_max) + 1;
|
3
|
+
extend n = min (max n 1);
|
4
|
+
|
5
|
+
let convolve image kernel method =
|
6
|
+
let ((m, n), (i, j)) = (dims image, dims kernel);
|
7
|
+
(half_i, half_j) = (i `quot` 2, j `quot` 2);
|
8
|
+
area = i * j
|
9
|
+
in [| let weightedSum = sum [
|
10
|
+
image!(x, y) * kernel!(i' + 1, j' + 1)
|
11
|
+
| (i', j') <- range (0, 0) (i - 1, j - 1),
|
12
|
+
let x = method (m' + i' - half_i) m,
|
13
|
+
let y = method (n' + j' - half_j) n,
|
14
|
+
x >= 1, x <= m, y >= 1, y <= n
|
15
|
+
] in weightedSum `quot` area
|
16
|
+
| (m', n') in (m, n) |];
|
@@ -0,0 +1,47 @@
|
|
1
|
+
let nextIndices n m window =
|
2
|
+
[(i, j) | i <- [1 .. n],
|
3
|
+
j <- [max 1 (i - window) .. min m (i + window)]];
|
4
|
+
|
5
|
+
let costMatrixInit rows cols window =
|
6
|
+
[| let initV = if ((n == 1) `and` (m == 1)) `or` ((abs n m <= window) `and` not ((n == 1) `or` (m == 1)))
|
7
|
+
then FNum 0
|
8
|
+
else Infty
|
9
|
+
in initV | (n, m) in (rows, cols) |];
|
10
|
+
|
11
|
+
let minAndPrev (i, j) im1 jm1 ijm1 =
|
12
|
+
let minim = minimal [im1, jm1, ijm1] in
|
13
|
+
if minim `eq` im1 then
|
14
|
+
((i, j + 1), minim)
|
15
|
+
else
|
16
|
+
if minim `eq` jm1 then
|
17
|
+
((i + 1, j ), minim)
|
18
|
+
else ((i, j), minim);
|
19
|
+
|
20
|
+
let extractPath indmatrix (n, m) accum =
|
21
|
+
if (n == 1) `and` (m == 1)
|
22
|
+
then accum
|
23
|
+
else
|
24
|
+
extractPath indmatrix (indmatrix!(n, m)) ((n - 1, m - 1) : accum);
|
25
|
+
|
26
|
+
let localMinUpdate seq1 seq2 cost (costmatrix, indmatrix) (i, j) =
|
27
|
+
let iEntr = nth (i - 1) seq1;
|
28
|
+
jEntr = nth (j - 1) seq2;
|
29
|
+
dist = cost iEntr jEntr;
|
30
|
+
ip = i + 1;
|
31
|
+
jp = j + 1;
|
32
|
+
im1 = costmatrix!(i , jp);
|
33
|
+
jm1 = costmatrix!(ip, j);
|
34
|
+
im1jm1 = costmatrix!(i, j);
|
35
|
+
(prev, FNum minim) = minAndPrev (i, j) im1 jm1 im1jm1;
|
36
|
+
newVal = FNum (dist + minim)
|
37
|
+
in (matrixUpdate costmatrix (ip, jp) newVal, matrixUpdate indmatrix (ip, jp) prev);
|
38
|
+
|
39
|
+
let computeDTW seq1 seq2 cost window =
|
40
|
+
let n = length seq1;
|
41
|
+
m = length seq2;
|
42
|
+
initD = costMatrixInit (n + 1) (m + 1) window;
|
43
|
+
initI = [| 0 | (i,j) in (n + 1, m + 1)|];
|
44
|
+
indexing = nextIndices n m window;
|
45
|
+
(finished, indices) = foldl (localMinUpdate seq1 seq2 cost) (initD, initI) indexing
|
46
|
+
in
|
47
|
+
(finished, extractPath indices (n + 1, m + 1) Nil);
|
@@ -0,0 +1,22 @@
|
|
1
|
+
let comp Infty Infty = EQ;
|
2
|
+
comp Infty (FNum y) = GT;
|
3
|
+
comp (FNum x) Infty = LT;
|
4
|
+
comp (FNum x) (FNum y) = compare x y;
|
5
|
+
|
6
|
+
let fmin x y =
|
7
|
+
match comp x y as {
|
8
|
+
LT -> x;
|
9
|
+
EQ -> x;
|
10
|
+
GT -> y
|
11
|
+
};
|
12
|
+
|
13
|
+
let minimal = foldl1 fmin;
|
14
|
+
|
15
|
+
let add Infty _ = Infty;
|
16
|
+
add (FNum x) Infty = Infty;
|
17
|
+
add (FNum x) (FNum y) = FNum (x + y);
|
18
|
+
|
19
|
+
let eq Infty Infty = True;
|
20
|
+
eq Infty (FNum x) = False;
|
21
|
+
eq (FNum x) Infty = False;
|
22
|
+
eq (FNum x) (FNum y) = x == y;
|
@@ -0,0 +1,221 @@
|
|
1
|
+
-- typedef Colour = Str
|
2
|
+
-- typedef Colours = List Colour
|
3
|
+
-- typedef Cat = Str
|
4
|
+
|
5
|
+
-- Group has location (0, 0) because it doesn't interfere with positioning of its children.
|
6
|
+
-- GraphicsElement -> Point
|
7
|
+
let coords (Group gs) = Point 0 0;
|
8
|
+
coords (Rect x y _ _ _) = Point x y;
|
9
|
+
coords (Text x y _ _ _) = Point x y;
|
10
|
+
coords (Viewport x y _ _ _ _ _ _ _) = Point x y;
|
11
|
+
|
12
|
+
-- GraphicsElement -> Float
|
13
|
+
let get_x g = let Point x _ = coords g in x;
|
14
|
+
|
15
|
+
-- GraphicsElement -> Float
|
16
|
+
let get_y g = let Point _ y = coords g in x;
|
17
|
+
|
18
|
+
-- Want some kind of typeclass mechanism plus record accessors/updaters.
|
19
|
+
-- Float -> GraphicsElement -> GraphicsElement
|
20
|
+
let set_x x (Group gs) = error "Group has immutable coordinates";
|
21
|
+
set_x x (Rect _ y w h fill) = Rect x y w h fill;
|
22
|
+
set_x x (Text _ y str anchor baseline) = Text x y str anchor baseline;
|
23
|
+
set_x x (Viewport _ y w h fill margin scale translate g) = Viewport x y w h fill margin scale translate g;
|
24
|
+
|
25
|
+
-- (Point, Point) -> Point
|
26
|
+
let dimensions2 (Point x1 y1, Point x2 y2) = Point (max x1 x2) (max y1 y2);
|
27
|
+
|
28
|
+
-- For Group, dimensions are relative to implicit coords of (0, 0), since a Group's children are effectively
|
29
|
+
-- positioned relative to parent of Group. For Polymarker, will probably have to ignore the markers themselves,
|
30
|
+
-- since they are scale-invariant.
|
31
|
+
-- GraphicsElement -> Point
|
32
|
+
let
|
33
|
+
dimensions (Group gs) = foldl (curry dimensions2) (Point 0 0) (map (coords_op) gs);
|
34
|
+
dimensions (Polyline ps _ _) = foldl (curry dimensions2) (Point 0 0) ps;
|
35
|
+
dimensions (Rect _ _ w h _) = Point w h;
|
36
|
+
dimensions (Text _ _ _ _ _) = Point 0 0; -- treat text like markers; scale-invariant
|
37
|
+
dimensions (Viewport _ _ w h _ _ _ _ _) = Point w h;
|
38
|
+
|
39
|
+
coords_op g =
|
40
|
+
let (Point x y, Point w h) = prod coords dimensions g in
|
41
|
+
Point (x + w) (y + h);
|
42
|
+
|
43
|
+
-- GraphicsElement -> Float
|
44
|
+
let width g = let Point w _ = dimensions g in w;
|
45
|
+
|
46
|
+
-- GraphicsElement -> Float
|
47
|
+
let height g = let Point _ h = dimensions g in h;
|
48
|
+
|
49
|
+
-- Float -> Float -> List GraphicsElement -> List GraphicsElement
|
50
|
+
let spaceRight z sep gs =
|
51
|
+
zipWith set_x (iterate (length gs) ((+) sep) z) gs;
|
52
|
+
|
53
|
+
-- Bake colour decisions into the library for the time being. Provide two palettes, so we can have two
|
54
|
+
-- different sets of categorical values (e.g. countries and energy types). Palettes from colorbrewer2.org.
|
55
|
+
let colours1 = ["#66c2a5", "#a6d854", "#ffd92f", "#e5c494", "#fc8d62", "#b3b3b3", "#8da0cb", "#e78ac3"];
|
56
|
+
let colours2 = ["#e41a1c", "#377eb8", "#4daf4a", "#984ea3", "#ff7f00", "#ffff33", "#a65628", "#f781bf"];
|
57
|
+
|
58
|
+
-- Compositionality principle: child coords/dimensions are always expressed directly using parent reference
|
59
|
+
-- frame, to avoid depending on content of child, and so are not themselves scaled. Polyline can't be scaled
|
60
|
+
-- directly because it inherits its frame of reference from its parent. For Viewport, margin will shrink the
|
61
|
+
-- available area, possibly to zero, at which point nothing will be rendered.
|
62
|
+
-- Float -> GraphicsElement -> GraphicsElement
|
63
|
+
let scaleToWidth w (Rect x y _ h fill) = Rect x y w h fill;
|
64
|
+
scaleToWidth w (Viewport x y w0 h fill margin (Scale x_scale y_scale) translate g) =
|
65
|
+
let scale = Scale (x_scale * w / w0) y_scale in
|
66
|
+
Viewport x y w h fill margin scale translate g;
|
67
|
+
|
68
|
+
-- Float -> List GraphicsElement -> List GraphicsElement
|
69
|
+
let stackRight sep gs =
|
70
|
+
map (scaleToWidth (1 - sep)) (spaceRight (sep / 2) 1 gs);
|
71
|
+
|
72
|
+
-- Float -> List GraphicsElement -> GraphicsElement
|
73
|
+
let groupRight sep gs =
|
74
|
+
Viewport 0 0 (length gs) (maximum (map height gs)) "none" 0 (Scale 1 1) (Translate 0 0) (Group (stackRight sep gs));
|
75
|
+
|
76
|
+
-- Heuristic saying how often to place a tick on an axis of length n.
|
77
|
+
-- Float -> Float
|
78
|
+
let tickEvery n =
|
79
|
+
let m = floor (logBase 10 n) in
|
80
|
+
if n <= 2 * 10 ** m
|
81
|
+
then 2 * 10 ** (m - 1)
|
82
|
+
else 10 ** m;
|
83
|
+
|
84
|
+
let axisStrokeWidth = 0.5;
|
85
|
+
axisColour = "black";
|
86
|
+
backgroundColour = "white";
|
87
|
+
defaultMargin = 24;
|
88
|
+
markerRadius = 3.5;
|
89
|
+
tickLength = 4;
|
90
|
+
|
91
|
+
-- Helpers for axis functions.
|
92
|
+
-- Orient -> Colour -> Float -> GraphicsElement
|
93
|
+
let tick Horiz colour len = Line (Point 0 0) (Point 0 (0 - len)) colour axisStrokeWidth;
|
94
|
+
tick Vert colour len = Line (Point 0 0) (Point (0 - len) 0) colour axisStrokeWidth;
|
95
|
+
|
96
|
+
-- Orient -> Float -> Float -> Str -> GraphicsElement
|
97
|
+
let label Horiz x distance str = Text x (0 - distance - 4) str "middle" "hanging";
|
98
|
+
label Vert x distance str = Text (0 - distance) x str "end" "central";
|
99
|
+
|
100
|
+
-- Orient -> Colour -> Float -> Str -> GraphicsElement
|
101
|
+
let labelledTick orient colour len str =
|
102
|
+
Group [tick orient colour len, label orient 0 len str];
|
103
|
+
|
104
|
+
-- Orient -> Float -> Float -> Point
|
105
|
+
let mkPoint Horiz x y = Point y x;
|
106
|
+
mkPoint Vert x y = Point x y;
|
107
|
+
|
108
|
+
-- x is position of this axis on the other axis. Returns axis and position of last tick.
|
109
|
+
-- Orient -> Float -> Float -> Float -> GraphicsElement
|
110
|
+
let axis orient x start end =
|
111
|
+
let tickSp = tickEvery (end - start);
|
112
|
+
firstTick = ceilingToNearest start tickSp;
|
113
|
+
lastTick = ceilingToNearest end tickSp;
|
114
|
+
n = floor ((end - firstTick) / tickSp) + 1;
|
115
|
+
ys = iterate n ((+) tickSp) firstTick;
|
116
|
+
-- avoid redundant start and end points
|
117
|
+
ys = match firstTick > start as {
|
118
|
+
True -> start : ys;
|
119
|
+
False -> ys
|
120
|
+
};
|
121
|
+
ys = match lastTick > end as {
|
122
|
+
True -> concat2 ys [lastTick];
|
123
|
+
False -> ys
|
124
|
+
};
|
125
|
+
ps = map (mkPoint orient x) ys;
|
126
|
+
ax = Group [
|
127
|
+
Line (head ps) (last ps) axisColour axisStrokeWidth,
|
128
|
+
Polymarkers ps (flip map ys (compose (labelledTick orient axisColour tickLength) numToStr))
|
129
|
+
]
|
130
|
+
in (ax, lastTick);
|
131
|
+
|
132
|
+
-- x is position of this axis on the other axis.
|
133
|
+
-- Orient -> Float -> List Cat -> GraphicsElement
|
134
|
+
let catAxis orient x catValues =
|
135
|
+
let ys = iterate (length catValues + 1) ((+) 1) 0;
|
136
|
+
ps = map (mkPoint orient x) ys
|
137
|
+
in Group [
|
138
|
+
Line (head ps) (last ps) axisColour axisStrokeWidth,
|
139
|
+
Polymarkers (tail ps) (map (const (tick orient axisColour tickLength)) catValues),
|
140
|
+
Polymarkers (flip map (tail ps) (fun (Point x y) -> Point (x - 0.5) y)) (map (label orient -0.5 0) catValues)
|
141
|
+
];
|
142
|
+
|
143
|
+
-- Float -> Float -> Float -> Float -> List GraphicsElement -> GraphicsElement
|
144
|
+
let viewport x_start x_finish y_finish margin gs =
|
145
|
+
Viewport 0 0 (x_finish - x_start) y_finish backgroundColour margin
|
146
|
+
(Scale 1 1) (Translate (0 - x_start) 0) (Group gs);
|
147
|
+
|
148
|
+
-- Plot a map of x values to lists of (categorical value, y value) pairs. Importantly, assume all data is uniform
|
149
|
+
-- (categorical keys are the same for each x value and are ordered the same each time).
|
150
|
+
-- Bool -> Colours -> Float -> List (Float, List (Cat, Float)) -> GraphicsElement
|
151
|
+
let lineChart withAxes colours x_start data =
|
152
|
+
let xs = map fst data;
|
153
|
+
nCat = length (snd (head data));
|
154
|
+
-- (Int, Colour) -> GraphicsElement
|
155
|
+
let plot (n, colour) =
|
156
|
+
let ps = map (fun (x, kvs) -> Point x (snd (nth n kvs))) data
|
157
|
+
in Group [
|
158
|
+
Polyline ps colour 1,
|
159
|
+
Polymarkers ps (repeat (length ps) (Circle 0 0 markerRadius colour))
|
160
|
+
];
|
161
|
+
-- List GraphicsElement
|
162
|
+
let lines = zipWith (curry plot) (iterate nCat ((+) 1) 0) colours;
|
163
|
+
x_finish = last xs;
|
164
|
+
y_finish = maximum (flip map data (fun (_, kvs) -> maximum (map snd kvs)))
|
165
|
+
in match withAxes as {
|
166
|
+
True ->
|
167
|
+
let (x_axis, x_finish) = axis Horiz 0 x_start x_finish;
|
168
|
+
(y_axis, y_finish') = axis Vert x_start 0 y_finish
|
169
|
+
in viewport x_start x_finish y_finish' defaultMargin (x_axis : y_axis : lines);
|
170
|
+
False -> viewport x_start x_finish y_finish 0 lines
|
171
|
+
};
|
172
|
+
|
173
|
+
-- Plot a chart of categorical values on the x-axis and renderings of the corresponding a-value on the y-axis.
|
174
|
+
-- (Colours -> List a -> GraphicsElement) -> Bool -> Colours -> Float -> List (Cat, a) -> GraphicsElement
|
175
|
+
let categoricalChart plotValue withAxes colours sep data =
|
176
|
+
let gs = stackRight sep (plotValue colours (map snd data));
|
177
|
+
w = length gs;
|
178
|
+
h = maximum (map height gs)
|
179
|
+
in match withAxes as {
|
180
|
+
True ->
|
181
|
+
let x_axis = catAxis Horiz 0 (map fst data);
|
182
|
+
(y_axis, h') = axis Vert 0 0 h
|
183
|
+
in viewport 0 w h' defaultMargin (concat2 gs [x_axis, y_axis]); -- axes on top
|
184
|
+
False -> viewport 0 w h 0 gs
|
185
|
+
};
|
186
|
+
|
187
|
+
-- Colours -> List a -> GraphicsElement
|
188
|
+
let rects colours ns =
|
189
|
+
zipWith (fun colour n -> Rect 0 0 1 n colour) colours ns;
|
190
|
+
|
191
|
+
-- First component of data (categorical value) currently ignored; values just mapped positionally to colors.
|
192
|
+
-- Can we use Group instead of Viewport here?
|
193
|
+
-- Colours -> List (a, Num) -> GraphicsElement
|
194
|
+
let stackedBar colours ns =
|
195
|
+
let heights = map snd ns;
|
196
|
+
subtotals = scanl1 (+) 0 heights;
|
197
|
+
dims = zip (0 : subtotals) heights;
|
198
|
+
rects = map
|
199
|
+
(fun ((y, height), colour) -> Rect 0 y 1 height colour)
|
200
|
+
(zip dims colours)
|
201
|
+
in Viewport 0 0 1 (last subtotals) "none" 0 (Scale 1 1) (Translate 0 0) (Group rects);
|
202
|
+
|
203
|
+
-- Bool -> Colours -> Float -> List (a, Float) -> GraphicsElement
|
204
|
+
let barChart = categoricalChart rects;
|
205
|
+
|
206
|
+
-- For each categorical value of type a, plot a bar chart for the corresponding b-indexed data.
|
207
|
+
-- Bool -> Colours -> Float -> List (a, List (b, Float)) -> GraphicsElement
|
208
|
+
let groupedBarChart = categoricalChart (compose map (flip (barChart False) 0));
|
209
|
+
|
210
|
+
-- See stackedBar for strong (unjustified) assumption about uniformity of data.
|
211
|
+
-- Bool -> Colours -> Num -> List (a, List (b, Num)) -> GraphicsElement
|
212
|
+
let stackedBarChart = categoricalChart (compose map stackedBar);
|
213
|
+
|
214
|
+
-- Bit of a hack, but how text fits into our model is a bit unclear at the moment.
|
215
|
+
-- Str -> GraphicsElement -> GraphicsElement
|
216
|
+
let caption str (Viewport x y w h fill margin scale translate g) =
|
217
|
+
let g' = Group [
|
218
|
+
Text (x + w / 2) -2 str "middle" "hanging",
|
219
|
+
Viewport 0 0 w h fill margin scale translate g
|
220
|
+
]
|
221
|
+
in Viewport x y w h backgroundColour (defaultMargin / 2 + 4) (Scale 1 1) (Translate 0 0) g';
|
@@ -0,0 +1,35 @@
|
|
1
|
+
let zipPairs = zipWith (fun x y -> {x : x, y : y});
|
2
|
+
let getXs = map (fun rec -> rec.x);
|
3
|
+
let getYs = map (fun rec -> rec.y);
|
4
|
+
|
5
|
+
-- ISSUE: With the ones that shrink, the values near the ends will be incorrect,
|
6
|
+
-- since the actual number of points is less than the size of window (= 1 + (2 * window))
|
7
|
+
-- To fix this, need to change the constant we divide by, but using length induces dependency on whole list
|
8
|
+
|
9
|
+
-- Central average, but stops near the ends of the sequence
|
10
|
+
let cMAvg ns window =
|
11
|
+
[ (sum (slice (ind - window) (ind + window + 1) ns)) / (1 + 2 * window) | ind <- [window..length ns - window] ];
|
12
|
+
|
13
|
+
let mAvgChop ps window =
|
14
|
+
zipPairs (slice window (length ps - window) (getXs ps)) (cMAvg (getYs ps) window);
|
15
|
+
|
16
|
+
-- Central average, but end points use incomplete data
|
17
|
+
let cMAvg' ns window =
|
18
|
+
[ (sum (slice (ind - window) (ind + window + 1) ns)) / (1 + 2 * window) | ind <- [0..length ns] ];
|
19
|
+
|
20
|
+
let mAvgShrink ps window =
|
21
|
+
zipPairs (getXs ps) (cMAvg' (getYs ps) window);
|
22
|
+
|
23
|
+
-- Simple (rearward) average, chops the beginning off the sequence
|
24
|
+
let sMAvg ns window =
|
25
|
+
[ (sum (slice (ind - window) (ind + 1) ns)) / window | ind <- [window..length ns] ];
|
26
|
+
|
27
|
+
let sAvgChop ps window =
|
28
|
+
zipPairs (slice window (length ps) (getXs ps)) (sMAvg (getYs ps) window);
|
29
|
+
|
30
|
+
-- Simple (rearward average), doesn't chop beginning off
|
31
|
+
let sMAvg' ns window =
|
32
|
+
[ (sum (slice (ind - window) (ind + 1) ns)) / window | ind <- [0..length ns] ];
|
33
|
+
|
34
|
+
let sAvgShrink ps window =
|
35
|
+
zipPairs (getXs ps) (sMAvg' (getYs ps) window);
|