@explorable-viz/fluid 0.7.85 → 0.7.86

package/dist/fluid/fluid/lib/convolution.fld

@@ -0,0 +1,31 @@
+let zero m n image =
+    let (m_max, n_max) = dims image
+    in if (m >= 1) `and` (m <= m_max) `and` (n >= 1) `and` (n <= n_max) 
+    then image!(m, n)
+    else 0;
+
+let wrap m n image = 
+    let (m_max, n_max) = dims image
+    in image!( ((m - 1) `mod` m_max) + 1, ((n - 1) `mod` n_max) + 1);
+
+let extend m n image = 
+    let (m_max, n_max) = dims image;
+        m' = min (max m 1) m_max;
+        n' = min (max n 1) n_max
+    in image!(m', n');
+
+let matrixSum matr =
+    let (m, n) = dims matr
+    in sum [ matr!(i, j) | (i, j) <- range (1, 1) (m, n)];
+
+let convolve image kernel lookup =
+    let ((m, n), (i, j)) = (dims image, dims kernel);
+        (half_i, half_j) = (i `quot` 2, j `quot` 2);
+        area = i * j
+    in [|let interMatrix = [|
+        let x = m' + i' - 1 - half_i;
+            y = n' + j' - 1 - half_j
+        in lookup x y image * kernel!(i', j')
+     | (i', j') in (i, j) |]
+     in matrixSum interMatrix `quot` area
+     | (m', n') in (m, n) |];

package/dist/fluid/fluid/lib/graphics.fld

@@ -0,0 +1,221 @@
+-- typedef Colour = Str
+-- typedef Colours = List Colour
+-- typedef Cat = Str
+
+-- Group has location (0, 0) because it doesn't interfere with positioning of its children.
+-- GraphicsElement -> Point
+let coords (Group gs) = Point 0 0;
+    coords (Rect x y _ _ _) = Point x y;
+    coords (String x y _ _ _) = Point x y;
+    coords (Viewport x y _ _ _ _ _ _ _) = Point x y;
+
+-- GraphicsElement -> Float
+let get_x g = let Point x _ = coords g in x;
+
+-- GraphicsElement -> Float
+let get_y g = let Point _ y = coords g in x;
+
+-- Want some kind of typeclass mechanism plus record accessors/updaters.
+-- Float -> GraphicsElement -> GraphicsElement
+let set_x x (Group gs) = error "Group has immutable coordinates";
+    set_x x (Rect _ y w h fill) = Rect x y w h fill;
+    set_x x (String _ y str anchor baseline) = String x y str anchor baseline;
+    set_x x (Viewport _ y w h fill margin scale translate g) = Viewport x y w h fill margin scale translate g;
+
+-- (Point, Point) -> Point
+let dimensions2 (Point x1 y1, Point x2 y2) = Point (max x1 x2) (max y1 y2);
+
+-- For Group, dimensions are relative to implicit coords of (0, 0), since a Group's children are effectively
+-- positioned relative to parent of Group. For Polymarker, will probably have to ignore the markers themselves,
+-- since they are scale-invariant.
+-- GraphicsElement -> Point
+let
+   dimensions (Group gs) = foldl (curry dimensions2) (Point 0 0) (map (coords_op) gs);
+   dimensions (Polyline ps _ _) = foldl (curry dimensions2) (Point 0 0) ps;
+   dimensions (Rect _ _ w h _) = Point w h;
+   dimensions (String _ _ _ _ _) = Point 0 0; -- treat text like markers; scale-invariant
+   dimensions (Viewport _ _ w h _ _ _ _ _) = Point w h;
+
+   coords_op g =
+      let (Point x y, Point w h) = prod coords dimensions g in
+      Point (x + w) (y + h);
+
+-- GraphicsElement -> Float
+let width g = let Point w _ = dimensions g in w;
+
+-- GraphicsElement -> Float
+let height g = let Point _ h = dimensions g in h;
+
+-- Float -> Float -> List GraphicsElement -> List GraphicsElement
+let spaceRight z sep gs =
+   zipWith set_x (iterate (length gs) ((+) sep) z) gs;
+
+-- Bake colour decisions into the library for the time being. Provide two palettes, so we can have two
+-- different sets of categorical values (e.g. countries and energy types). Palettes from colorbrewer2.org.
+let colours1 = ["#66c2a5", "#a6d854", "#ffd92f", "#e5c494", "#fc8d62", "#b3b3b3", "#8da0cb", "#e78ac3"];
+let colours2 = ["#e41a1c", "#377eb8", "#4daf4a", "#984ea3", "#ff7f00", "#ffff33", "#a65628", "#f781bf"];
+
+-- Compositionality principle: child coords/dimensions are always expressed directly using parent reference
+-- frame, to avoid depending on content of child, and so are not themselves scaled. Polyline can't be scaled
+-- directly because it inherits its frame of reference from its parent. For Viewport, margin will shrink the
+-- available area, possibly to zero, at which point nothing will be rendered.
+-- Float -> GraphicsElement -> GraphicsElement
+let scaleToWidth w (Rect x y _ h fill) = Rect x y w h fill;
+    scaleToWidth w (Viewport x y w0 h fill margin (Scale x_scale y_scale) translate g) =
+      let scale = Scale (x_scale * w / w0) y_scale in
+      Viewport x y w h fill margin scale translate g;
+
+-- Float -> List GraphicsElement -> List GraphicsElement
+let stackRight sep gs =
+   map (scaleToWidth (1 - sep)) (spaceRight (sep / 2) 1 gs);
+
+-- Float -> List GraphicsElement -> GraphicsElement
+let groupRight sep gs =
+   Viewport 0 0 (length gs) (maximum (map height gs)) "none" 0 (Scale 1 1) (Translate 0 0) (Group (stackRight sep gs));
+
+-- Heuristic saying how often to place a tick on an axis of length n.
+-- Float -> Float
+let tickEvery n =
+   let m = floor (logBase 10 n) in
+   if n <= 2 * 10 ** m
+   then 2 * 10 ** (m - 1)
+   else 10 ** m;
+
+let axisStrokeWidth = 0.5;
+    axisColour = "black";
+    backgroundColour = "white";
+    defaultMargin = 24;
+    markerRadius = 3.5;
+    tickLength = 4;
+
+-- Helpers for axis functions.
+-- Orient -> Colour -> Float -> GraphicsElement
+let tick Horiz colour len = Line (Point 0 0) (Point 0 (0 - len)) colour axisStrokeWidth;
+    tick Vert colour len = Line (Point 0 0) (Point (0 - len) 0) colour axisStrokeWidth;
+
+-- Orient -> Float -> Float -> Str -> GraphicsElement
+let label Horiz x distance str = String x (0 - distance - 4) str "middle" "hanging";
+    label Vert x distance str = String (0 - distance) x str "end" "central";
+
+-- Orient -> Colour -> Float -> Str -> GraphicsElement
+let labelledTick orient colour len str =
+   Group [tick orient colour len, label orient 0 len str];
+
+-- Orient -> Float -> Float -> Point
+let mkPoint Horiz x y = Point y x;
+    mkPoint Vert x y = Point x y;
+
+-- x is position of this axis on the other axis. Returns axis and position of last tick.
+-- Orient -> Float -> Float -> Float -> GraphicsElement
+let axis orient x start end =
+   let tickSp = tickEvery (end - start);
+       firstTick = ceilingToNearest start tickSp;
+       lastTick = ceilingToNearest end tickSp;
+       n = floor ((end - firstTick) / tickSp) + 1;
+       ys = iterate n ((+) tickSp) firstTick;
+       -- avoid redundant start and end points
+       ys = match firstTick > start as {
+          True -> start : ys;
+          False -> ys
+       };
+       ys = match lastTick > end as {
+          True -> concat2 ys [lastTick];
+          False -> ys
+       };
+       ps = map (mkPoint orient x) ys;
+       ax = Group [
+          Line (head ps) (last ps) axisColour axisStrokeWidth,
+          Polymarkers ps (flip map ys (compose (labelledTick orient axisColour tickLength) numToStr))
+       ]
+   in (ax, lastTick);
+
+-- x is position of this axis on the other axis.
+-- Orient -> Float -> List Cat -> GraphicsElement
+let catAxis orient x catValues =
+   let ys = iterate (length catValues + 1) ((+) 1) 0;
+       ps = map (mkPoint orient x) ys
+   in Group [
+      Line (head ps) (last ps) axisColour axisStrokeWidth,
+      Polymarkers (tail ps) (map (const (tick orient axisColour tickLength)) catValues),
+      Polymarkers (flip map (tail ps) (fun (Point x y) -> Point (x - 0.5) y)) (map (label orient -0.5 0) catValues)
+   ];
+
+-- Float -> Float -> Float -> Float -> List GraphicsElement -> GraphicsElement
+let viewport x_start x_finish y_finish margin gs =
+   Viewport 0 0 (x_finish - x_start) y_finish backgroundColour margin
+            (Scale 1 1) (Translate (0 - x_start) 0) (Group gs);
+
+-- Plot a map of x values to lists of (categorical value, y value) pairs. Importantly, assume all data is uniform
+-- (categorical keys are the same for each x value and are ordered the same each time).
+-- Bool -> Colours -> Float -> List (Float, List (Cat, Float)) -> GraphicsElement
+let lineChart withAxes colours x_start data =
+   let xs = map fst data;
+       nCat = length (snd (head data));
+   -- (Int, Colour) -> GraphicsElement
+   let plot (n, colour) =
+      let ps = map (fun (x, kvs) -> Point x (snd (nth n kvs))) data
+      in Group [
+         Polyline ps colour 1,
+         Polymarkers ps (repeat (length ps) (Circle 0 0 markerRadius colour))
+      ];
+   -- List GraphicsElement
+   let lines = zipWith (curry plot) (iterate nCat ((+) 1) 0) colours;
+       x_finish = last xs;
+       y_finish = maximum (flip map data (fun (_, kvs) -> maximum (map snd kvs)))
+   in match withAxes as {
+      True ->
+         let (x_axis, x_finish) = axis Horiz 0 x_start x_finish;
+             (y_axis, y_finish') = axis Vert x_start 0 y_finish
+         in viewport x_start x_finish y_finish' defaultMargin (x_axis : y_axis : lines);
+      False -> viewport x_start x_finish y_finish 0 lines
+   };
+
+-- Plot a chart of categorical values on the x-axis and renderings of the corresponding a-value on the y-axis.
+-- (Colours -> List a -> GraphicsElement) -> Bool -> Colours -> Float -> List (Cat, a) -> GraphicsElement
+let categoricalChart plotValue withAxes colours sep data =
+   let gs = stackRight sep (plotValue colours (map snd data));
+       w = length gs;
+       h = maximum (map height gs)
+   in match withAxes as {
+      True ->
+         let x_axis = catAxis Horiz 0 (map fst data);
+             (y_axis, h') = axis Vert 0 0 h
+         in viewport 0 w h' defaultMargin (concat2 gs [x_axis, y_axis]); -- axes on top
+      False -> viewport 0 w h 0 gs
+   };
+
+-- Colours -> List a -> GraphicsElement
+let rects colours ns =
+   zipWith (fun colour n -> Rect 0 0 1 n colour) colours ns;
+
+-- First component of data (categorical value) currently ignored; values just mapped positionally to colors.
+-- Can we use Group instead of Viewport here?
+-- Colours -> List (a, Num) -> GraphicsElement
+let stackedBar colours ns =
+   let heights = map snd ns;
+       subtotals = scanl1 (+) 0 heights;
+       dims = zip (0 : subtotals) heights;
+       rects = map
+          (fun ((y, height), colour) -> Rect 0 y 1 height colour)
+          (zip dims colours)
+   in Viewport 0 0 1 (last subtotals) "none" 0 (Scale 1 1) (Translate 0 0) (Group rects);
+
+-- Bool -> Colours -> Float -> List (a, Float) -> GraphicsElement
+let barChart = categoricalChart rects;
+
+-- For each categorical value of type a, plot a bar chart for the corresponding b-indexed data.
+-- Bool -> Colours -> Float -> List (a, List (b, Float)) -> GraphicsElement
+let groupedBarChart = categoricalChart (compose map (flip (barChart False) 0));
+
+-- See stackedBar for strong (unjustified) assumption about uniformity of data.
+-- Bool -> Colours -> Num -> List (a, List (b, Num)) -> GraphicsElement
+let stackedBarChart = categoricalChart (compose map stackedBar);
+
+-- Bit of a hack, but how text fits into our model is a bit unclear at the moment.
+-- Str -> GraphicsElement -> GraphicsElement
+let caption str (Viewport x y w h fill margin scale translate g) =
+   let g' = Group [
+      String (x + w / 2) -2 str "middle" "hanging",
+      Viewport 0 0 w h fill margin scale translate g
+   ]
+   in Viewport x y w h backgroundColour (defaultMargin / 2 + 4) (Scale 1 1) (Translate 0 0) g';

package/dist/fluid/fluid/lib/prelude.fld

@@ -0,0 +1,276 @@
+-- "Num" throughout means (Int + Float).
+
+-- Bool -> Bool
+let and False y = False;
+    and True y = y;
+
+-- Bool -> Bool
+let or True y = True;
+    or False y = y;
+
+-- Bool -> Bool
+let not True = False;
+    not False = True;
+
+-- Int -> Int -> Ordering
+let compare x y =
+   if x > y
+   then GT
+   else if x < y
+      then LT
+      else EQ;
+
+-- Num -> Num
+let negate = (-) 0;
+
+-- Log of x in base y.
+-- Float -> Float -> Float
+let logBase x y = log y / log x;
+
+-- Float -> Float -> Float
+let ceilingToNearest n m =
+   ceiling (n / m) * m;
+
+-- (b -> c) -> (a -> b) -> a -> c
+-- Want infix <<<
+let compose f g x = f (g x);
+
+-- ((a, b) -> c) -> a -> b -> c
+let curry f x y = f (x, y);
+
+-- (a -> b -> c) -> (a, b) -> c
+let uncurry f (x, y) = f x y;
+
+-- a -> b -> a
+let const x _ = x;
+
+-- (a -> b) -> (a, c) -> (b, c)
+let first f (a, c) = (f a, c);
+
+-- (a, b) -> b
+let snd (_, y) = y;
+
+-- (a -> b) -> (c, a) -> (c, b)
+let second f (c, a) = (c, f a);
+
+-- (a -> b -> c) -> b -> a -> c
+let flip f x y = f y x;
+
+-- (a, b) -> a
+let fst (x, _) = x;
+
+-- a -> a
+let id x = x;
+
+-- (a -> b) -> (a -> c) -> a -> (b, c)
+-- Want infix &&&
+let prod f g x = (f x, g x);
+
+-- (a, b) -> (b, a)
+let swap (a, b) = (b, a);
+
+-- List a -> a
+let head [] = error "Can't take head of empty list";
+    head (x : _) = x;
+
+-- List a -> List a
+let tail [] = error "Can't take tail of empty list";
+    tail (_ : xs) = xs;
+
+-- Eq a => a -> List a -> Bool
+let elem x [] = False;
+    elem x (x' : xs) = (x == x') `or` (elem x xs);
+
+-- (a -> Bool) -> List a -> Option a
+let find p [] = error "not found";
+    find p (x : xs) = if p x then Some x else find p xs;
+
+-- String -> String -> List Dict -> Option Dict
+let findWithKey fname fval table = find (fun y -> y.[fname] == fval) table;
+
+let fromSome option = match option as {
+    None -> error "Expected Some!";
+    Some x -> x
+};
+
+-- (a -> Bool) -> List a -> List a
+let filter p [] = [];
+    filter p (x : xs) =
+      let ys = filter p xs in
+      if p x then x : ys else ys;
+
+-- (a -> Option b) -> List a -> List b
+let filterMap p [] = [];
+    filterMap p (x : xs) =
+      match p x as {
+         None -> filterMap f xs;
+         Some y -> y : filterMap f xs
+      };
+
+-- (a -> b -> a) -> a -> List b -> a
+let foldl op z [] = z;
+    foldl op z (x : xs) = foldl op (op z x) xs;
+
+-- (a -> b -> a) -> List b -> a
+let foldl1 op (x : xs) = foldl op x xs;
+
+-- (a -> b -> b) -> b -> List a -> b
+let foldr op z [] = z;
+    foldr op z (x : xs) = op x (foldr op z xs);
+
+-- (a -> b -> b) -> List a -> b
+let foldr1 op [x] = x;
+    foldr1 op (x : y : xs) = op x (foldr1 op (y : xs));
+
+-- (a -> b -> a) -> a -> List b -> List a
+let scanl1 op z xs =
+   let go x continue acc =
+      let next = op acc x in
+      next : continue next in
+   foldr go (const []) xs z;
+
+-- (a -> b -> a) -> a -> List b -> List a
+let scanl op z xs =
+   z : scanl1 op z xs;
+
+-- (a -> b) -> List a -> List b
+let map f [] = [];
+    map f (x : xs) = f x : map f xs;
+
+-- (List a, List a) -> List a
+let append ([], ys) = ys;
+    append (x : xs, ys) = x : append (xs, ys);
+
+-- List a -> List -> List a
+-- Want infix ++
+let concat2 [] ys = ys;
+    concat2 (x : xs) ys = x : concat2 xs ys;
+
+-- List (List a) -> List a
+let concat = foldl concat2 [];
+
+-- (a -> List b) -> List a -> List b
+let concatMap f xs = concat (map f xs);
+
+-- List a -> a -> List a
+let intersperse [] _ = [];
+    intersperse [x] _ = [x];
+    intersperse (x : y : ys) sep = x : sep : intersperse (y : ys) sep;
+
+-- Int -> (a -> a) -> a -> List a
+let iterate n f z =
+   if n == 0 then [] else z : map f (iterate (n - 1) f z);
+
+-- List Int -> Int
+let sum = foldr (+) 0;
+
+-- List a -> a
+let last [x] = x;
+    last (x : y : ys) = last (y : ys);
+
+-- List a -> Int
+let length [] = 0;
+    length (_ : xs) = 1 + length xs;
+
+-- List a -> List a
+let reverse [] = [];
+    reverse (x : xs) = append (reverse xs, [x]);
+
+-- Int -> a -> List a
+let repeat = flip iterate id;
+
+-- Int -> List a -> List a
+let take n xs =
+    if n <= 0
+    then []
+    else match xs as {
+       [] -> [];
+       x : xs -> x : take (n - 1) xs
+    };
+
+-- Int -> List a -> List a
+let drop n xs =
+   if n <= 0
+   then xs
+   else match xs as {
+      [] -> [];
+      _ : xs -> drop (n - 1) xs
+   };
+
+-- Int -> List a -> List a
+let lastN n xs =
+   foldl (compose const (drop 1)) xs (drop n xs);
+
+-- Expects non-negative integer as first argument and non-empty list as second argument.
+-- Int -> List a -> a
+let nth n (x : xs) =
+   if n == 0 then x else nth (n - 1) xs;
+
+-- Matrix Int -> Int -> Int -> Int
+let nth2 i j xss =
+   nth (j - 1) (nth (i - 1) xss);
+
+-- Partial; requires k to be in the map.
+-- Int -> List (Int, b) -> b
+let lookup k [] = error "Key not found in map";
+    lookup k ((k', v) : kvs) =
+       if k == k' then v else lookup k kvs;
+
+-- Int -> Int -> Int
+let max n m =
+   if n > m then n else m;
+
+-- Int -> Int -> Int
+let min n m =
+   if n < m then n else m;
+
+-- List Int -> Int
+let maximum = foldr1 max;
+
+-- List Int -> Int
+let minimum = foldr1 min;
+
+-- List (a, b) -> (List a, List b)
+let unzip [] = ([], []);
+    unzip ((x, y) : zs) =
+      let (xs, ys) = unzip zs in
+      (x : xs, y : ys);
+
+-- (a -> b -> c) -> List a -> List b -> List c
+let zipWith op [] ys = [];
+    zipWith op (x : xs) [] = [];
+    zipWith op (x : xs) (y : ys) = op x y : zipWith op xs ys;
+
+-- List a -> List b -> List (a, b)
+let zip = zipWith (curry id);
+
+-- Int -> Int -> List Int
+let enumFromTo n m =
+    if n <= m then n : [n + 1 .. m] else [];
+
+let range (m1, n1) (m2, n2) =
+      [ (i1, i2) | i1 <- [m1 .. m2], i2 <- [n1 .. n2] ];
+
+-- Int -> Int -> Int
+let abs x y =
+   if x - y < 0 then negate (x - y) else (x - y);
+
+-- Eq a => [a] -> [a]
+let nub xs =
+    let nub' [] _ = [];
+        nub' (x : xs) ys = if x `elem` ys then nub' xs ys else x : nub' xs (x : ys) in
+    nub' xs [];
+
+-- Int -> Int -> [a] -> [a]
+let slice begin end xs =
+   take (end - begin) (drop begin xs);
+
+
+-- (a -> Boolean) -> List a -> (List a, List a)
+let splitOn p data = 
+    let go fls trs [] = (reverse fls, reverse trs);
+        go fls trs (x : xs) = 
+            if p x
+            then go fls (x : trs) xs
+            else go (x : fls) trs xs
+    in go [] [] data;

package/dist/fluid/fluid/lib/stats.fld

@@ -0,0 +1,76 @@
+let split [] = ([], []);
+    split (x : xs) =
+      let (ys, zs) = split xs in (x : zs, ys);
+
+let merge xs ys =
+       match (xs, ys) as {
+          ([], _) -> ys;
+          (x : xs', []) -> xs;
+          (x : xs', y : ys') ->
+             if x < y
+             then x : merge xs' ys
+             else y : merge xs ys'
+       };
+
+let mergesort xs =
+       if length xs < 2
+       then xs
+       else
+          let (ys, zs) = split xs in
+          merge (mergesort ys) (mergesort zs);
+
+-- assume data is sorted
+let findQuantile q p data = 
+    let rank = (p / q) * (length data - 1)
+    in if rank == floor rank
+    then nth rank data
+    else let x1 = floor rank;
+             x2 = ceiling rank;
+             left = nth x1 data;
+             right = nth x2 data
+        in left + (rank - x1) * (right - left);
+
+let findPercentile = findQuantile 100;
+
+let accumBins data Nil = [];
+    accumBins data [l] = [];
+    accumBins data (l : r : es) =  
+        let (ge, le) = splitOn (fun x -> x <= r) data
+        in (le , r - l) : accumBins ge (r : es);
+
+let cut data nbins = 
+    let low = minimum data;
+        binwidth = (maximum data - low) / nbins;
+        edges = [ low + (x * binwidth) | x <- enumFromTo 0 nbins ]
+    in accumBins data edges;
+
+let qcut data qs = 
+        let low = minimum data;
+            high = maximum data;
+            edges = append (low : [ findPercentile x data | x <- qs], [high])
+        in accumBins data edges;
+
+let likelihoodLE data target = 
+    length (filter (fun x -> x <= target) data) / length data;
+
+let likelihoodGE data target = 
+    length (filter (fun x -> x >= target) data) / length data;
+
+let likelihoodMap table prob = (fromSome (find (fun x -> x.prob <= prob) table)).msg;
+
+let mkPercent num = (numToStr (num * 100)) ++ "%";
+
+let leqP n m =
+    if n <= m
+    then "less"
+    else "more";
+
+let gradedLeqP n m =
+    let ratio = n / m
+    in if ratio <= 1.0
+        then if ratio <=0.5
+            then "much less"
+            else "less"
+        else if ratio >= 2.0
+            then "much more"
+            else "more";