From VisualWorks® NonCommercial, 7.3 of December 3, 2004 on March 15, 2006 at 4:29:01 am HistogramsInterface CormasNS.Kernel UI.ApplicationModel false none data cormasModel histoList classesLegend nbClasses selectedHisto classes selectedClass CormasKernel-Interface cormas CormasNS.Kernel.HistogramsInterface class interface specs classesSettings "Tools.UIPainter new openOnClass: self andSelector: #classesSettings" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Classes setting' #min: #(#{Core.Point} 268 250 ) #max: #(#{Core.Point} 268 1000 ) #bounds: #(#{Graphics.Rectangle} 640 512 908 919 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.LabelSpec} #layout: #(#{Core.Point} 12 5 ) #name: #title #label: 'Set new classes for:' #style: #default ) #(#{UI.DataSetSpec} #properties: #(#{UI.PropertyListDictionary} #showHorizontalLines true #allowColumnResizing true #showVerticalLines true #allowColumnReordering false ) #layout: #(#{Graphics.LayoutFrame} 11 0 74 0 251 0 0 0.82 ) #name: #classesDataSet #flags: 13 #model: #classes #columns: #( #(#{UI.DataSetColumnSpec} #properties: #(#{UI.PropertyListDictionary} #allowSorting true ) #model: #'selectedClass x' #label: 'Low value (included)' #labelIsImage: false #width: 110 #editorType: #InputField #noScroll: false ) #(#{UI.DataSetColumnSpec} #properties: #(#{UI.PropertyListDictionary} #allowSorting true ) #model: #'selectedClass y' #label: 'High value (excluded)' #labelIsImage: false #width: 110 #editorType: #InputField #noScroll: false ) ) ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 11 45 96 68 ) #name: #addClass #model: #addClass #label: 'Add Class' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutSizedOrigin} 29 0 0 0.89 70 30 ) #name: #apply #model: #setNewHistoClasses #label: 'Apply' #defaultable: true ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.LayoutSizedOrigin} 116 0 0 0.89 100 30 ) #name: #applyAndClose #model: #setNewHistoClassesAndClose #label: 'Apply and Close' #defaultable: true ) #(#{UI.DividerSpec} #layout: #(#{Graphics.LayoutSizedOrigin} 5 0 31 0 250 4 ) #name: #Divider3 ) #(#{UI.DividerSpec} #layout: #(#{Graphics.LayoutSizedOrigin} 6 0 3 0.85 250 4 ) #name: #Divider2 ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutSizedOrigin} 131 0 10 0 120 16 ) #name: #nameOfHisto #flags: 0 #colors: #(#{UI.LookPreferences} #setForegroundColor: #(#{Graphics.ColorValue} #blue ) ) #model: #selectedHisto #tabable: false #isReadOnly: true #type: #string ) ) ) ) windowSpec "Tools.UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#{UI.FullSpec} #window: #(#{UI.WindowSpec} #label: 'Histograms' #min: #(#{Core.Point} 20 20 ) #max: #(#{Core.Point} 0 0 ) #bounds: #(#{Graphics.Rectangle} 640 512 1235 840 ) ) #component: #(#{UI.SpecCollection} #collection: #( #(#{UI.ChartViewSpec} #layout: #(#{Graphics.LayoutFrame} 152 0 20 0 0 0.95 0 0.9 ) #name: #Chart1 #model: #data #xAxis: #(#{UI.ChartingAxisSpec} #tickPosition: #tickOutside #sectionMarkAt: #none ) ) #(#{UI.LabelSpec} #layout: #(#{Core.Point} 12 52 ) #name: #Label1 #label: 'Histogram list' ) #(#{UI.InputFieldSpec} #layout: #(#{Graphics.LayoutFrame} 170 0 0 0.86 0 0.95 0 0.92 ) #name: #InputField1 #flags: 0 #model: #classesLegend #tabable: false #alignment: #center #isReadOnly: true #type: #string ) #(#{UI.SequenceViewSpec} #layout: #(#{Graphics.Rectangle} 10 79 132 220 ) #name: #List1 #model: #histoList #callbacksSpec: #(#{UI.UIEventCallbackSubSpec} #valueChangeSelector: #setNewHistoData ) #useModifierKeys: true #selectionType: #highlight ) #(#{UI.ActionButtonSpec} #layout: #(#{Graphics.Rectangle} 16 252 133 280 ) #name: #ActionButton1 #model: #openClassesSettingWindow #label: 'Change chart classes' #defaultable: true ) ) ) ) CormasNS.Kernel.HistogramsInterface class initialize-release newWith: aModel | a | a := self new. a cormasModel: aModel. a init CormasNS.Kernel.HistogramsInterface This class provides an interface that links to a Cormas model (http://cormas.cirad.fr) to allow ploting histograms which bars' heights correspond to the number of occurrence in each class (classes being for example people from age 10 to 20, then from age 20 to 30 etc…). To use this HistogramsInterface Class proceed as so: - in the init method of your Cormas model write the following line “HistogramsInterface newWith: self” (the line can be placed anywhere in your init method) *** from now on, a new interface, the “histograms interface” will open each time you init your model *** - in your Cormas model class, create a new protocol named “histograms” ***in this protocol you can now add as many histograms definition you want*** - the syntax of a method defining a new histogram is as so: - it should return an Array instance composed of 2 OrderedCollection (or one OrderedCollection and one Array) - the first value of this Array is the collection of quantitative values you want to plot in the histograms (e.g. a collection of age of an agents population) - the second value of this Array is the classes to which you want to plot your data (e.g. to define the 3 following classes 0 to 30; 30 to 60 and 60 to 90, the value to be sent is #(0 30 90 100). ) ***note that 2 additional classes will be created: one for all values less than your lowest class; and a second for all values higher than your highest class**** _______________________________ creation date: 14-03-06 by: Nicolas Becu email: becu@uni-hohenheim.de CormasNS.Kernel.HistogramsInterface aspects classes ^classes isNil ifTrue: [classes := SelectionInList new. classes selectionIndexHolder compute: [:v | self selectedClass value: classes selection]. classes] ifFalse: [classes] classesLegend ^classesLegend isNil ifTrue: [classesLegend := String new asValue] ifFalse: [classesLegend] data ^data isNil ifTrue: [data := List new asValue] ifFalse: [data] histoList ^histoList isNil ifTrue: [histoList := SelectionInList new] ifFalse: [histoList] selectedClass ^selectedClass isNil ifTrue: [selectedClass := nil asValue] ifFalse: [selectedClass] selectedHisto ^selectedHisto isNil ifTrue: [selectedHisto := self histoList selection asText asValue] ifFalse: [selectedHisto] CormasNS.Kernel.HistogramsInterface accessing cormasModel: aModel cormasModel := aModel CormasNS.Kernel.HistogramsInterface initialize-release init self histoList list: (cormasModel class organization listAtCategoryNamed: #histograms) asSortedCollection asList. self open CormasNS.Kernel.HistogramsInterface actions addClass (classes list) add: (Point x: (classes list last y) y: ((classes list last y) asNumber +1) printString) . openClassesSettingWindow | aList | self histoList selection isNil ifTrue: [Dialog warn: 'You need to select an histogram in the list first'] ifFalse: [aList := List new. aList add: (Point x:'0' y: '0'). self classes list: aList. self openInterface: #classesSettings] setNewHistoClasses | builtClasses | 1 to: self classes list size - 1 do: [:i | (self classes list at: i) y ~= (self classes list at: i + 1) x ifTrue: [^Dialog warn: 'High value of class ''n'', must be equal to the low value of class ''n+1'' ']]. builtClasses := OrderedCollection new. builtClasses add: (classes list first x asNumber). classes list do: [:c | builtClasses add: ((c y) asNumber)]. self setHistoDataWithClasses: builtClasses setNewHistoClassesAndClose self setNewHistoClasses. self closeAndUnschedule setNewHistoData self histoList selection isNil ifTrue: [self data value: List new. self classesLegend value: ''] ifFalse: [self setHistoDataWithClasses: (cormasModel perform: self histoList selection) last.] CormasNS.Kernel.HistogramsInterface procedures histogramOf: indiData withClasses: classes | dataSet temp | dataSet := OrderedCollection new. classes do:[:v| temp := indiData select:[:i| i < v]. dataSet add: temp size. indiData removeAll: temp]. dataSet add: indiData size. ^dataSet setHistoDataWithClasses: defaultClasses | text | self data value: (self histogramOf: (cormasModel perform: self histoList selection) first withClasses: defaultClasses asList). text := '[min;'. defaultClasses do: [:c | text := text , c printString , '[ [' , c printString , ';']. text := text , 'max]'. self classesLegend value: text