[PATCH] GNUPlot bindings - histograms

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  <[hidden email]>
 
+ * 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  <[hidden email]>
+
  * 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'>

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk