packages feed

streamgraph (empty) → 0.5.1.0

raw patch · 7 files changed

+446/−0 lines, 7 filesdep +aesondep +basedep +hashable

Dependencies added: aeson, base, hashable, hspec, scientific, semigroups, text, time, unordered-containers, vector, visie

Files

+ LICENSE view
@@ -0,0 +1,16 @@+Poetic License+==============++© 2014 Francesco Occhipinti++This work ‘as-is’ I provide.+No warranty express or implied.+  For no purpose fit,+  not even a wee bit.+Liability for damages denied.++Permission is granted hereby,+to copy, share, and modify.+  Use it with glee,+  for profit or free.+On this notice, these rights rely.
+ Streamgraph.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE OverloadedStrings #-}+module Streamgraph where++import Visie+import Visie.Data (TextFloat(TextFloat, getText), toText)+import Visie.ToTimeSeries+import Visie.Index+import Visie.Data+import Paths_streamgraph (getDataFileName)+import Data.Time.Clock+import Data.Time.Calendar (fromGregorian)+import Data.Time.Format (formatTime, defaultTimeLocale)+import Data.Scientific (fromFloatDigits)+import Data.Hashable+import Data.List (sortOn)+import qualified Data.HashMap.Strict as H+import qualified Data.Text as T++type Point = Timestamped TextFloat++dateFormat :: UTCTime -> T.Text+dateFormat = T.pack . formatTime defaultTimeLocale "%D"++-- make an universal time value using year, month, day+makeUni :: Integer -> Int -> Int -> UTCTime+makeUni y m d = UTCTime (fromGregorian y m d) (secondsToDiffTime 0)++options = defaultOptions { d3Version = Version2, index = ChartDiv }++toPoint :: (T.Text, Float, UTCTime) -> Point+toPoint (te, fl, ti) = Timestamped (TextFloat te fl) ti++-- if some dates will be missing for some labels, a runtime error will+-- be thrown. In order to prevent that, this function inefficiently+-- generates empty data points for all labels and dates+addAllPoints :: [Point] -> [Point]+addAllPoints existing = existing ++ allPoints+  where allPoints = [Timestamped (TextFloat te 0) ti | te <- texts, ti <- times]+        texts = map (getText . getStamped) existing+        times = map getTime existing++-- | given a function `f` and a list `l`, produce a list of lists of+-- elements of `l` that produce the same result when `f` is applied to+-- them+groupWith :: (Eq b, Hashable b) => (a -> b) -> [a] -> [[a]]+groupWith f = H.elems . foldr myInsert H.empty+  where myInsert a = H.insertWith (++) (f a) [a]++-- | This function groups points with the same description, which are+-- then mapped and concatenated in a flat list of points. So points+-- with the same description are considered like a single time+-- series. Order might affect the proper functioning of the drawing+-- logic, so test after changes+toTimeSeries :: ([Point] -> [Point]) -> [Point] -> [Point]+toTimeSeries onEachStream = concat+                            . map onEachStream+                            . toStreams+  where toStreams :: [Point] -> [[Point]]+        toStreams = groupWith (getText . getStamped)++-- | sort `elements` concatenating their monoid when their time falls+-- within the same interval+convertPoints :: NominalDiffTime -> [Point] -> [Point]+convertPoints interval elements = sampler sorted+  where sorted = sortOn getTime elements+        times = iterator interval (getTime (head sorted))+        sampler = consume times+        iterator :: NominalDiffTime -> UTCTime -> [UTCTime]+        iterator interval start = iterate (addUTCTime interval) start+        getText (Timestamped (TextFloat t _) _) = t+        label = getText $ head elements+        -- at every call, the recursive function returns a processed list, and+        -- it gets a non processed list and a reference date about the last+        -- emitted element. if the next element would have a date greater than+        -- the reference + the interval, a filling element is+        -- created. otherwise, the function will look ahead and merge all+        -- elements within the same interval, pick a representative date for+        -- the merged elements and use it as the new reference+        consume :: [UTCTime] -> [Point] -> [Point]+        consume (t:ts) [] = []+        consume (t:ts) elements+          | length preceding == 0 = filled : rest+          | otherwise = foldl (merge t) filled preceding : rest+          where (preceding, succeeding) = span ((<= t) . getTime) elements+                filled = toPoint (label, 0, t)+                rest = consume ts succeeding+                merge :: Monoid a => UTCTime -> Timestamped a -> Timestamped a -> Timestamped a+                merge t (Timestamped a _) (Timestamped b _) = Timestamped (mappend a b) t++streamgraph :: Int -> Maybe Int -> [(T.Text, Float, UTCTime)] -> IO ()+streamgraph days maybeLastPoints =+  custom options getDataFileName transform+  where transform = toText+                    . toTimeSeries onEachStream+                    . addAllPoints+                    . map toPoint+        -- | turn each stream into a time series and take the last n+        -- points+        onEachStream :: [Point] -> [Point]+        onEachStream = maybeLastN maybeLastPoints . convertPoints seconds+        seconds = fromIntegral (days * 60 * 60 * 24)+        maybeLastN :: Maybe Int -> [a] -> [a]+        maybeLastN Nothing  l = l+        maybeLastN (Just n) l = drop (length l - n) l++simple+  :: [(T.Text, Float, UTCTime)]+  -- ^ Input data. Labels in the Text field will be grouped so that+  -- values with the same description form a stream+  -> IO ()+simple = streamgraph 1 Nothing
+ Test.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}+import Test.Hspec+import Streamgraph+import Visie.Data (TextFloat(TextFloat), getText)++main :: IO ()+main = hspec $ do+  describe "aggregate" $ do+    let dates = [makeUni 2017 1 6,+                 makeUni 2017 1 7,+                 makeUni 2017 1 8,+                 makeUni 2017 1 9,+                 makeUni 2017 1 10,+                 makeUni 2017 1 11]+        keys = ["a", "b", "c"]+        values = [1..10]+        toAggregate = [(k, v, d) | k <- keys, v <- values, d <- dates]+        aggregate = toTimeSeries id . map toPoint+    it "first case" $ do+      (length . aggregate) toAggregate `shouldBe`+        (length keys * length dates * length values)+  describe "the monoid" $ do+    it "appends as expected" $ do+      (getText (mappend (TextFloat "a" 1) (TextFloat "a" 2))) `shouldBe` "a"+  describe "groupWith" $ do+    it "groups even numbers" $ do+      let modThree :: Int -> Int+          modThree = flip mod 3+      (groupWith modThree [1, 2, 4, 3, 6]) `shouldBe` [[3,6], [1,4], [2]]+      
+ data/script.js view
@@ -0,0 +1,180 @@+// copied from http://bl.ocks.org/WillTurman/4631136+chart("data.csv", "orange");++var datearray = [];+var colorrange = [];+var visie;++function chart(csvpath, color) {++  if (color == "blue") {+    colorrange = ["#045A8D", "#2B8CBE", "#74A9CF", "#A6BDDB", "#D0D1E6", "#F1EEF6"];+  }+  else if (color == "pink") {+    colorrange = ["#980043", "#DD1C77", "#DF65B0", "#C994C7", "#D4B9DA", "#F1EEF6"];+  }+  else if (color == "orange") {+    colorrange = ["#B30000", "#E34A33", "#FC8D59", "#FDBB84", "#FDD49E", "#FEF0D9"];+  }+  strokecolor = colorrange[0];++  var format = d3.time.format("%m/%d/%y");++  var margin = {top: 20, right: 40, bottom: 30, left: 40};+  var width = document.documentElement.clientWidth - margin.left - margin.right;+  var height = document.documentElement.clientHeight - margin.top - margin.bottom;++  var tooltip = d3.select("body")+        .append("div")+        .attr("class", "remove")+        .style("position", "absolute")+        .style("z-index", "20")+        .style("visibility", "hidden")+        .style("top", "30px")+        .style("left", "55px");++  var x = d3.time.scale()+        .range([0, width]);++  var y = d3.scale.linear()+        .range([height-10, 0]);++  var z = d3.scale.ordinal()+        .range(colorrange);++  var xAxis = d3.svg.axis()+        .scale(x)+        .orient("bottom")+        .ticks(d3.time.weeks);++  var yAxis = d3.svg.axis()+        .scale(y);++  var yAxisr = d3.svg.axis()+        .scale(y);++  var stack = d3.layout.stack()+        .offset("silhouette")+        .values(function(d) { return d.values; })+        .x(function(d) { return d.date; })+        .y(function(d) { return d.value; });++  var nest = d3.nest()+        .key(function(d) { return d.key; });++  var area = d3.svg.area()+        .interpolate("cardinal")+        .x(function(d) { return x(d.date); })+        .y0(function(d) { return y(d.y0); })+        .y1(function(d) { return y(d.y0 + d.y); });++  var svg = d3.select(".chart").append("svg")+        .attr(+          "viewBox",+          "0 0 " ++            (width + margin.left + margin.right) ++            " " ++            (height + margin.top + margin.bottom)+        )+        .append("g")+        .attr("transform", "translate(" + margin.left + "," + margin.top + ")");++  visie = function(data) {++    data.forEach(function(d) {+      d.date = format.parse(d.date);+      d.value = +d.value;+    });++    var layers = stack(nest.entries(data));++    x.domain(d3.extent(data, function(d) { return d.date; }));+    y.domain([0, d3.max(data, function(d) { return d.y0 + d.y; })]);++    svg.selectAll(".layer")+      .data(layers)+      .enter().append("path")+      .attr("class", "layer")+      .attr("d", function(d) { return area(d.values); })+      .style("fill", function(d, i) { return z(i); });+++    svg.append("g")+      .attr("class", "x axis")+      .attr("transform", "translate(0," + height + ")")+      .call(xAxis);++    svg.append("g")+      .attr("class", "y axis")+      .attr("transform", "translate(" + width + ", 0)")+      .call(yAxis.orient("right"));++    svg.append("g")+      .attr("class", "y axis")+      .call(yAxis.orient("left"));++    svg.selectAll(".layer")+      .attr("opacity", 1)+      .on("mouseover", function(d, i) {+        svg.selectAll(".layer").transition()+          .duration(250)+          .attr("opacity", function(d, j) {+            return j != i ? 0.2 : 1;+          })})++      .on("mousemove", function(d, i) {+        mousex = d3.mouse(this);+        mousex = mousex[0];+        var invertedx = x.invert(mousex);+        var dateArrayIndex = invertedx.getMonth() + invertedx.getDate();+        var selected = (d.values);+        for (var k = 0; k < selected.length; k++) {+          datearray[k] = selected[k].date+          datearray[k] = datearray[k].getMonth() + datearray[k].getDate();+        }++        mousedate = datearray.indexOf(dateArrayIndex);+        pro = d.values[mousedate].value;++        d3.select(this)+          .classed("hover", true)+          .attr("stroke", strokecolor)+          .attr("stroke-width", "0.5px"), ++        tooltip+          .html( "<p>" + d.key + "<br>" + pro + "<br>" + invertedx.toDateString() + "</p>" )+          .style("visibility", "visible");+      })+      .on("mouseout", function(d, i) {+        svg.selectAll(".layer")+          .transition()+          .duration(250)+          .attr("opacity", "1");+        d3.select(this)+          .classed("hover", false)+          .attr("stroke-width", "0px"), tooltip.html( "<p>" + d.key + "<br>" + pro + "</p>" ).style("visibility", "hidden");+      })+    +    var vertical = d3.select(".chart")+          .append("div")+          .attr("class", "remove")+          .style("position", "absolute")+          .style("z-index", "19")+          .style("width", "1px")+          .style("height", "380px")+          .style("top", "10px")+          .style("bottom", "30px")+          .style("left", "0px")+          .style("background", "#fff");++    d3.select(".chart")+      .on("mousemove", function(){  +        mousex = d3.mouse(this);+        mousex = mousex[0] + 5;+        vertical.style("left", mousex + "px" )})+      .on("mouseover", function(){  +        mousex = d3.mouse(this);+        mousex = mousex[0] + 5;+        vertical.style("left", mousex + "px")});+  };+}
+ data/style.css view
@@ -0,0 +1,25 @@+body {+  font: 10px sans-serif;+}++.chart { +  background: #fff;+}++p {+  font: 12px helvetica;+}+++.axis path, .axis line {+  fill: none;+  stroke: #000;+  stroke-width: 2px;+  shape-rendering: crispEdges;+}++button {+  position: absolute;+  right: 50px;+  top: 10px;+}
+ streamgraph-browser-test.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}+import Streamgraph+import Data.Monoid ((<>))++d = [("a", 10, makeUni 2017 1 1),+     ("b", 5, makeUni 2017 1 1),+     ("c", 30, makeUni 2017 1 1),+     ("a", 10, makeUni 2017 1 2),+     ("b", 10, makeUni 2017 1 2),+     ("c", 15, makeUni 2017 1 2),+     ("a", 10, makeUni 2017 1 3),+     ("b", 15, makeUni 2017 1 3),+     ("c", 20, makeUni 2017 1 3)]++main = simple d
+ streamgraph.cabal view
@@ -0,0 +1,69 @@+-- Initial streamgraph.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                streamgraph+version:             0.5.1.0+synopsis:            generate a streamgraph from haskell on the command line+description:         Use Streamgraph.simple to generate a streamgraph from+                     its data. Run `streamgraph-browser-test` for an example+license:             PublicDomain+license-file:        LICENSE+author:              danse+maintainer:          f.occhipinti@gmail.com+-- copyright:           +category:            Visualisation+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++data-files: data/style.css,+            data/script.js++source-repository head+  type: git+  location: https://github.com/danse/streamgraph++library+  exposed-modules:     Streamgraph+  other-modules:       Paths_streamgraph   +  build-depends:       aeson >= 2.3.0 && < 2.4,+                       base >= 4.19.2 && < 4.20,+                       hashable >= 1.5.1 && < 1.6,+                       text >= 2.1.1 && < 2.2,+                       scientific >= 0.3.8 && < 0.4,+                       unordered-containers >= 0.2.21 && < 0.3,+                       vector >= 0.13.2 && < 0.14,+                       time >= 1.12.2 && < 1.13,+                       semigroups >= 0.20.1 && < 0.21,+                       visie >= 0.6.2 && < 0.7+  -- hs-source-dirs:      +  default-language:    Haskell2010++executable streamgraph-browser-test+           main-is: streamgraph-browser-test.hs+           build-depends: aeson >= 2.3.0 && < 2.4,+                          base >= 4.19.2 && < 4.20,+                          hashable >= 1.5.1 && < 1.6,+                          text >= 2.1.1 && < 2.2,+                          scientific >= 0.3.8 && < 0.4,+                          unordered-containers >= 0.2.21 && < 0.3,+                          vector >= 0.13.2 && < 0.14,+                          time >= 1.12.2 && < 1.13,+                          semigroups >= 0.20.1 && < 0.21,+                          visie >= 0.6.2 && < 0.7+           default-language:    Haskell2010++Test-Suite test+           type: exitcode-stdio-1.0+           main-is: Test.hs+           build-depends: base >= 4.19.2 && < 4.20,+                          visie,+                          aeson,+                          time,+                          vector,+                          unordered-containers,+                          text,+                          scientific,+                          hashable,+                          hspec+           default-language:    Haskell2010