DIRECTORY BiAxials, BiScrollers, Commander, CommandTool, Convert, FS, Geom2D, Histograms, HistogramsExtras, HistogramsOut, HistogramsPrivate, HistogramsViewing, HistogramsViewingExtras, HistogramsViewingPrivate, Icons, Imager, ImagerBackdoor, ImagerBox, ImagerColor, ImagerFont, ImagerTransformation, IO, LinearSystem, MessageWindow, MJSContainers, PopUpButtons, Process, Real, RealFns, Rope, Rules, SimpleFeedback, StructuredStreams, TIPUser, UnparserBuffer, Vector2, VFonts, ViewerClasses, ViewerForkers, ViewerOps, ViewerSpecs, ViewerTools; HistogramsViewingImpl: CEDAR MONITOR LOCKS h USING h: Histogram IMPORTS BiAxials, BiScrollers, Commander, CommandTool, Convert, FS, Geom2D, Histograms, HistogramsExtras, HistogramsPrivate, Icons, Imager, ImagerBackdoor, ImagerBox, ImagerColor, ImagerFont, ImagerTransformation, IO, LinearSystem, MessageWindow, MJSContainers, PopUpButtons, Process, Real, RealFns, Rope, Rules, SimpleFeedback, StructuredStreams, TIPUser, UnparserBuffer, Vector2, VFonts, ViewerForkers, ViewerOps, ViewerSpecs, ViewerTools EXPORTS Histograms, HistogramsOut, HistogramsViewing, HistogramsViewingExtras = BEGIN OPEN BA:BiAxials, BS:BiScrollers, IT:ImagerTransformation, PUB:PopUpButtons, SS:StructuredStreams, UB:UnparserBuffer, VF:VFonts, VFk:ViewerForkers, VO:ViewerOps, Histograms, HistogramsOut, HistogramsPrivate, HistogramsViewingPrivate; Font: TYPE ~ ImagerFont.Font; Box: TYPE ~ Imager.Box; Histogram: TYPE = REF HistogramRep; HistogramRep: PUBLIC TYPE = HistogramsPrivate.HistogramRep; TweakResult: TYPE ~ RECORD [msg: ROPE _ NIL, paint: BOOL _ FALSE]; screenFont: Font _ VF.defaultFont; printFont: Font _ VF.defaultFont; digWid: REAL _ 0.0; fontHeight: INTEGER _ 0; containerFlavor: ATOM = $VanillaMJSContainer; bsStyle: BS.BiScrollerStyle ~ BS.GetStyle[]; histogramViewer: BA.Class ~ BA.CreateClass[bsStyle, [ flavor: $Histogram, extrema: Extrema, notify: Notify, paint: Paint, destroy: Destroy, tipTable: TIPUser.InstantiateNewTIPTable["Histograms.tip"], mayStretch: TRUE, vanilla: Vanilla, preserve: [0.0, 0.0] ]]; icon: Icons.IconFlavor ~ Icons.NewIconFromFile["Histograms.icons", 0]; ts: REAL _ 1; --tick radius tl: REAL _ 5; --tick length ls: REAL _ 2; --sep between tick and label axsr: REAL _ 0.5; --axis stroke radius axorg: VEC _ [-1.5, -1.5]; dHeightInitial: REAL _ 5; vFreqInitial: INTEGER _ 3; leftFudge: REAL _ 3; --because the highest label is not necessarily the widest (but it's gonna be close) polyColor: Imager.Color _ ImagerBackdoor.MakeStipple[stipple: CARD16.LAST, xor: TRUE]; minEven: NAT _ 3; maxILabs: NAT _ 10; SetFonts: PROC [s, p: Font] ~ { screenFont _ s; printFont _ p; digWid _ MAX[screenFont.Escapement[[0, ORD['8]]].x, printFont.Escapement[[0, ORD['8]]].x]; fontHeight _ MAX[VF.FontHeight[screenFont], VF.FontHeight[printFont]]; RETURN}; Show: PUBLIC PROC [ h: Histogram, viewerInit: ViewerClasses.ViewerRec _ [], format: ROPE _ NIL, --NIL means "%d" width: NAT _ 0, --max number of chars produced when formatting base: REAL _ 0.0, --base>1 means display count logarithmicly updatePeriod: REAL _ -1.0, --If > 0, every updatePeriod seconds the viewer is repainted if it's out of date. If updatePeriod=0, the viewer is painted every time something changes. If updatePeriod<0, the viewer is never automatically repainted. paint: BOOL _ TRUE] RETURNS [v: Viewer] = { hv: HistogramView; x, yTop, yBot: INTEGER _ 0; w, cw: INTEGER; Place: PROC [iv: Viewer] = { IF iv.wx+iv.ww <= w THEN NULL ELSE IF iv.wx = 0 THEN NULL ELSE VO.MoveViewer[iv, x _ 0, yTop _ yBot+vSep, iv.ww, iv.wh, FALSE]; x _ iv.wx + iv.ww + hSep; yBot _ MAX[yBot, iv.wy + iv.wh]; }; lps: BA.LabelPolicies; IF format=NIL THEN format _ "%d"; IF width=0 THEN width _ 5; lps[X] _ BA.CreateLinearLabelPolicy[ axis: X, format: format, labelChars: width, ctl: IF h.log[X] THEN [TRUE, h.x0, h.xChg, h.xChg, -1.0] ELSE [FALSE, h.x0, h.xChg] ]; IF base<1.0 THEN base _ 1.0; IF h.dimensionality=1 THEN lps[Y] _ BA.CreateLinearLabelPolicy[ axis: Y, format: "%d", labelChars: 1+Real.Ceiling[RealFns.Log[10.0, Count.LAST]], ctl: IF base>1.0 THEN [TRUE, 1.0/base, base, base, 0.999] ELSE [FALSE, 0.0, 1.0] ] ELSE lps[Y] _ BA.CreateLinearLabelPolicy[ axis: Y, format: format, labelChars: width, ctl: [h.log[Y], h.y0, h.yChg, h.yChg, -1] ]; viewerInit.data _ hv _ NEW [HistogramViewRep _ [ h: h, logarithmic: base > 1.0, logFact: IF base>1.0 THEN RealFns.Ln[base] ELSE 0.0, iFormat: format, iChars: width, updatePeriod: updatePeriod ]]; ComputeMins[hv, h]; viewerInit.scrollable _ FALSE; IF viewerInit.icon = unInit THEN viewerInit.icon _ icon; hv.ctr _ v _ MJSContainers.Create[viewerFlavor: containerFlavor, info: viewerInit, paint: paint]; w _ IF v.parent # NIL THEN MAX[v.cw, 100] ELSE (ViewerSpecs.openRightWidth - 2*ViewerSpecs.windowBorderSize); cw _ w - ViewerSpecs.scrollBarW; hv.bs _ BA.Create[class: histogramViewer, labelPolicies: lps, info: [parent: hv.ctr, wx: 0, wy: 0, ww: w, wh: v.ch, data: hv, border: FALSE], paint: FALSE]; Place[stats.Instantiate[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE, name: "Stats"], hv, NIL, NIL, FALSE]]; IF h.dimensionality = 1 THEN { } ELSE { Place[fitting.Instantiate[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE, name: "LeastSquares"], hv, NIL, NIL, FALSE]]; Place[projecting.Instantiate[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE, name: "Project"], hv, NIL, NIL, FALSE]]; }; Place[dataCtl.Instantiate[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE, name: "Data"], hv, NIL, NIL, FALSE]]; Place[BA.CreateDrawingButton[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE], hv.bs]]; Place[BS.CreateEdge[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE], hv.bs]]; Place[BS.CreateReset[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE], hv.bs]]; Place[BS.CreatePrev[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE], hv.bs]]; Place[BS.CreateScale[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE], hv.bs]]; Place[BS.CreateFit[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE], hv.bs]]; Place[Rules.Create[[parent: hv.ctr, wx: 1, wy: yTop, ww: ViewerSpecs.bwScreenWidth, wh: 1], NIL, FALSE]]; VO.MoveViewer[hv.bsOuter _ hv.bs.QuaViewer[], 0, yBot, w, hv.ctr.ch-yBot, FALSE]; MJSContainers.ChildXBound[hv.ctr, hv.bsOuter]; MJSContainers.ChildYBound[hv.ctr, hv.bsOuter]; AddNoter[h, [NoteChange, hv]]; IF paint THEN VO.PaintViewer[v, client]; IF updatePeriod > 0 THEN hv.tracker _ FORK Track[hv, Process.MsecToTicks[ MAX[Real.Fix[MIN[updatePeriod, LAST[INTEGER]/1000]*1000 + 0.999], 1]]]; }; hSep: INTEGER _ 2; vSep: INTEGER _ 2; ComputeMins: ENTRY PROC [hv: HistogramView, h: Histogram] ~ { ENABLE UNWIND => NULL; InnerComputeMins[hv, h]; RETURN}; InnerComputeMins: INTERNAL PROC [hv: HistogramView, h: Histogram] ~ { hv.minIn _ [ i: IF hv.fitLog[X] AND NOT h.log[X] THEN INTEGER[Real.Ceiling[MAX[0.0, MIN[REAL[INTEGER.LAST], 0.50000005 - h.iOffset/h.iFactor]]]] ELSE 0, j: IF hv.fitLog[Y] AND NOT h.log[Y] THEN INTEGER[Real.Ceiling[MAX[0.0, MIN[REAL[INTEGER.LAST], 0.50000005 - h.jOffset/h.jFactor]]]] ELSE 0]; RETURN}; ShowProjection: PROC [hv: HistogramView, cx, cy: REAL] RETURNS [pv: Viewer] ~ { ph: Histogram ~ HistogramsExtras.Project[hv.h, cx, cy]; pv _ Show[h: ph, viewerInit: [name: IO.PutFR["%g * [%g, %g]", [rope[hv.ctr.name]], [real[cx]], [real[cy]]], column: hv.ctr.column, iconic: TRUE], base: RealFns.Exp[hv.logFact], updatePeriod: hv.updatePeriod]; RETURN [pv]}; NoteChange: PROC [data: REF ANY, h: Histogram, c: ChangeNote] ~ { hv: HistogramView ~ NARROW[data]; IF hv.destroyed THEN RETURN; hv.sumsValid _ FALSE; FOR d: Dim IN Dim DO hv.bad[d].min _ MIN[hv.bad[d].min, c.range[d].min]; hv.bad[d].max _ MAX[hv.bad[d].max, c.range[d].max]; ENDLOOP; IF hv.updatePeriod = 0.0 THEN VFk.ForkPaint[viewer: hv.bsOuter, hint: client, clearClient: FALSE, tryShortCuts: TRUE]; RETURN}; Track: PROC [hv: HistogramView, ticks: Process.Ticks] = { DO Process.Pause[ticks]; IF hv.destroyed OR hv.ctr.destroyed THEN EXIT; IF hv.bad[X].max >= hv.bad[X].min AND hv.bad[Y].max >= hv.bad[Y].min AND NOT hv.ctr.iconic THEN VO.PaintViewer[hv.bsOuter, client, FALSE]; ENDLOOP; }; stats: PUB.Class _ PUB.MakeClass[[proc: GiveStats, doc: "Print statistics in MessageWindow"]]; GiveStats: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = { hv: HistogramView = NARROW[instanceData]; Stats1: PROC [h: Histogram] = { count: INT; sum1, sum2, avg, stdDev: REAL; range: RealRange1; [count, sum1, sum2, avg, stdDev, range] _ Stats1D[h]; MessageWindow.Append[ message: IO.PutFR[ "count=%g; sum=%g; sum of squares=%g", [integer[count]], [real[sum1]], [real[sum2]] ], clearFirst: TRUE]; IF count > 0 THEN MessageWindow.Append[ message: IO.PutFR[ "; avg=%g", [real[avg]] ], clearFirst: FALSE]; IF count > 1 THEN MessageWindow.Append[ message: IO.PutFR[ "; std. dev.=%g", [real[stdDev]] ], clearFirst: FALSE]; IF range.max >= range.min THEN MessageWindow.Append[ message: IO.PutFR[ "; x bounds=[%g..%g]", [real[range.min]], [real[range.max]] ], clearFirst: FALSE]; }; Stats2: PROC [h: Histogram] = { sums: Sums2D; range: RealRange2; count: INT; [sums, range] _ Stats2D[h, 1, [FALSE, FALSE]]; count _ Real.Round[sums.Sxkl[0][0]]; MessageWindow.Append[ message: IO.PutFR[ "count=%g; sum=<%g,%g>", IO.int[count], IO.real[sums.Sxkl[0][1]], IO.real[sums.Sxky[0]]], clearFirst: TRUE]; IF count > 0 THEN MessageWindow.Append[ message: IO.PutFR[ "; avg=<%g,%g>", IO.real[sums.Sxkl[0][1]/sums.Sxkl[0][0] ], IO.real[sums.Sxky[0]/sums.Sxkl[0][0] ]], clearFirst: FALSE]; IF range[X].max >= range[X].min THEN MessageWindow.Append[ message: IO.PutFR[ "; bounds=[<%g,%g>..<%g,%g>]", [real[range[X].min]], [real[range[Y].min]], [real[range[X].max]], [real[range[Y].max]] ], clearFirst: FALSE]; }; SELECT hv.h.dimensionality FROM 1 => Stats1[hv.h]; 2 => Stats2[hv.h]; ENDCASE => ERROR; }; dataCtl: PUB.Class _ PUB.MakeClass[[ proc: DataCtl, choices: LIST[ [$WriteToScript, "Write description and contents to a new typescript"], [$Copy, "Create & view copy of self"], [$WriteToFile, "Write description and contents to file named in Tioga selection"], [$CreateFromSel, "Create a new Histogram and view from contents of the Tioga selection"], [$Clear, "Set all counters to 0"], [$CreateFromFile, "Create a new Histogram and view from contents of file named in Tioga selection"] ], doc: "Various data operations"]]; DataCtl: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = { viewer: Viewer = NARROW[view]; hv: HistogramView = NARROW[instanceData]; SELECT key FROM $Clear => ClearAll[hv.h]; $WriteToScript => { buff: IO.STREAM ~ IO.ROS[]; ViewerWrite[hv.ctr, buff, TRUE, TRUE, TRUE]; [] _ ViewerTools.MakeNewTextViewer[info: [name: hv.ctr.name, data: IO.RopeFromROS[buff], iconic: FALSE, column: hv.ctr.column]]; }; $WriteToFile => { nameBase: ROPE _ ViewerTools.GetSelectionContents[]; IF nameBase.Length=0 THEN nameBase _ hv.ctr.name; {fileName: ROPE ~ nameBase.Concat[".hist"]; file: IO.STREAM ~ FS.StreamOpen[fileName, create !FS.Error => { MessageWindow.Append[Rope.Cat["File create error: ", error.explanation], TRUE]; GOTO Dun}]; ViewerWrite[hv.ctr, file, TRUE, TRUE, TRUE]; MessageWindow.Append[FS.ExpandName[fileName].fullFName.Concat[" written"], TRUE]; file.Close[]}}; $CreateFromSel => { spec: IO.STREAM ~ IO.RIS[ViewerTools.GetSelectionContents[]]; create: CreateData; show: ShowData; newH: Histogram; {ENABLE Error => { MessageWindow.Append[IO.PutFR["Error[%g] near %g", [rope[msg]], [integer[spec.GetIndex[]]]], TRUE]; GOTO Dun}; [create, show] _ ReadSpecs[spec]; newH _ CreateFromSpec[create]; AddFrom[newH, spec]; [] _ ShowBySpec[newH, show, [iconic: FALSE, column: hv.ctr.column]]}}; $CreateFromFile => CreateFromFile[ViewerTools.GetSelectionContents[], hv.ctr.column !Error => {MessageWindow.Append[msg, TRUE]; GOTO Dun}]; $Copy => { newH: Histogram ~ SELECT hv.h.dimensionality FROM 1 => Create1D[MaybeEx[hv.h.iFactor, hv.h.log[X]], MaybeEx[hv.h.iOffset, hv.h.log[X]], hv.h.log[X], hv.h.BinNamer, hv.h.clientData], 2 => Create2D[MaybeEx[hv.h.iFactor, hv.h.log[X]], MaybeEx[hv.h.jFactor, hv.h.log[Y]], MaybeEx[hv.h.iOffset, hv.h.log[X]], MaybeEx[hv.h.jOffset, hv.h.log[Y]], hv.h.log[X], hv.h.log[Y], hv.h.BinNamer, hv.h.clientData], ENDCASE => ERROR; AddData[newH, hv.h]; [] _ Show[h: newH, viewerInit: [name: hv.ctr.name, iconic: FALSE, column: hv.ctr.column], format: hv.iFormat, width: hv.iChars, base: IF hv.logFact#0.0 THEN RealFns.Exp[hv.logFact] ELSE 0.0]}; ENDCASE => ERROR; RETURN EXITS Dun => key _ key}; NewCommand: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL] --Commander.CommandProc-- = { h: Histogram ~ Create1D[]; v: Viewer ~ Show[h]; RETURN}; ReadCommand: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL] --Commander.CommandProc-- = { argv: CommandTool.ArgumentVector ~ CommandTool.Parse[cmd]; FOR i: NAT IN [1 .. argv.argc) DO CreateFromFile[argv[i], left !Error => { cmd.err.PutF["%g\n", [rope[msg]]]; result _ $Failure; CONTINUE}]; ENDLOOP; cmd _ cmd}; CreateFromFile: PROC [nameBase: ROPE, column: ViewerClasses.Column] ~ { complaint: ROPE _ "shouldn't ever be seen"; create: CreateData; show: ShowData; newH: Histogram; {spec: IO.STREAM ~ FS.StreamOpen[nameBase.Concat[".hist"] !FS.Error => {complaint _ Rope.Cat["File read error: ", error.explanation]; GOTO Crapout}]; {ENABLE Error => {complaint _ IO.PutFR["Error[%g] near %g", [rope[msg]], [integer[spec.GetIndex[]]]]; GOTO Crapout}; [create, show] _ ReadSpecs[spec]; newH _ CreateFromSpec[create]; AddFrom[newH, spec]; spec.Close[]; [] _ ShowBySpec[newH, show, [name: nameBase, iconic: FALSE, column: column]]}; EXITS Crapout => ERROR Error[complaint]}; RETURN}; CreateFromSpec: PROC [create: CreateData] RETURNS [Histogram] ~ { WITH create SELECT FROM x: REF CreateDataPrivate[oneD] => RETURN Create1D[x.factor, x.offset, x.log]; x: REF CreateDataPrivate[twoD] => RETURN Create2D[x.iFactor, x.jFactor, x.iOffset, x.jOffset, x.log[X], x.log[Y]]; ENDCASE => ERROR}; ShowBySpec: PROC [h: Histogram, show: ShowData, viewerInit: ViewerClasses.ViewerRec] RETURNS [Viewer] ~ { RETURN Show[h: h, viewerInit: viewerInit, format: show.format, width: show.width, base: show.base]}; AddData: PROC [to, from: Histogram] ~ { d: DataRef ~ from.data; SELECT to.dimensionality FROM 1 => FOR i: NATURAL _ 0, i+1 WHILE i0 THEN { x: REAL ~ ExvertI[from, i]; ChangeTransformed[to, x, 0.0, d.counts[i]]; }; ENDLOOP; 2 => { index: NATURAL _ 0; FOR i: NATURAL IN [0 .. NATURAL[from.nI]) DO x: REAL ~ ExvertI[from, i]; FOR j: NATURAL IN [0 .. NATURAL[from.nJ]) DO IF d[index] # 0 THEN { y: REAL ~ ExvertJ[from, j]; ChangeTransformed[to, x, y, d[index]]; }; index _ index + 1; ENDLOOP; ENDLOOP; }; ENDCASE => ERROR; RETURN}; projecting: PUB.Class _ PUB.MakeClass[[ proc: ProjectControl, image: PUB.ImageForRope["Project"], choices: LIST[ [$RowSums], [$Sums], [$ColSums]] ]]; ProjectControl: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = { hv: HistogramView = NARROW[instanceData]; SELECT key FROM $RowSums => [] _ ShowProjection[hv, 0, 1]; $Sums => [] _ ShowProjection[hv, 1, 1]; $ColSums => [] _ ShowProjection[hv, 1, 0]; ENDCASE => ERROR; RETURN}; fitting: PUB.Class _ PUB.MakeClass[[ proc: FitControl, image: PUB.ImageForRope["LeastSquares"], choices: LIST[ [$LogNeitherXNorY], [$FitVisible], [$LogXNotY], [$LogYNotX], [$FitInvisible], [$LogXAndY], [$FitDegree0], [$FitDegree1], [$FitDegree2], [$FitDegreeFromTioga], [$ReFit], [$ReportCoefs]] ]]; FitControl: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = { hv: HistogramView = NARROW[instanceData]; cw: NAT = hv.bs.QuaViewer[TRUE].cw; tr: TweakResult _ []; WithLock: ENTRY PROC [h: Histogram] = { SELECT key FROM $FitVisible => { IF NOT hv.fitVisible THEN tr.paint _ hv.fitVisible _ TRUE; IF hv.fitCoefs=NIL OR NOT hv.sumsValid THEN tr _ FitCoefs[h, hv]}; $FitInvisible => IF hv.fitVisible THEN tr.paint _ NOT (hv.fitVisible _ FALSE); $LogNeitherXNorY => IF hv.fitLog[X] OR hv.fitLog[Y] THEN { hv.sumsValid _ hv.fitLog[X] _ hv.fitLog[Y] _ FALSE; InnerComputeMins[hv, h]; IF hv.fitVisible THEN tr _ FitCoefs[h, hv]}; $LogXNotY => IF (~hv.fitLog[X]) OR hv.fitLog[Y] THEN { hv.fitLog[X] _ NOT (hv.fitLog[Y] _ hv.sumsValid _ FALSE); InnerComputeMins[hv, h]; IF hv.fitVisible THEN tr _ FitCoefs[h, hv]}; $LogYNotX => IF (~hv.fitLog[Y]) OR hv.fitLog[X] THEN { hv.fitLog[Y] _ NOT (hv.fitLog[X] _ hv.sumsValid _ FALSE); InnerComputeMins[hv, h]; IF hv.fitVisible THEN tr _ FitCoefs[h, hv]}; $LogXAndY => IF (~hv.fitLog[X]) OR (~hv.fitLog[Y]) THEN { hv.sumsValid _ NOT (hv.fitLog[X] _ hv.fitLog[Y] _ TRUE); InnerComputeMins[hv, h]; IF hv.fitVisible THEN tr _ FitCoefs[h, hv]}; $FitDegree0 => IF hv.fitDegree#0 THEN { hv.fitDegree _ 0; hv.sumsValid _ FALSE; IF hv.fitVisible THEN tr _ FitCoefs[h, hv]}; $FitDegree1 => IF hv.fitDegree#1 THEN { hv.fitDegree _ 1; hv.sumsValid _ FALSE; IF hv.fitVisible THEN tr _ FitCoefs[h, hv]}; $FitDegree2 => IF hv.fitDegree#2 THEN { hv.fitDegree _ 2; hv.sumsValid _ FALSE; IF hv.fitVisible THEN tr _ FitCoefs[h, hv]}; $FitDegreeFromTioga => { sel: ROPE ~ ViewerTools.GetSelectionContents[]; degree: INT ~ Convert.IntFromRope[sel !Convert.Error => {tr.msg _ "Bad number"; GOTO Givup}]; IF NOT degree IN [0 .. 10] THEN tr.msg _ "Don't be ridiculous" ELSE IF hv.fitDegree#degree THEN { hv.fitDegree _ degree; hv.sumsValid _ FALSE; IF hv.fitVisible THEN tr _ FitCoefs[h, hv]}}; $ReFit => {hv.fitVisible _ TRUE; tr _ FitCoefs[h, hv]}; $ReportCoefs => IF hv.fitCoefs=NIL THEN tr.msg _ "No fit to report" ELSE { FOR i: NATURAL IN [0 .. hv.fitCoefs.ncols) DO tr.msg _ tr.msg.Cat[" ", Convert.RopeFromReal[hv.fitCoefs[i]]]; ENDLOOP; }; ENDCASE => ERROR; RETURN; EXITS Givup => key _ key; }; WithLock[hv.h]; IF tr.msg#NIL THEN MessageWindow.Append[tr.msg, TRUE]; IF tr.paint THEN ViewerOps.PaintViewer[hv.bsOuter, client, FALSE]; RETURN}; Paint: PROC [self: Viewer, context: Imager.Context, bounds: Box, dest: BA.ImageDestination, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL _ FALSE] --BA.PaintProc-- ~ { asBS: BiScroller = BS.QuaBiScroller[self]; hv: HistogramView = NARROW[BA.ClientDataOf[asBS]]; {ENABLE Real.RealException => TRUSTED { Process.Detach[FORK MessageWindow.Append["Can't paint because of arithmatic error", TRUE]]; CONTINUE}; SELECT hv.h.dimensionality FROM 1 => Paint1D[self, asBS, hv.h, hv, context, bounds, whatChanged, screenFont, clear, TRUE]; 2 => Paint2D[self, asBS, hv.h, hv, context, bounds, whatChanged, screenFont, clear, TRUE]; ENDCASE => ERROR; RETURN}}; Paint1D: ENTRY PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, context: Imager.Context, bounds: Box, whatChanged: REF ANY, font: Font, clear, latch: BOOL] = { ENABLE UNWIND => NULL; InnerPaint1D[self, asBS, h, hv, context, bounds, whatChanged, font, clear, latch]; RETURN}; InnerPaint1D: INTERNAL PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, context: Imager.Context, bounds: Box, whatChanged: REF ANY, font: Font, clear, latch: BOOL] ~ { maxi: INT ~ IMax[h]; cWidth: REAL ~ IF asBS.style.GetTransforms[asBS].clientToViewer.a >= 1.25 THEN 0.8 ELSE 1.0; i, iMin, iMax: INT; IF NOT h.maxValid THEN ComputeMax[h]; {incremental: BOOL = NOT clear; mz: REAL ~ DispCount[hv, h.maxCount]; iMin _ MAX[Real.Floor[bounds.xmin], 0]; iMax _ MIN[Real.Ceiling[bounds.xmax], h.data.length-1]; IF incremental THEN { iMin _ MAX[hv.bad[X].min, iMin]; iMax _ MIN[hv.bad[X].max, iMax]; }; IF hv.shown # NIL AND iMax < hv.shown.length THEN NULL ELSE IF iMax < 0 THEN NULL ELSE hv.shown _ Ensure1[hv.shown, iMax]; context.SetStrokeEnd[butt]; context.SetStrokeWidth[cWidth]; IF NOT incremental THEN { showns: DataRef = hv.shown; actuals: DataRef = h.data; IF NOT clear THEN { context.SetColor[Imager.white]; context.MaskBox[bounds]; }; context.SetColor[Imager.black]; FOR i _ iMin, i+1 WHILE i <= iMax DO IF actuals[i]>0 THEN { cx: REAL ~ i; context.MaskVector[[cx, 0], [cx, DispCount[hv, actuals[i]] ]]}; IF latch THEN showns[i] _ actuals[i]; ENDLOOP; } ELSE { showns: DataRef = hv.shown; actuals: DataRef = h.data; IF NOT latch THEN ERROR--we shouldn't be incremental if we're not latching--; context.SetColor[ImagerBackdoor.invert]; FOR i _ iMin, i+1 WHILE i <= iMax DO sy: REAL = DispCount[hv, showns[i]]; ay: REAL = DispCount[hv, actuals[i]]; IF ay # sy THEN { cx: REAL ~ i; context.MaskVector[[cx, ay], [cx, sy]]; showns[i] _ actuals[i]}; ENDLOOP; }; hv.bad _ nullRange2; }}; Paint2D: ENTRY PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, context: Imager.Context, bounds: Box, whatChanged: REF ANY, font: Font, clear, latch: BOOL] = { ENABLE UNWIND => NULL; InnerPaint2D[self, asBS, h, hv, context, bounds, whatChanged, font, clear, latch]; RETURN}; InnerPaint2D: INTERNAL PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, context: Imager.Context, bounds: Box, whatChanged: REF ANY, font: Font, clear, latch: BOOL] = { viMin, viMax, vjMin, vjMax: INT; iMin, iMax, jMin, jMax: INT; DrawPoly: PROC [ak: ColumnN, showLog: BoolPair, range: RealRange1] ~ { IF ak=NIL THEN RETURN; IF range.min > range.max THEN RETURN; {leftX: REAL ~ ExvertI[h, range.min, showLog[X]]; rightX: REAL ~ ExvertI[h, range.max, showLog[X]]; leftY: REAL ~ Eval[ak, leftX]; rightY: REAL ~ Eval[ak, rightX]; context.SetColor[polyColor]; IF ak.ncols<=2 AND showLog[X]=h.log[X] AND showLog[Y]=h.log[Y] THEN { leftJ: REAL ~ InvertJR[h, leftY, showLog[Y]]; rightJ: REAL ~ InvertJR[h, rightY, showLog[Y]]; context.MaskVector[[range.min, leftJ], [range.max, rightJ]]; RETURN} ELSE { first: BOOL _ TRUE; di: REAL ~ (range.max-range.min)/8.0; Path: Imager.PathProc ~ { i: REAL _ range.min; THROUGH [0 .. 8] DO x: REAL ~ ExvertI[h, i, showLog[X]]; y: REAL ~ Eval[ak, x]; IF showLog[Y] OR (NOT h.log[Y]) OR y > 0.0 THEN { j: REAL ~ InvertJR[h, y, showLog[Y]]; IF first THEN {moveTo[[i, j]]; first _ FALSE} ELSE lineTo[[i, j]]; }; i _ i + di; ENDLOOP; RETURN}; context.MaskStroke[Path]; RETURN}}}; IF NOT h.maxValid THEN {ComputeMax[h]; hv.bad _ fullRange2}; {maxCount: Count = h.maxCount; mz: REAL ~ DispCount[hv, maxCount]; incremental: BOOL = maxCount = hv.shownMax AND NOT clear; viMin _ MAX[Real.Round[bounds.xmin], 0]; viMax _ MIN[Real.Round[bounds.xmax], h.nI-1]; vjMin _ MAX[Real.Round[bounds.ymin], 0]; vjMax _ MIN[Real.Round[bounds.ymax], h.nJ-1]; IF incremental THEN { iMin _ MAX[hv.bad[X].min, viMin]; iMax _ MIN[hv.bad[X].max, viMax]; jMin _ MAX[hv.bad[Y].min, vjMin]; jMax _ MIN[hv.bad[Y].max, vjMax]; } ELSE {iMin _ viMin; iMax _ viMax; jMin _ vjMin; jMax _ vjMax}; IF clear THEN hv.shownCoefs _ NIL; IF iMin <= iMax AND jMin <= jMax THEN { IF NOT clear THEN { IF hv.shownCoefs#NIL THEN {DrawPoly[hv.shownCoefs, hv.shownFitLog, hv.shownRange]; hv.shownCoefs _ NIL}; context.SetColor[ImagerColor.ColorFromGray[0]]; context.MaskBox[[iMin-0.5, jMin-0.5, iMax+0.5, jMax+0.5]]; }; IF mz > 0 THEN FOR i: INT IN [iMin .. iMax] DO k: INT _ i*h.nJ + jMin; FOR j: INT IN [jMin .. jMax] DO c: Count ~ h.data[k]; IF c>0 THEN { context.SetColor[ImagerColor.ColorFromGray[MAX[0.0, MIN[1.0, DispCount[hv, c]/mz]]]]; context.MaskRectangle[[x: i-0.4, y: j-0.4, w: 0.8, h: 0.8]]; }; k _ k + 1; ENDLOOP; ENDLOOP; clear _ clear}; IF latch THEN {hv.shownMax _ maxCount; hv.bad _ nullRange2}; IF NOT latch THEN latch _ latch ELSE IF hv.fitVisible THEN { IF hv.shownCoefs#hv.fitCoefs THEN { IF hv.shownCoefs#NIL THEN DrawPoly[hv.shownCoefs, hv.shownFitLog, hv.shownRange]; DrawPoly[hv.shownCoefs _ hv.fitCoefs, hv.shownFitLog _ hv.fitLog, hv.shownRange _ [IntMax[viMin, hv.minIn.i]-0.4, viMax+0.4]]}; } ELSE IF hv.shownCoefs#NIL THEN { DrawPoly[hv.shownCoefs, hv.shownFitLog, hv.shownRange]; hv.shownCoefs _ NIL}; RETURN}}; Extrema: PROC [clientData: REF ANY, direction: BS.Vec] RETURNS [min, max: BS.Vec] --BS.ExtremaProc-- = { hv: HistogramView = NARROW[clientData]; WithLock: ENTRY PROC [h: Histogram] RETURNS [min, max: BS.Vec] = { ENABLE UNWIND => NULL; SELECT hv.h.dimensionality FROM 1 => { IF NOT h.maxValid THEN ComputeMax[h]; [min, max] _ Geom2D.ExtremaOfRect[ ImagerBox.RectangleFromBox[[ -0.5, 0.0, REAL[IMax[h]+0.5], DispCount[hv, h.maxCount] ]], direction]; }; 2 => [min, max] _ Geom2D.ExtremaOfRect[ [-0.5, -0.5, h.nI, h.nJ], direction]; ENDCASE => ERROR; }; RETURN WithLock[hv.h]}; Vanilla: PROC [bs: BS.BiScroller] RETURNS [t: BS.Transform] --BS.TransformGenerator-- = { t _ IT.Scale2[[1.0, dHeightInitial]]; RETURN}; Find1D: INTERNAL PROC [hv: HistogramView, wo: BS.ClientCoords] RETURNS [index: NAT, valid: BOOL] ~ { i: INT; IF wo.x <= -1.0 OR wo.x >= INT[hv.h.data.length] + 1 THEN RETURN [0, FALSE]; i _ Real.Round[wo.x]; IF i < 0 OR i >= hv.h.data.length THEN RETURN [0, FALSE]; RETURN [i, TRUE]; }; Find2D: INTERNAL PROC [hv: HistogramView, wo: BS.ClientCoords] RETURNS [i, j: INT, valid: BOOL] ~ { i _ Real.Round[wo.x]; j _ Real.Round[wo.y]; valid _ i IN [0 .. hv.h.nI) AND j IN [0 .. hv.h.nJ)}; Notify: PROC [self: Viewer, input: LIST OF REF ANY] --ViewerClasses.NotifyProc-- = BEGIN asBS: BiScroller _ BS.QuaBiScroller[self]; hv: HistogramView _ NARROW[BA.ClientDataOf[asBS]]; SELECT hv.h.dimensionality FROM 1 => Notify1D[self, asBS, hv.h, hv, input]; 2 => Notify2D[self, asBS, hv.h, hv, input]; ENDCASE => ERROR; END; Notify1D: ENTRY PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, input: LIST OF REF ANY] = { ENABLE UNWIND => NULL; WHILE input # NIL DO SELECT input.first FROM $StartFind, $FollowFind, $FinishFind => BEGIN index: NAT; valid: BOOL; coords: BS.ClientCoords _ NARROW[input.rest.first]; [index, valid] _ Find1D[hv, coords]; IF valid THEN FollowFind1D[hv, index]; IF input.first=$FinishFind THEN hv.finding _ FALSE; input _ input.rest.rest; END; ENDCASE => ERROR; ENDLOOP; }; Notify2D: PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, input: LIST OF REF ANY] = { DoFindStuff: ENTRY PROC [h: Histogram] ~ { ENABLE UNWIND => NULL; coords: BS.ClientCoords ~ NARROW[input.rest.first]; i, j: INT; valid: BOOL; [i, j, valid] _ Find2D[hv, coords]; IF valid THEN FollowFind2D[hv, i, j]; IF input.first=$FinishFind THEN hv.finding _ FALSE; input _ input.rest.rest}; WHILE input # NIL DO SELECT input.first FROM $StartFind, $FollowFind, $FinishFind => DoFindStuff[h]; $TweakOffset => { coords: BS.ClientCoords ~ NARROW[input.rest.first]; tr: TweakResult ~ TweakOffset[h, hv, coords]; IF tr.paint THEN ViewerOps.PaintViewer[viewer: hv.bsOuter, hint: client, clearClient: FALSE]; IF tr.msg#NIL THEN MessageWindow.Append[tr.msg, TRUE]; input _ input.rest.rest}; $TweakSlope, $DontTweakSlope => { coords: BS.ClientCoords ~ NARROW[input.rest.first]; tr: TweakResult ~ TweakSlope[h, hv, asBS, coords, input.first=$DontTweakSlope]; IF tr.paint THEN ViewerOps.PaintViewer[viewer: hv.bsOuter, hint: client, clearClient: FALSE]; IF tr.msg#NIL THEN MessageWindow.Append[tr.msg, TRUE]; input _ input.rest.rest}; ENDCASE => ERROR; ENDLOOP; }; TweakOffset: PROC [h: Histogram, hv: HistogramView, coords: BS.ClientCoords] RETURNS [tr: TweakResult _ []] ~ { InnerTweakOffset: PROC RETURNS [tr: TweakResult _ []] ~ { x: REAL ~ ExvertI[h, coords.x, hv.fitLog[X]]; IF NOT hv.fitVisible THEN { hv.fitVisible _ TRUE; IF hv.fitCoefs=NIL THEN EntryFitCoefs[h, hv]}; IF hv.fitCoefs=NIL THEN RETURN [["Can't tweak broken fit"]]; {curY: REAL ~ Eval[hv.fitCoefs, x]; y: REAL ~ ExvertJ[h, coords.y, hv.fitLog[Y]]; new0: REAL ~ hv.fitCoefs[0] + y - curY; IF new0 # hv.fitCoefs[0] THEN { hv.fitCoefs _ CopyVec[hv.fitCoefs, 1, new0]; [hv.fits, hv.fitr] _ EvalError[hv.sums, hv.fitCoefs]; tr _ [FmtErr[hv], TRUE]}; RETURN}}; tr _ InnerTweakOffset[!Real.RealException => {tr.msg _ "Real Exception"; tr.paint _ FALSE; CONTINUE}]; RETURN}; TweakSlope: ENTRY PROC [h: Histogram, hv: HistogramView, asBS: BiScroller, coords: BS.ClientCoords, stop: BOOL] RETURNS [tr: TweakResult _ []] ~ { ENABLE UNWIND => NULL; tr _ InnerTweakSlope[h, hv, asBS, coords, stop !Real.RealException => {tr.msg _ "Real Exception"; tr.paint _ FALSE; CONTINUE}]; IF stop THEN hv.tweakingSlope _ FALSE; RETURN}; InnerTweakSlope: INTERNAL PROC [h: Histogram, hv: HistogramView, asBS: BiScroller, coords: BS.ClientCoords, stop: BOOL] RETURNS [tr: TweakResult _ []] ~ { x: REAL ~ ExvertI[h, coords.x, hv.fitLog[X]]; y: REAL ~ ExvertJ[h, coords.y, hv.fitLog[Y]]; IF hv.fitDegree # 1 THEN RETURN [[IO.PutFR["Can't tweak slope of degree-%g fit", [integer[hv.fitDegree]] ]]]; IF NOT hv.fitVisible THEN { hv.fitVisible _ TRUE; IF hv.fitCoefs=NIL THEN [] _ FitCoefs[h, hv]}; IF hv.fitCoefs=NIL THEN RETURN [["Can't tweak broken fit"]]; IF NOT hv.tweakingSlope THEN { npts: NATURAL _ 0; pts: ARRAY [0 .. 1] OF VEC _ ALL[[0.0, 0.0]]; clickPt: VEC ~ [x, y]; Try: PROC [p: VEC] ~ { IF p.x>=viMin AND p.x<=viMax AND p.y>=vjMin AND p.y<=vjMax THEN { IF npts<2 THEN pts[npts] _ p; npts _ npts+1; RETURN} ELSE RETURN}; xMin, xMax, yMin, yMax: VEC; viMin, viMax, vjMin, vjMax: REAL; [xMin, xMax] _ asBS.ViewportExtrema[[1, 0]]; [yMin, yMax] _ asBS.ViewportExtrema[[0, 1]]; viMin _ MAX[xMin.x, REAL[IntMax[hv.minIn.i, 0]]]; viMax _ MIN[xMax.x, h.nI-1.0]; vjMin _ MAX[yMin.y, REAL[IntMax[hv.minIn.j, 0]]]; vjMax _ MIN[yMax.y, h.nJ-1.0]; IF viMin >= viMax OR vjMin >= vjMax THEN RETURN [["Can't tweak in empty box", FALSE]]; viMin _ ExvertI[h, viMin, hv.fitLog[X]]; viMax _ ExvertI[h, viMax, hv.fitLog[X]]; vjMin _ ExvertJ[h, vjMin, hv.fitLog[Y]]; vjMax _ ExvertJ[h, vjMax, hv.fitLog[Y]]; Try[[viMin, hv.fitCoefs[0] + hv.fitCoefs[1]*viMin]]; Try[[viMax, hv.fitCoefs[0] + hv.fitCoefs[1]*viMax]]; Try[[(vjMin - hv.fitCoefs[0])/hv.fitCoefs[1], vjMin]]; Try[[(vjMax - hv.fitCoefs[0])/hv.fitCoefs[1], vjMax]]; IF npts#2 THEN RETURN [[IO.PutFR["Bug 1 (%g)", [integer[npts]] ]]]; hv.tweakConst _ IF DistSquared[pts[0], clickPt] <= DistSquared[pts[1], clickPt] THEN pts[1] ELSE pts[0]; hv.tweakingSlope _ TRUE; }; {dx: REAL ~ x - hv.tweakConst.x; dy: REAL ~ y - hv.tweakConst.y; newSlope: REAL ~ dy / dx; newOffset: REAL ~ y - x * newSlope; IF hv.fitCoefs[0] # newOffset OR hv.fitCoefs[1] # newSlope THEN { hv.fitCoefs _ CopyVec[hv.fitCoefs, 2, newOffset, newSlope]; [hv.fits, hv.fitr] _ EvalError[hv.sums, hv.fitCoefs]; tr _ [FmtErr[hv], TRUE]}; RETURN}}; FollowFind1D: INTERNAL PROC [hv: HistogramView, current: NAT] = { data: DataRef = hv.h.data; lowest, highest: NAT; count: INT _ 0; IF NOT hv.finding THEN {hv.finding _ TRUE; hv.findFirstI _ current}; [lowest, highest] _ Sort2[hv.findFirstI, current]; FOR i: NAT IN [lowest .. highest] DO count _ count + data[i]; ENDLOOP; MessageWindow.Append[ message: IO.PutFR[ "%g in %g thru %g", IO.int[count], [rope[Describe[hv.h, lowest, 0, -0.5]]], [rope[Describe[hv.h, highest, 0, 0.5]]] ], clearFirst: TRUE]; }; Describe: PROC [h: Histogram, i, j: INTEGER, d: REAL] RETURNS [desc: ROPE] ~ { name: ROPE ~ IF h.BinNamer#NIL THEN h.BinNamer[h.clientData, i, j] ELSE NIL; desc _ SELECT h.dimensionality FROM 1 => Convert.RopeFromReal[ExvertI[h, i+d]], 2 => IO.PutFR["<%g, %g>", [real[ExvertI[h, i+d]]], [real[ExvertJ[h, j+d]]]], ENDCASE => ERROR; IF name#NIL THEN desc _ desc.Cat["(", name, ")"]; RETURN}; Sort2: PROC [i1, i2: INT] RETURNS [min, max: INT] = { SELECT i2 - i1 FROM >0 => {min _ i1; max _ i2}; =0 => min _ max _ i1; <0 => {min _ i2; max _ i1}; ENDCASE => ERROR; }; FollowFind2D: INTERNAL PROC [hv: HistogramView, i, j: INT] = BEGIN data: DataRef = hv.h.data; iMin, iMax, jMin, jMax: INT; count: INT _ 0; IF NOT hv.finding THEN {hv.finding _ TRUE; hv.findFirstI _ i; hv.findFirstJ _ j}; [iMin, iMax] _ Sort2[hv.findFirstI, i]; [jMin, jMax] _ Sort2[hv.findFirstJ, j]; FOR i: INT IN [iMin .. iMax] DO index: NAT _ i * hv.h.nJ + jMin; FOR j: INT IN [jMin .. jMax] DO count _ count + data[index]; index _ index + 1; ENDLOOP; ENDLOOP; MessageWindow.Append[ message: IO.PutFR[ "%g in %g thru %g", IO.int[count], [rope[Describe[hv.h, iMin, jMin, -0.5]]], [rope[Describe[hv.h, iMax, jMax, 0.5]]] ], clearFirst: TRUE]; END; Destroy: PROC [self: Viewer] --ViewerClasses.DestroyProc-- = { asBS: BiScroller = BS.QuaBiScroller[self]; hv: HistogramView = NARROW[BA.ClientDataOf[asBS]]; IF NOT hv.destroyed THEN { hv.destroyed _ TRUE; RemNoter[hv.h, [NoteChange, hv]]}; RETURN}; EntryFitCoefs: ENTRY PROC [h: Histogram, hv: HistogramView] ~ { ENABLE UNWIND => NULL; [] _ FitCoefs[h, hv]}; FitCoefs: INTERNAL PROC [h: Histogram, hv: HistogramView] RETURNS [TweakResult] ~ { IF NOT hv.sumsValid THEN { hv.sums _ Stats2DInt[h, hv.fitDegree, hv.fitLog].sums; hv.sumsValid _ TRUE}; IF hv.sums.exception THEN { hv.fitCoefs _ NIL; RETURN [["Can't fit because of REAL exception", TRUE]]} ELSE { [hv.fitCoefs, hv.fits, hv.fitr] _ Analyze[hv.sums]; RETURN [[FmtErr[hv], TRUE]]}; }; FmtErr: PROC [hv: HistogramView] RETURNS [ans: ROPE] ~ { ans _ IO.PutFR["sigma = %g", [real[hv.fits]] ]; IF hv.fitDegree=1 THEN ans _ ans.Concat[IO.PutFR["; rho = %g", [real[hv.fitr]] ]]; RETURN}; IMax: INTERNAL PROC [h: Histogram] RETURNS [iMax: INTEGER] ~ { data: DataRef ~ h.data; IF data.length=0 THEN RETURN [0]; FOR iMax _ data.length-1, iMax-1 WHILE iMax>0 AND data[iMax]=0 DO NULL ENDLOOP; RETURN}; Eval: PROC [poly: ColumnN, x: REAL] RETURNS [val: REAL] ~ { xk: REAL _ 1.0; val _ poly[0]; FOR k: NATURAL IN [1 .. poly.ncols) DO xk _ xk * x; val _ val + poly[k] * xk; ENDLOOP; x _ x}; AddFromFile: PROC [h: Histogram, fileName: ROPE] ~ { from: IO.STREAM ~ FS.StreamOpen[fileName]; AddFrom[h, from]; from.Close[]; RETURN}; ViewerWriteToFile: PUBLIC PROC [v: Viewer, fileName: ROPE, create, show, data: BOOL _ TRUE] ~ { to: IO.STREAM ~ FS.StreamOpen[fileName, create]; ViewerWrite[v, to, create, show, data]; to.Close[]; RETURN}; ViewerWriteToRope: PUBLIC PROC [v: Viewer, create, show, data: BOOL _ TRUE] RETURNS [ROPE] ~ { to: IO.STREAM ~ IO.ROS[]; ViewerWrite[v, to, create, show, data]; RETURN to.RopeFromROS[]}; ViewerWrite: PUBLIC PROC [v: Viewer, to: IO.STREAM, create, show, data: BOOL] ~ { hv: HistogramView = NARROW[MJSContainers.GetClientData[v]]; h: Histogram ~ hv.h; IF create OR NOT show THEN WriteTo[h, to, create, data AND NOT show]; IF NOT show THEN RETURN; IF create THEN to.PutRope["\n"]; to.PutF["show[format: \"%q\", width: %g, base: %g]", [rope[hv.iFormat]], [integer[hv.iChars]], [real[IF hv.logFact#0.0 THEN RealFns.Exp[hv.logFact] ELSE -1.0]] ]; IF data THEN {to.PutRope["\n"]; WriteTo[h, to, FALSE, TRUE]}; RETURN}; WriteTo: PUBLIC ENTRY PROC [h: Histogram, to: IO.STREAM, create, data: BOOL] = { ENABLE UNWIND => NULL; d: DataRef ~ h.data; others, layered: BOOL _ FALSE; IF create THEN SELECT h.dimensionality FROM 1 => { to.PutF["oneD[factor: %g, offset: %g, log: %g]", [real[MaybeEx[h.iFactor, h.log[X]]]], [real[MaybeEx[h.iOffset, h.log[X]]]], [boolean[h.log[X]]] ]}; 2 => { to.PutF["twoD[factors: %g %g, offsets: %g %g, ", [real[MaybeEx[h.iFactor, h.log[X]]]], [real[MaybeEx[h.jFactor, h.log[Y]]]], [real[MaybeEx[h.iOffset, h.log[X]]]], [real[MaybeEx[h.jOffset, h.log[Y]]]], ]; to.PutF["log: %g %g]", [boolean[h.log[X]]], [boolean[h.log[Y]]] ]}; ENDCASE => ERROR; IF data THEN { IF create THEN to.PutRope["\n"]; IF (layered _ NOT SS.IsAnSS[to]) THEN to _ SS.Create[UB.NewInittedHandle[[margin: printWidth, output: [stream[to]] ]] ]; SS.Begin[to]; to.PutF["%g[", [integer[h.dimensionality]]]; SELECT h.dimensionality FROM 1 => { amtFmt: ROPE; IF NOT h.maxValid THEN ComputeMax[h]; amtFmt _ IO.PutFR["%%0%gg of %%g", [integer[Real.Floor[RealFns.Log[base: 10, arg: IntMax[h.maxCount, 1]]]+1]]]; FOR i:NAT _ 0, i+1 WHILE i0 THEN { name: ROPE ~ IF h.BinNamer#NIL THEN h.BinNamer[h.clientData, i, 0] ELSE NIL; IF others THEN {to.PutRope[","]; SS.Bp[to, width, indent, " "]} ELSE {others _ TRUE; SS.Bp[to, width, indent]}; to.PutF[amtFmt, IO.card[d.counts[i]], IO.real[ExvertI[h, i]]]; IF name#NIL THEN to.PutF["\"%q\"", [rope[name]]]; }; ENDLOOP; }; 2 => { index: NAT _ 0; someI: BOOL _ FALSE; FOR i: INT IN [0 .. h.nI) DO someJ: BOOL _ FALSE; EnsureJ: PROC = { IF someJ THEN {to.PutRope[","]; SS.Bp[to, width, indent, " "]; RETURN}; someJ _ TRUE; IF someI THEN {to.PutRope[","]; SS.Bp[to, united, indent, " "]} ELSE {someI _ TRUE; SS.Bp[to, united, indent]}; SS.Begin[to]; to.PutF["%g: [", IO.real[ExvertI[h, i]]]; SS.Bp[to, width, indent]; RETURN}; FOR j: INT IN [0 .. h.nJ) DO IF h.data[index] # 0 THEN { name: ROPE ~ IF h.BinNamer#NIL THEN h.BinNamer[h.clientData, i, j] ELSE NIL; EnsureJ[]; to.PutF["%g", IO.real[ExvertJ[h, j]]]; IF name#NIL THEN to.PutF["\"%q\"", [rope[name]]]; to.PutF[": %g", IO.int[h.data[index]]]; }; index _ index + 1; ENDLOOP; IF someJ THEN {to.PutF["]"]; SS.End[to]}; ENDLOOP; }; ENDCASE => ERROR; to.PutRope["]"]; SS.End[to]; IF layered THEN IO.Close[to]; }; RETURN}; printWidth: INT _ 76; indent: INT _ 2; Stats1D: PUBLIC ENTRY PROC [h: Histogram] RETURNS [sum0: INT, sum1, sum2, avg, stdDev: REAL, range: RealRange1] = { ENABLE UNWIND => NULL; data: DataRef = h.data; needMin: BOOL _ TRUE; x: REAL _ h.x0; iMin, iMax: INTEGER _ 0; sum0 _ 0; sum1 _ sum2 _ 0; FOR i: NAT IN [0..data.length) DO n: Count = data[i]; IF n # 0 THEN { sum0 _ sum0 + n; sum1 _ sum1 + x * n; sum2 _ sum2 + x * x * n; iMax _ i; IF needMin THEN {iMin _ i; needMin _ FALSE}; }; IF h.log[X] THEN x _ x * h.xChg ELSE x _ x + h.iFactor; ENDLOOP; avg _ IF sum0 > 0 THEN sum1/sum0 ELSE Real.TrappingNaN; stdDev _ IF sum0 > 1 THEN RealFns.SqRt[MAX[(sum2 - sum0*avg*avg) / (sum0 - 1), 0.0]] ELSE Real.TrappingNaN; range _ IF needMin THEN [Real.LargestNumber, -Real.LargestNumber] ELSE [ExvertI[h, iMin-0.5], ExvertI[h, iMax+0.5]]; RETURN}; Analyze: PUBLIC PROC [sums: Sums2D] RETURNS [ak: ColumnN _ NIL, s, r: REAL _ 0.0] ~ { S1: REAL ~ sums.Sxkl[0][0]; IF S1=0 THEN RETURN; {ENABLE Real.RealException => CONTINUE; ak _ LinearSystem.SolveN[LinearSystem.Copy[sums.Sxkl], CopyVec[sums.Sxky, 0], sums.degree+1]; [s, r] _ EvalError[sums, ak]; RETURN}}; EvalError: PUBLIC PROC [sums: Sums2D, ak: ColumnN] RETURNS [s, r: REAL _ 0.0] ~ { IF sums.degree > 0 THEN { S1: REAL ~ sums.Sxkl[0][0]; Sx: REAL ~ sums.Sxkl[0][1]; Sx2: REAL ~ sums.Sxkl[1][1]; Sy: REAL ~ sums.Sxky[0]; Syx: REAL ~ sums.Sxky[1]; Sy2: REAL ~ sums.Sy2; d2: REAL ~ RealFns.SqRt[MAX[(S1*Sx2 - Sx*Sx) * (S1*Sy2 - Sy*Sy), 0.0]]; IF d2#0.0 THEN r _ (S1*Syx - Sx*Sy) / d2; IF S1 > sums.degree THEN s _ RealFns.SqRt[MAX[0.0, (sums.Sy2 - 2 * Dot[ak, sums.Sxky] + Dot[ak, LinearSystem.MultiplyVec[sums.Sxkl, ak]]) / (S1 - sums.degree) ]]}; RETURN}; Stats2D: PUBLIC ENTRY PROC [h: Histogram, degree: NATURAL, log: BoolPair] RETURNS [sums: Sums2D, range: RealRange2] = { ENABLE UNWIND => NULL; RETURN Stats2DInt[h, degree, log]}; Stats2DInt: PUBLIC INTERNAL PROC [h: Histogram, degree: NATURAL, log: BoolPair] RETURNS [sums: Sums2D, range: RealRange2 _ ALL[[Real.LargestNumber, -Real.LargestNumber]]] = { twiceDegree: NATURAL ~ degree*2; Sxk: ColumnN ~ NEW [LinearSystem.VecSeq[twiceDegree+1]]; someI: BOOL _ FALSE; iMin, iMax, jMin, jMax: INTEGER _ 0; {ENABLE Real.RealException => {sums.exception _ TRUE; CONTINUE}; sums _ [ degree: degree, exception: FALSE, Sxkl: LinearSystem.Create[degree+1, degree+1], Sxky: NEW [LinearSystem.VecSeq[degree+1]], Sy2: 0.0 ]; FOR k: NATURAL IN [0 .. degree] DO Sxk[k] _ sums.Sxky[k] _ 0.0 ENDLOOP; FOR k: NATURAL IN (degree .. twiceDegree] DO Sxk[k] _ 0.0 ENDLOOP; FOR i: INT IN [0 .. h.nI) DO x: REAL; gotX: BOOL _ FALSE; someJ: BOOL _ FALSE; ijMin, ijMax: INTEGER _ 0; FOR j: INT IN [0 .. h.nJ) DO index: NAT _ i * h.nJ + j; n: Count ~ h.data.counts[index]; IF n # 0 THEN { IF NOT gotX THEN {x _ ExvertI[h, i, log[X]]; gotX _ TRUE}; {y: REAL ~ ExvertJ[h, j, log[Y]]; yn: REAL ~ y*n; nx2k: REAL _ n; nxky: REAL _ yn; twoK: NATURAL _ 0; Sxk[0] _ Sxk[0] + nx2k; sums.Sxky[0] _ sums.Sxky[0] + nxky; sums.Sy2 _ sums.Sy2 + y*yn; FOR k: NATURAL IN [1 .. degree] DO sums.Sxky[k] _ sums.Sxky[k] + (nxky _ nxky * x); twoK _ twoK + 1; Sxk[twoK] _ Sxk[twoK] + (nx2k _ nx2k * x); twoK _ twoK + 1; Sxk[twoK] _ Sxk[twoK] + (nx2k _ nx2k * x); ENDLOOP; ijMax _ j; IF NOT someJ THEN {ijMin _ j; someJ _ TRUE}; }}; ENDLOOP; IF someJ THEN { iMax _ i; IF someI THEN {jMax _ MAX[ijMax, jMax]; jMin _ MIN[ijMin, jMin]} ELSE {someI _ TRUE; iMin _ i; jMin _ ijMin; jMax _ ijMax}; }; ENDLOOP; IF someI THEN range _ [ X: [min: ExvertI[h, iMin-0.5, log[X]], max: ExvertI[h, iMax+0.5, log[X]]], Y: [min: ExvertJ[h, jMin-0.5, log[Y]], max: ExvertJ[h, jMax+0.5, log[Y]]]]; FOR k: NATURAL IN [0 .. degree] DO FOR l: NATURAL IN [0 .. degree] DO sums.Sxkl[k][l] _ Sxk[k+l]; ENDLOOP ENDLOOP; degree _ degree}}; ComputeMax: PUBLIC INTERNAL PROC [h: Histogram] = BEGIN h.maxCount _ 0; FOR i: NAT _ 0, i+1 WHILE i < h.data.length DO h.maxCount _ MAX[h.maxCount, h.data.counts[i]]; ENDLOOP; h.maxValid _ TRUE; END; CopyVec: PROC [v: ColumnN, change: NATURAL, x0, x1: REAL _ 0.0] RETURNS [w: ColumnN] ~ { w _ NEW [LinearSystem.VecSeq[v.ncols]]; FOR i: NATURAL IN [change .. v.ncols) DO w[i] _ v[i] ENDLOOP; IF change>0 THEN w[0] _ x0; IF change>1 THEN w[1] _ x1; IF change>2 THEN ERROR; RETURN}; DistSquared: PROC [a, b: VEC] RETURNS [REAL] ~ { c: VEC ~ a.InlineSub[b]; RETURN c.InlineDot[c]}; DispCount: PROC [hv: HistogramView, count: Count] RETURNS [REAL] ~ INLINE {RETURN [IF hv.logarithmic THEN (IF count#0 THEN RealFns.Ln[count]/hv.logFact+1 ELSE 0.0) ELSE count]}; DispToRope: PROC [hv: HistogramView, z: REAL] RETURNS [ROPE] ~ INLINE {RETURN [IF hv.logarithmic THEN Convert.RopeFromReal[IF z#0.0 THEN RealFns.Exp[(z-1)*hv.logFact] ELSE 0.0] ELSE Convert.RopeFromInt[Real.Round[z]]]}; Dot: PROC [a: RowN, b: ColumnN] RETURNS [dot: REAL _ 0.0] ~ { IF a.ncols # b.ncols THEN ERROR; FOR k: NATURAL IN [0 .. a.ncols) DO dot _ dot + a[k]*b[k]; ENDLOOP; dot _ dot}; CeilDiv: PROC [num, den: INT] RETURNS [INT] ~ { IF den < 0 THEN {num _ -num; den _ -den}; IF num > 0 THEN RETURN [(num-1)/den+1]; RETURN [-((-num)/den)]}; FloorDiv: PROC [num, den: INT] RETURNS [INT] ~ { IF den < 0 THEN {num _ -num; den _ -den}; IF num >= 0 THEN RETURN [num/den]; RETURN [-((-(num+1))/den+1)]}; IntMax: PROC [i, j: INT] RETURNS [INT] --to work around compiler bug discovered 11/2/90 ~ {RETURN [MAX[i, j]]}; IntMin: PROC [i, j: INT] RETURNS [INT] --to work around compiler bug discovered 11/2/90 ~ {RETURN [MIN[i, j]]}; MakeExample: PROC ~ { [] _ Show[h: Create1D[], viewerInit: [name: "example"]]; RETURN}; Start: PROC ~ { printFont _ ImagerFont.FindScaled["xerox/xc1-2-2/classic", 10 ! Imager.Warning => { SimpleFeedback.PutF[$Histograms, oneLiner, $Warning, "Imager.Warning[%g, %g] when Finding Histogram print font xerox/xc1-2-2/classic.", [atom[error.code]], [rope[error.explanation]] ]; RESUME}; Imager.Error => { SimpleFeedback.PutF[$Histograms, oneLiner, $Error, "Imager.Error[%g, %g] when Finding Histogram print font xerox/xc1-2-2/classic, will use Viewers default font instead.", [atom[error.code]], [rope[error.explanation]] ]; CONTINUE}]; SetFonts[screenFont, printFont]; Commander.Register["NewHistogram", NewCommand, "creates and views a new histogram"]; Commander.Register["ReadHistogram", ReadCommand, "views histograms from given files"]; RETURN}; Start[]; END. �HistogramsViewingImpl.Mesa Copyright � 1990 by Xerox Corporation. All rights reserved. Last tweaked by Mike Spreitzer on March 23, 1992 4:53 pm PST ��7u�code��K��VK�� K�� K��K��K��K�� #�� ZK�� FK��K��K�� K��)�)K��$K��.�>K��*��vK��K��.�9��K�K��.K�� !��K��K��K�K�� H�^K�� &��YK��)��K��K��K�K��5�5�� K��&�&K��K�� K��K��K��'�� K��K��K��K��'�� K��K��K��K��4�� K��K��K��K��K��K��K� K�K��K��.K��g��u��$�� K��K��K��K��K��'�� K��K� �� *K� �� (�K��:�� K��K��K��K��K��K��K��K��K�K�K��K��K�� $K�� K�GK�&K�RK�YK�"K�f�K��!�!�K�� &��WK��K��)��K��K� ��K��,K��C��K��K�� &�4K��1K��+� ��?K��I��OK��K��,K��4��QK��K� ��%�=K��K��K��K��F��cK�� K��!�!K�K��K��%��F��S�SK��%��7�� 1K��K��K��K�K� �;��F��K��K��K��K��StartOfExpansionL -- [cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]�� wK�K�K��K��L -- [cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]�� xK��:�:��!��(�(K��"�"K��K��K��K��K��#�GK��+K��K��K��$�9K��I��[�K��F�� tK��!�!K�K��K� K��5��NK��)K��K��A��K��%�MK��J�rK��K�� E�� iK��^�d�K��'K�� 0��K��K��+�+K��K��K�� ,K�� ,��K��K��&�&K��K�K��K��K��K��K��K�� 'K�K��#�� K�K�K��K��K�� &��^K��)��K��*�*K��'�'K��*�*K��K��K�� $K�K��(�� K�K�K�K�K�K�K�K�K�K�K� K��K��K�� &��ZK��)K��#K��'��K��:K� �� B�K� ��N��:K��-��3K�K��,�� 6K�� 9K�K��,�� 6K�� 9K�K��,�� 9K�� 8K�K��,��'K��!��'K��,��'K��!��'K��,��'K��!��'K��,��K��&�/K��E�� ]K��>��"K��&��,K��-��K��7� �� J��-K�?K��K��K��K��K��K��K�K��6K�� +��BK��K��<�� K��*K��2��'K��A��[K�� K��T��ZK��T��ZK��K�� K��v��K��K��R�RK��K��v��K��K� ��9��\K��K��%K��K��%K��'K��-�7�� K�� K�� K��K� ��6K�� K��$�(K��K�� K�K��K�K�K��K��$��K�� K��?�?�K��%K��K��K�K��K� ��5��MK�(��$K��$K��%�� K�� K��'�'K��K��K��K��K��K��v��K��K��R�RK��K��v��K�� K��d�4�FK� ��K��%K��%�1K��%�1K�� K�� K�� EK��"�-K��#�/K��<�K��"��'��K��J��hK��/�/K��:�:K��.K��K�� K��+��UK��hK��K��K�� K��K�� K��#��AK��;�;K��$�5K��K�� K��AK�K��K��K��DK��2�2��$K�K�� K�K��K��(�(K��'�'K��K��K��K��NK� �� L��#K�L[from: REAL, precision: Convert.RealPrecision _ 7, useE: BOOL _ FALSE]��'��+K��&��LK��K��!�1K��K�� 5�� K��K��K��K��K��K��K��*K��2��K��K��"�"�K��K�� &�?K��K��K��#��S��K��6�6K��K��K��*��7��K��3K��K��K��8K��!��/K��!��RK��K�� >K��K��!K��OK��K�� ;K��K��&K��K��K��K��K��4K��*K�K� K��K��_K��0K��'�'K�K��K��!��^K� ��K��'�'K��K��QK��!�;K�K��EK��K�� K��e�� K��#��=K��K��PK��K�K��+��0K��%�%K��%�%K�K��0K��%�%K��%�%K��%�%K��%�%K��K�K�K��K��K�� K�� A�xK�� K��,�,��K�� K��%K�[base: REAL, arg: REAL]�� d�o�� &��K� �� LK��oK��>K��!�1K��K��K��K��K�� K��K��GK�� K�� oK�� K��)K��K�� K� �� LK�� K��&K��!�1K��'K��K�K��K�� )K��K��K��K�K�� K�� K��K��K��K��K��sK��K�K�� K��K��K��!K��K��K��K��K�� K�� ,K��K�� 7K��K�� 7K� � �� +��kK�� +��.�tK��K��UK� �gk��K� ��K��'K��.��]K��K�� K�� Q��K� ��K� �gn��K� ��nu��K� ��K� ��K� ��K�� GK��)K� �� K��K��&�wK��K��#�K�� $��0��K�� K��&�8K��K��$K��)��@�K�K��K��*�.K��!�*K��K��K��GK�� B�� K��K��K��K�� K��K�� K��$��:K��!K��K��K��K��K� ��K�� #K� ��"K� �� 0K��K�� *K��K�� *K��K�� K��,K��K��K�� K�� 7K�� (�:�K��K�� K��J�JK��K�K��EK� �� K��K��K�� 1K��K�� .K�� /K��K�� K��K�� XK�� 'K� �� =K�� K�� K�� K��K�� 0K��K��K�� #��@K�� p�K��