@explorable-viz/fluid 0.0.23
This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
- 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);
|