[Help-smalltalk] [PATCH] GNUPlot bindings - histograms

[Paolo Bonzini]

I added support for histograms to the GNUPlot bindings (it's the only 
part of gst that I get to use at work so...).  It's not done using 
gnuplot's histograms, because it doesn't really map well to an 
object-oriented interface.

Stacked bars only work if the data for all the bars comes from the same 
data source.  It's going into 3.0.2 too.

Paolo

diff --git a/packages/gnuplot/2D.st b/packages/gnuplot/2D.st
index 4ad0a0b..6b1db28 100644
--- a/packages/gnuplot/2D.st
+++ b/packages/gnuplot/2D.st
@@ -33,7 +33,7 @@ GPAbstractPlot subclass: GPPlot [
     <category: 'GNUPlot'>
     <comment: 'My instance is used to define a single ''plot'' command.'>
 
-    | xAxis x2Axis yAxis y2Axis |
+    | xAxis x2Axis yAxis y2Axis barWidth barGap |
 
     GPPlot class >> defaultStyleClass [
         ^GPPlotStyle 
@@ -88,6 +88,38 @@ GPAbstractPlot subclass: GPPlot [
        y2Axis := aGPAxis
     ]
 
+    barGap [
+       <category: 'accessing'>
+       ^barGap
+    ]
+
+    barGap: anInteger [
+       <category: 'accessing'>
+       barGap := anInteger
+    ]
+
+    barWidth [
+       <category: 'accessing'>
+       barWidth isNil ifTrue: [ barWidth := 1 ].
+       ^barWidth
+    ]
+
+    barWidth: aNumber [
+       <category: 'accessing'>
+       barWidth := aNumber
+    ]
+
+    newGroup: anInteger of: maxGroup [
+       <category: 'private'>
+       | gap |
+       gap := (self barGap ifNil: [ #(##(1/2) 1) at: maxGroup ifAbsent: [2] ])
+         - (1 - self barWidth).
+       ^(super newGroup: anInteger of: maxGroup)
+           barOffset: (2 * anInteger - 1 - maxGroup) / 2 / (maxGroup + gap);
+           barWidth: self barWidth / (maxGroup + gap);
+           yourself
+    ]
+
     function: exprBlock [
        <category: 'building'>
        | expr |
@@ -232,6 +264,19 @@ GPAbstractPlot subclass: GPPlot [
        ^series
     ]
 
+    bars: aDataSourceOrArray [
+       <category: 'building'>
+       ^self add: (GPBarSeries on: aDataSourceOrArray)
+    ]
+
+    bars: aDataSourceOrArray with: aBlock [
+       <category: 'building'>
+       | series |
+       series := self bars: aDataSourceOrArray.
+       aBlock value: series.
+       ^series
+    ]
+
     boxes: aDataSourceOrArray [
        <category: 'building'>
        ^self add: ((GPBoxSeries on: aDataSourceOrArray)
@@ -380,6 +425,75 @@ GPStyle subclass: GPPlotStyle [
 
 ]
 
+GPGroupSeries subclass: GPBarSeries [
+    <category: 'GNUPlot'>
+    <comment: 'My instance is used to define a data series for an histogram.'>
+
+    defaultColumns [
+       ^{ GPColumnRef column: 1 }
+    ]
+
+    data [
+       ^self columns first
+    ]
+
+    data: expr [
+       self columns: { expr asGPExpression }
+    ]
+
+    displayOn: aStream group: aGroup [
+        self dataSource displayOn: aStream.
+        aStream nextPutAll: ' using '.
+        self displayColumnsOn: aStream group: aGroup.
+        self displayStyleOn: aStream group: aGroup.
+       aGroup stackData: self data.
+        self displayTicLabelsOn: aStream group: aGroup.
+    ]
+
+    displayColumnsOn: aStream group: aGroup [
+       aStream nextPutAll: '($0'.
+       aGroup barOffset < 0 ifFalse: [ aStream nextPut: $+ ].
+       aStream print: aGroup barOffset asFloat.
+       aStream nextPutAll: '):'.
+       aGroup dataOffset isNil
+           ifTrue: [
+               aStream display: self data.
+               aStream nextPutAll: ':('.
+               aStream display: aGroup barWidth asFloat.
+               aStream nextPut: $) ]
+           ifFalse: [
+               aStream display: aGroup dataOffset + (self data / 2).
+               aStream nextPutAll: ':('.
+               aStream display: (aGroup barWidth / 2) asFloat.
+               aStream nextPutAll: '):'.
+               aStream display: self data / 2 ].
+    ]
+
+    displayStyleOn: aStream group: aGroup [
+       aGroup dataOffset isNil
+           ifTrue: [ aStream nextPutAll: ' with boxes' ]
+           ifFalse: [ aStream nextPutAll: ' with boxxyerrorbars' ].
+       super displayStyleOn: aStream group: aGroup
+    ]
+
+    displayTicLabelsOn: aStream group: aGroup [
+       ticColumns isNil ifFalse: [
+           aStream nextPutAll: ', '.
+           self dataSource displayOn: aStream.
+           aStream nextPutAll: ' using 0:'.
+           aStream display: aGroup dataOffset.
+           aStream nextPutAll: ':""'.
+           super displayTicLabelsOn: aStream group: aGroup.
+           aStream nextPutAll: ' notitle with labels'.
+       ]
+    ]
+
+    printDataOn: aStream [
+       super printDataOn: aStream.
+       ticColumns isNil ifFalse: [ super printDataOn: aStream ].
+    ]
+]
+
 GPDataSeries subclass: GPXYSeries [
     <category: 'GNUPlot'>
     <comment: 'My instance is used to define a data series for (x,y) values.'>
diff --git a/packages/gnuplot/Base.st b/packages/gnuplot/Base.st
index c069db2..0aaabfa 100644
--- a/packages/gnuplot/Base.st
+++ b/packages/gnuplot/Base.st
@@ -464,12 +464,49 @@ GPContainer subclass: GPAbstractPlot [
         series do: [:d | d displayPrologOn: aStream into: defs ].
     ]
 
+    groupedSeries [
+       "Assign groups to series that do not have one, and return a
+        Dictionary of OrderedCollections, holding the series according
+        to their #group."
+       <category: 'private'>
+
+       | groupedSeries maxGroup |
+       maxGroup := series inject: 0 into: [ :old :each |
+           each group = 0 ifTrue: [ each group: old + 1 ].
+           each group ].
+
+       groupedSeries := LookupTable new.
+       series do: [:d |
+           (groupedSeries
+               at: (self newGroup: d group of: maxGroup)
+               ifAbsentPut: [ OrderedCollection new ])
+                   add: d ].
+
+       ^groupedSeries
+    ]
+
+    newGroup: anInteger of: maxGroup [
+       <category: 'private - factory'>
+       ^GPSeriesGroup new
+           id: anInteger;
+           yourself
+    ]
+
     displaySeriesOn: aStream [
         <category: 'printing'>
-        series do: [:d | d displayOn: aStream]
-            separatedBy: [aStream nextPutAll: ', '].
+       | groupedSeries first |
+       groupedSeries := self groupedSeries.
+       first := true.
+       groupedSeries
+           keysAndValuesDo: [:group :list |
+               list do: [:d |
+                   first ifFalse: [aStream nextPutAll: ', '].
+                   first := false.
+                   d displayOn: aStream group: group]].
+
         aStream nl.
-        series do: [:d | d printDataOn: aStream]
+       groupedSeries do: [:list |
+           list do: [:d | d printDataOn: aStream]]
     ]
 
     displayOn: aStream [
diff --git a/packages/gnuplot/ChangeLog b/packages/gnuplot/ChangeLog
index 9d21328..e9cc2d2 100644
--- a/packages/gnuplot/ChangeLog
+++ b/packages/gnuplot/ChangeLog
@@ -1,5 +1,14 @@
 2008-03-04  Paolo Bonzini  <address@hidden>
 
+       * 2D.st: Add #barGap, #barWidth, #bars:, GPBarSeries.
+       * Base.st: Fix some things in the design of grouped series.
+       * Examples.st: Add bar graph example.
+       * Series.st: Implement GPSeriesGroup.  Use template method
+       pattern for GPSeries>>#displayOn:group: and
+       GPDataSeries>>#displayOn:group:.
+
+2008-03-04  Paolo Bonzini  <address@hidden>
+
        * Series.st: Add special ticSpacing value of 0 to suppress tics.
        Add GPAxis>>#from: and GPAxis>>#to:
 
diff --git a/packages/gnuplot/Examples.st b/packages/gnuplot/Examples.st
index 0e120b2..5f81971 100644
--- a/packages/gnuplot/Examples.st
+++ b/packages/gnuplot/Examples.st
@@ -182,4 +182,57 @@ GPObject subclass: GNUPlotExamples [
        Transcript display: p; nl.
        p execute
     ]
+
+    GNUPlotExamples class >> bars [
+       ^self barsOn: nil
+    ]
+
+    GNUPlotExamples class >> barsOn: file [
+       | p plot data |
+       p := GNUPlot new.
+       file isNil ifFalse: [
+           p terminal: self newPngTerminal.
+           p output: file ].
+
+       data := #((1 2 'a') (2 3 'b') (3 4 'c') (4 5 'd') (5 6 'e')).
+
+       (plot := GPPlot new)
+           bars: data
+           with: [:series |
+               series style fillStyle: #solid.
+               series data: (GPColumnRef column: 1) ];
+
+           bars: data
+           with: [:series |
+               series style fillStyle: #solid.
+               series data: (GPColumnRef column: 2); xTicColumn: 3 ].
+
+       plot xAxis ticSpacing: 0.
+       plot xAxis from: -0.5 to: 4.5.
+       plot yAxis from: 0.
+       p add: plot.
+
+       data := #((1 1 'a') (2 1 'b') (3 1 'c') (4 1 'd') (5 1 'e')).
+
+       (plot := GPPlot new)
+           bars: data
+           with: [:series |
+               series style fillStyle: #solid.
+               series group: 1.
+               series data: (GPColumnRef column: 1) ];
+
+           bars: data
+           with: [:series |
+               series style fillStyle: #solid.
+               series group: 1.
+               series data: (GPColumnRef column: 2); xTicColumn: 3 ].
+
+       plot xAxis ticSpacing: 0.
+       plot xAxis from: -0.5 to: 4.5.
+       plot yAxis from: 0.
+
+       p add: plot.
+       Transcript display: p; nl.
+       p execute
+    ]
 ]
diff --git a/packages/gnuplot/Series.st b/packages/gnuplot/Series.st
index 8af98f0..270e725 100644
--- a/packages/gnuplot/Series.st
+++ b/packages/gnuplot/Series.st
@@ -163,6 +163,68 @@ function or data set.'>
     ]
 ]
 
+Object subclass: GPSeriesGroup [
+    <category: 'GNUPlot'>
+    <comment: 'I am used internally to track the series that have already
+been plotted in a group.'>
+
+    | id barWidth barOffset dataOffset |
+    = anObject [
+       <category: 'basic'>
+       ^self class == anObject class and: [ self id = anObject id ]
+    ]
+
+    hash [
+       <category: 'basic'>
+       ^id hash
+    ]
+
+    id [
+       <category: 'accessing'>
+       id isNil ifTrue: [ id := 0 ].
+       ^id
+    ]
+
+    id: anInteger [
+       <category: 'accessing'>
+       id := anInteger
+    ]
+
+    barWidth [
+       <category: 'accessing'>
+       barWidth isNil ifTrue: [ barWidth := 0.5 ].
+       ^barWidth
+    ]
+
+    barWidth: aNumber [
+       <category: 'accessing'>
+       barWidth := aNumber
+    ]
+
+    barOffset [
+       <category: 'accessing'>
+       barOffset isNil ifTrue: [ barOffset := 0 ].
+       ^barOffset
+    ]
+
+    barOffset: aNumber [
+       <category: 'accessing'>
+       barOffset := aNumber
+    ]
+
+    dataOffset [
+       <category: 'accessing'>
+       ^dataOffset
+    ]
+
+    stackData: aColumn [
+       <category: 'accessing'>
+       dataOffset := dataOffset isNil
+           ifTrue: [ aColumn ]
+           ifFalse: [ dataOffset + aColumn ]
+    ]
+]
+
 GPContainer subclass: GPSeries [
     <category: 'GNUPlot'>
     <comment: 'My instances are used to define a plotted function or data 
set.'>
@@ -171,14 +233,25 @@ GPContainer subclass: GPSeries [
        ^GPSeriesStyle
     ]
 
+    addTo: aGPPlot [
+       <category: 'private - double dispatch'>
+       aGPPlot addSeries: self
+    ]
+
     defaultTitle [
        <category: 'dwim'>
        self subclassResponsibility
     ]
 
-    addTo: aGPPlot [
-       <category: 'private - double dispatch'>
-       aGPPlot addSeries: self
+    group [
+       <category: 'accessing'>
+       ^0
+    ]
+
+    group: anInteger [
+       <category: 'accessing'>
+       "Do nothing.  Grouping would not affect the way most data
+        series are drawn."
     ]
 
     printDataOn: aStream [
@@ -187,6 +260,17 @@ GPContainer subclass: GPSeries [
 
     displayOn: aStream [
        <category: 'printing'>
+       | group |
+       group := GPSeriesGroup new id: self group; yourself.
+       self displayOn: aStream group: group.
+    ]
+
+    displayOn: aStream group: aGroup [
+       <category: 'printing'>
+       self displayStyleOn: aStream group: aGroup
+    ]
+
+    displayStyleOn: aStream group: aGroup [
        | theParameters |
        theParameters := style ifNil: [ self class defaultStyle ].
        theParameters displayOn: aStream for: self
@@ -248,7 +332,7 @@ GPSeries subclass: GPFunctionSeries [
        ^range ifNotNil: [ :r | r second ]
     ]
 
-    displayOn: aStream [
+    displayOn: aStream group: aGroup [
         <category: 'printing'>
        range isNil ifFalse: [
            aStream
@@ -259,7 +343,7 @@ GPSeries subclass: GPFunctionSeries [
                nextPut: $];
                space ].
        expression displayOn: aStream.
-       super displayOn: aStream
+       super displayOn: aStream group: aGroup
     ]
 
     displayPrologOn: aStream into: defs [
@@ -330,13 +414,27 @@ GPSeries subclass: GPDataSeries [
        graphType := aString
     ]
 
-    displayOn: aStream [
-       dataSource displayOn: aStream.
+    displayOn: aStream group: aGroup [
+       self dataSource displayOn: aStream.
        aStream nextPutAll: ' using '.
+       self displayColumnsOn: aStream group: aGroup.
+       self displayTicLabelsOn: aStream group: aGroup.
+       super displayOn: aStream group: aGroup.
+    ]
+
+    displayStyleOn: aStream group: aGroup [
+       graphType isNil ifFalse: [
+           aStream nextPutAll: ' with '; nextPutAll: graphType; space ].
+        super displayStyleOn: aStream group: aGroup
+    ]
+
+    displayColumnsOn: aStream group: aGroup [
        self columns
            do: [ :each | each displayOn: aStream ]
            separatedBy: [ aStream nextPut: $: ].
+    ]
 
+    displayTicLabelsOn: aStream group: aGroup [
        "Add xticlabels etc. fake columns."
        ticColumns isNil ifFalse: [
            ticColumns keysAndValuesDo: [ :k :v |
@@ -346,9 +444,6 @@ GPSeries subclass: GPDataSeries [
                    nextPut: $(;
                    display: v;
                    nextPut: $) ] ].
-
-       aStream nextPutAll: ' with '; nextPutAll: style; space.
-       super displayOn: aStream.
     ]
 
     printDataOn: aStream [
@@ -416,6 +511,24 @@ GPSeries subclass: GPDataSeries [
     ]"
 ]
 
+GPDataSeries subclass: GPGroupSeries [
+    <category: 'GNUPlot'>
+    <comment: 'My instances are used to define plotted data sets when
+more series can be grouped together (e.g. in stacked bars).'>
+
+    | group |
+    group [
+       <category: 'accessing'>
+       group isNil ifTrue: [ group := 0 ].
+       ^group
+    ]
+
+    group: anInteger [
+       <category: 'accessing'>
+       group := anInteger.
+    ]
+]
+
 
 GPObject subclass: GPAxis [
     <category: 'GNUPlot'>
@@ -423,7 +536,7 @@ GPObject subclass: GPAxis [
 axis.'>
 
     | name range logScale mirrorTics outwardTics ticRange ticSpacing ticFormat
-       ticSubdivision majorGrid minorGrid tics style label labelStyle |
+      ticSubdivision majorGrid minorGrid tics style label labelStyle |
 
     name: aString [
        <category: 'private - initialization'>