(* Graphs.sml --- drawing bar charts, pie charts, cumulative graphs, ... using Gdimage. For examples of use, see file testgdimage.sml. sestoft@dina.kvl.dk 1998-05-13 *) open Gdimage; (* Creating a histogram of a given size, from a list of values *) (* So far no axes or tick marks *) fun histogram (w, h) [] = raise Fail "histogram: no data" | histogram (w, h) obs = let val max = foldl Int.max 0 obs val yscale = real h / real (max + 2) val im = image (w, h) (255, 255, 255) val {blue, ...} = htmlcolors im val n = length obs val colwidth = w div n val colspace = 1 + colwidth div 8 fun loop i [] = () | loop i (x :: xr) = let val x1 = i * colwidth val y1 = h - round (yscale * real x) val x2 = x1+colwidth-colspace in fillRect im (Color blue) ((x1, y1), (x2, h)); loop (i+1) xr end in loop 0 obs; im end (* Allocate colors and return a coloration function *) fun makecolors im = let val {black, white, silver, gray, maroon, red, purple, fuchsia, green, lime, olive, yellow, navy, blue, teal, aqua} = htmlcolors im val colors = Array.fromList [red, navy, olive, aqua, black, purple, lime, blue, maroon, silver, green, yellow, teal] val firstcolor = Random.range (0, Array.length colors) (Random.newgen()) fun color i = Color (Array.sub(colors, (i + firstcolor) mod Array.length colors)) in color end fun addlegend im itemnames black color = let val (w, h) = size im val longestitem = foldl Int.max 0 (map String.size itemnames) val font = Small val (fontw, fonth) = charsize font val bh = fonth val bw = 2 * bh val sepw = bh val marginsep = 10 val legendw = bw + sepw + fontw * longestitem + marginsep val itemcount = length itemnames val itemh = (h - 2 * marginsep) div itemcount val seph = Int.min(bh, itemh - bh) val x1 = w - legendw val y0 = (h - itemcount * bh - (itemcount - 1) * seph) div 2 fun legend _ [] = () | legend i (item1 :: itemr) = let val y1 = i * (bh + seph) + y0 in fillRect im (color i) ((x1, y1), (x1+bw, y1+bh)); string im black font (x1+bw+sepw, y1) item1; legend (i+1) itemr end in legend 0 itemnames; legendw end fun piechart _ [] _ = raise Fail "piechart: no data" | piechart (wh as (w, h)) (obs as obs1 :: obsr) itemnames = let (* The image and its color table *) val im = image (w, h) (255, 255, 255) val black = color im (0, 0, 0) val color = makecolors im val legendw = addlegend im itemnames black color (* The pie-chart itself, to the left *) val sum = if List.all (fn x => x > 0.0) obs then foldl op+ 0.0 obs else raise Fail "piechart: all slices must be positive" val radscale = 2.0 * Math.pi / sum val piew = w - legendw val pieh = h val pied = Int.min(piew, pieh) - 20 val center = (piew div 2, h div 2) val angleoffset = (Math.pi + obs1 * radscale) / 2.0 fun polar r a = (#1 center + round (r * Math.cos (a - angleoffset)), #2 center + round (r * Math.sin (a - angleoffset))) fun drawradius angle = drawLine im (Color black) (center, polar (real pied / 2.0) angle) fun fillslice i angle = fill im (color i) (polar (real pied / 4.0) angle) fun loop i lastsum [] = () | loop i lastsum (x :: xr) = (drawradius ((lastsum + x) * radscale); fillslice i ((lastsum + x / 2.0) * radscale); loop (i+1) (lastsum + x) xr) in drawArc im (Color black) { c = center, wh = (pied, pied), from = 0, to = 360 }; (case obsr of [] => fillslice 0 0.0 | _ => (drawradius (obs1 * radscale); loop 1 obs1 obsr; fillslice 0 (obs1 / 2.0 * radscale))); im end (* Graphing several series of data, stacking the series on top of each other. Time is implicit. Linear interpolation. Automatically scale X and Y axis. The input is a list of data series (rows). Each data series (row) is a list of reals, and will be plotted with linear interpolation between the data points. *) fun accugraph (w, h) [] _ = raise Fail "accugraph: no data series" | accugraph (w, h) (obss as obs1 :: obsr) itemnames = let val noobs = length obs1 val _ = if noobs >= 2 then () else raise Fail "accugraph: series must have at least two obs" val _ = if List.all (fn xs => length xs = noobs) obsr then () else raise Fail "accugraph: data series of unequal length" (* The image and its color table *) val im = image (w, h) (255, 255, 255) val black = color im (0, 0, 0) val color = makecolors im (* Compute accumulated observations *) fun loop [] sum = [sum] | loop (xs :: xss) sum = sum :: loop xss (ListPair.map op+ (xs, sum)) val accumrows = loop obsr obs1 val legendw = addlegend im itemnames black color + 20 val maxsum = List.foldr Real.max 0.0 (List.last accumrows) val lastsum = List.last (List.last accumrows) val xoffset = 10 (* from left *) val grfw = w - legendw - 2 * xoffset (* The height will be at most 2/3 of the width: *) val grfh = Int.min(h - 2 * xoffset, grfw * 2 div 3) val yoffset = (h + grfh) div 2 (* from top *) val xscale = real grfw / real (noobs - 1) val yscale = real grfh / (maxsum + 2.0) fun pos i y = (round (real i * xscale) + xoffset, yoffset - round (y * yscale)) fun drawobs i last [] = () | drawobs i last (obs1 :: obsr) = (drawLine im (Color black) (pos i last, pos (i+1) obs1); drawobs (i+1) obs1 obsr) fun drawseries (obs1 :: obsr) = drawobs 0 obs1 obsr; fun fillsection ser last [] = () | fillsection ser last ((_ :: obs12 :: _) :: obsr) = (fill im (color ser) (pos 1 ((last+obs12) / 2.0)); fillsection (ser-1) obs12 obsr) fun uparrowhead (xy as (x, y)) = (drawLine im (Color black) (xy, (x-3, y+4)); drawLine im (Color black) (xy, (x+3, y+4))) fun rightarrowhead (xy as (x, y)) = (drawLine im (Color black) (xy, (x-4, y-3)); drawLine im (Color black) (xy, (x-4, y+3))) in (* Y axis, left *) drawLine im (Color black) ((xoffset, yoffset-grfh-5), (xoffset, yoffset+5)); uparrowhead (xoffset, yoffset-grfh-5); (* Y axis, left *) drawLine im (Color black) ((xoffset+grfw, yoffset - round (lastsum * yscale)), (xoffset+grfw, yoffset)); (* X axis *) drawLine im (Color black) ((xoffset-5, yoffset), (xoffset+grfw+10, yoffset)); rightarrowhead (xoffset+grfw+10, yoffset); List.app drawseries accumrows; fillsection (length obss - 1) 0.0 accumrows; im end
(* Graphs.sml --- drawing bar charts, pie charts, cumulative graphs, ...
using Gdimage. For examples of use, see file testgdimage.sml.
sestoft@dina.kvl.dk 1998-05-13
*)
open Gdimage;
(* Creating a histogram of a given size, from a list of values *)
(* So far no axes or tick marks *)
fun histogram (w, h) [] = raise Fail "histogram: no data"
| histogram (w, h) obs =
let val max = foldl Int.max 0 obs
val yscale = real h / real (max + 2)
val im = image (w, h) (255, 255, 255)
val {blue, ...} = htmlcolors im
val n = length obs
val colwidth = w div n
val colspace = 1 + colwidth div 8
fun loop i [] = ()
| loop i (x :: xr) =
let val x1 = i * colwidth
val y1 = h - round (yscale * real x)
val x2 = x1+colwidth-colspace
in
fillRect im (Color blue) ((x1, y1), (x2, h));
loop (i+1) xr
end
in loop 0 obs; im end
(* Allocate colors and return a coloration function *)
fun makecolors im =
let val {black, white, silver, gray, maroon, red, purple, fuchsia,
green, lime, olive, yellow, navy, blue, teal, aqua} =
htmlcolors im
val colors = Array.fromList [red, navy, olive, aqua, black, purple,
lime, blue, maroon, silver, green,
yellow, teal]
val firstcolor =
Random.range (0, Array.length colors) (Random.newgen())
fun color i =
Color (Array.sub(colors, (i + firstcolor) mod Array.length colors))
in color end
fun addlegend im itemnames black color =
let val (w, h) = size im
val longestitem = foldl Int.max 0 (map String.size itemnames)
val font = Small
val (fontw, fonth) = charsize font
val bh = fonth
val bw = 2 * bh
val sepw = bh
val marginsep = 10
val legendw = bw + sepw + fontw * longestitem + marginsep
val itemcount = length itemnames
val itemh = (h - 2 * marginsep) div itemcount
val seph = Int.min(bh, itemh - bh)
val x1 = w - legendw
val y0 = (h - itemcount * bh - (itemcount - 1) * seph) div 2
fun legend _ [] = ()
| legend i (item1 :: itemr) =
let val y1 = i * (bh + seph) + y0
in
fillRect im (color i) ((x1, y1), (x1+bw, y1+bh));
string im black font (x1+bw+sepw, y1) item1;
legend (i+1) itemr
end
in legend 0 itemnames; legendw end
fun piechart _ [] _ = raise Fail "piechart: no data"
| piechart (wh as (w, h)) (obs as obs1 :: obsr) itemnames =
let (* The image and its color table *)
val im = image (w, h) (255, 255, 255)
val black = color im (0, 0, 0)
val color = makecolors im
val legendw = addlegend im itemnames black color
(* The pie-chart itself, to the left *)
val sum = if List.all (fn x => x > 0.0) obs then foldl op+ 0.0 obs
else raise Fail "piechart: all slices must be positive"
val radscale = 2.0 * Math.pi / sum
val piew = w - legendw
val pieh = h
val pied = Int.min(piew, pieh) - 20
val center = (piew div 2, h div 2)
val angleoffset = (Math.pi + obs1 * radscale) / 2.0
fun polar r a = (#1 center + round (r * Math.cos (a - angleoffset)),
#2 center + round (r * Math.sin (a - angleoffset)))
fun drawradius angle =
drawLine im (Color black) (center, polar (real pied / 2.0) angle)
fun fillslice i angle =
fill im (color i) (polar (real pied / 4.0) angle)
fun loop i lastsum [] = ()
| loop i lastsum (x :: xr) =
(drawradius ((lastsum + x) * radscale);
fillslice i ((lastsum + x / 2.0) * radscale);
loop (i+1) (lastsum + x) xr)
in
drawArc im (Color black) { c = center, wh = (pied, pied),
from = 0, to = 360 };
(case obsr of
[] => fillslice 0 0.0
| _ => (drawradius (obs1 * radscale);
loop 1 obs1 obsr;
fillslice 0 (obs1 / 2.0 * radscale)));
im
end
(* Graphing several series of data, stacking the series on top of each
other. Time is implicit. Linear interpolation. Automatically
scale X and Y axis.
The input is a list of data series (rows). Each data series (row)
is a list of reals, and will be plotted with linear interpolation
between the data points.
*)
fun accugraph (w, h) [] _ = raise Fail "accugraph: no data series"
| accugraph (w, h) (obss as obs1 :: obsr) itemnames =
let val noobs = length obs1
val _ = if noobs >= 2 then ()
else raise Fail "accugraph: series must have at least two obs"
val _ = if List.all (fn xs => length xs = noobs) obsr then ()
else raise Fail "accugraph: data series of unequal length"
(* The image and its color table *)
val im = image (w, h) (255, 255, 255)
val black = color im (0, 0, 0)
val color = makecolors im
(* Compute accumulated observations *)
fun loop [] sum = [sum]
| loop (xs :: xss) sum =
sum :: loop xss (ListPair.map op+ (xs, sum))
val accumrows = loop obsr obs1
val legendw = addlegend im itemnames black color + 20
val maxsum = List.foldr Real.max 0.0 (List.last accumrows)
val lastsum = List.last (List.last accumrows)
val xoffset = 10 (* from left *)
val grfw = w - legendw - 2 * xoffset
(* The height will be at most 2/3 of the width: *)
val grfh = Int.min(h - 2 * xoffset, grfw * 2 div 3)
val yoffset = (h + grfh) div 2 (* from top *)
val xscale = real grfw / real (noobs - 1)
val yscale = real grfh / (maxsum + 2.0)
fun pos i y = (round (real i * xscale) + xoffset,
yoffset - round (y * yscale))
fun drawobs i last [] = ()
| drawobs i last (obs1 :: obsr) =
(drawLine im (Color black) (pos i last, pos (i+1) obs1);
drawobs (i+1) obs1 obsr)
fun drawseries (obs1 :: obsr) = drawobs 0 obs1 obsr;
fun fillsection ser last [] = ()
| fillsection ser last ((_ :: obs12 :: _) :: obsr) =
(fill im (color ser) (pos 1 ((last+obs12) / 2.0));
fillsection (ser-1) obs12 obsr)
fun uparrowhead (xy as (x, y)) =
(drawLine im (Color black) (xy, (x-3, y+4));
drawLine im (Color black) (xy, (x+3, y+4)))
fun rightarrowhead (xy as (x, y)) =
(drawLine im (Color black) (xy, (x-4, y-3));
drawLine im (Color black) (xy, (x-4, y+3)))
in
(* Y axis, left *)
drawLine im (Color black) ((xoffset, yoffset-grfh-5),
(xoffset, yoffset+5));
uparrowhead (xoffset, yoffset-grfh-5);
(* Y axis, left *)
drawLine im (Color black) ((xoffset+grfw,
yoffset - round (lastsum * yscale)),
(xoffset+grfw, yoffset));
(* X axis *)
drawLine im (Color black) ((xoffset-5, yoffset),
(xoffset+grfw+10, yoffset));
rightarrowhead (xoffset+grfw+10, yoffset);
List.app drawseries accumrows;
fillsection (length obss - 1) 0.0 accumrows;
im
end