<> <> <> DIRECTORY BiScrollers, Commander, CommandTool, Convert, FS, Geom2D, Histograms, HistogramsExtras, HistogramsOut, HistogramsPrivate, HistogramsViewing, HistogramsViewingExtras, HistogramsViewingPrivate, Icons, Imager, ImagerBackdoor, ImagerBox, ImagerColor, ImagerFont, ImagerInterpress, 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 BiScrollers, Commander, CommandTool, Convert, FS, Geom2D, Histograms, HistogramsExtras, HistogramsPrivate, Icons, Imager, ImagerBackdoor, ImagerBox, ImagerColor, ImagerFont, ImagerInterpress, 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 BS:BiScrollers, IT:ImagerTransformation, PUB:PopUpButtons, SS:StructuredStreams, UB:UnparserBuffer, VF:VFonts, VFk:ViewerForkers, VO:ViewerOps, Histograms, HistogramsOut, HistogramsPrivate, HistogramsViewingPrivate; Font: TYPE ~ ImagerFont.Font; 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: BS.BiScrollerClass ~ bsStyle.NewBiScrollerClass[[ flavor: $Histogram, extrema: Extrema, notify: Notify, paint: Paint, destroy: Destroy, tipTable: TIPUser.InstantiateNewTIPTable["Histograms.tip"], mayStretch: FALSE, 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]; }; viewerInit.data _ hv _ NEW [HistogramViewRep _ [ h: h, logarithmic: base > 1.0, logFact: IF base>1.0 THEN RealFns.Ln[base] ELSE 0.0, iFormat: IF format.Length[] = 0 THEN "%d" ELSE format, iChars: IF width = 0 THEN 5 ELSE width, vFreq: vFreqInitial, dHeight: dHeightInitial, dWidth: 5, 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.minHLabSep _ Real.Round[hv.iChars * digWid * 1.2]; hv.iFreq _ MAX[Real.Ceiling[IntMax[hv.minHLabSep, cw/maxILabs]/hv.dWidth], 1]; hv.cWidth _ 0.8 * hv.dWidth; hv.bs _ bsStyle.CreateBiScroller[class: histogramViewer, 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 { Place[vScale.Instantiate[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE, name: "V-Scale"], hv, NIL, NIL, FALSE]]; Place[hScale.Instantiate[[parent: hv.ctr, wx: x, wy: yTop, border: FALSE, name: "H-Scale"], hv, NIL, NIL, FALSE]]; } 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[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. MessageWindow.Append[ message: IO.PutFR[ "count=%g; sum=<%g,%g>", IO.int[count], IO.real[sums. IO.real[sums. clearFirst: TRUE]; IF count > 0 THEN MessageWindow.Append[ message: IO.PutFR[ "; avg=<%g,%g>", IO.real[sums. IO.real[sums. 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"], [$DrawToFile, "Create an interpress master of viewer contents"]], 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]]; }; $DrawToFile => { fileName: ROPE ~ ViewerTools.GetSelectionContents[]; writtenName: ROPE; width, height: REAL; [writtenName, width, height] _ ToIP[hv.ctr, fileName !FS.Error => { MessageWindow.Append[Rope.Cat["File create error: ", error.explanation], TRUE]; GOTO Dun}]; MessageWindow.Append[IO.PutFR["%g is %g by %g", [rope[FS.ExpandName[writtenName].fullFName]], [real[width]], [real[height]]], TRUE]; key _ key}; $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}; vScale: PUB.Class _ PUB.MakeClass[[proc: TweakVScale, choices: LIST[[$DoubleResolution], [$Fit], [$HalveResolution], [NIL], [$Reset], [NIL]] ]]; TweakVScale: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = { viewer: Viewer = NARROW[view]; hv: HistogramView = NARROW[instanceData]; EnterAndTweakV: ENTRY PROC [h: Histogram] = { ENABLE UNWIND => NULL; TweakVWithLock[h]; RETURN}; TweakVWithLock: INTERNAL PROC [h: Histogram] = { SELECT key FROM $DoubleResolution => IF hv.dHeight < 16384 THEN { hv.dHeight _ hv.dHeight * 2; hv.vFreq _ MAX[(hv.vFreq + 1) / 2, 1]; VFk.ForkPaint[viewer: hv.bsOuter, hint: client, clearClient: TRUE]; }; $HalveResolution => IF hv.dHeight > 1.0/16384 THEN { hv.dHeight _ hv.dHeight / 2; hv.vFreq _ MIN[hv.vFreq, 16383] * 2; VFk.ForkPaint[viewer: hv.bsOuter, hint: client, clearClient: TRUE]; }; $Fit => { IF NOT h.maxValid THEN ComputeMax[h]; IF h.maxCount >= 1 THEN { ySpacing: INTEGER ~ fontHeight + 1; vMin, vMax: BS.Vec; dHeightNew, yf: REAL; [vMin, vMax] _ hv.bs.ViewportExtrema[[0, 1]]; dHeightNew _ 0.95 * (vMax.y - (vMin.y + ySpacing * 2)) / DispCount[hv, hv.h.maxCount]; IF dHeightNew > 0 AND ySpacing < 32000*dHeightNew THEN { yf _ ySpacing / dHeightNew; hv.dHeight _ dHeightNew; hv.vFreq _ MAX[Real.Ceiling[yf], 1]; VFk.ForkPaint[viewer: hv.bsOuter, hint: client, clearClient: TRUE]; }; }; }; $Reset => { hv.dHeight _ dHeightInitial; hv.vFreq _ vFreqInitial; VFk.ForkPaint[viewer: hv.bsOuter, hint: client, clearClient: TRUE]; }; ENDCASE => ERROR; }; EnterAndTweakV[hv.h]; }; hScale: PUB.Class _ PUB.MakeClass[[proc: TweakHScale, choices: LIST[[$DoubleResolution], [$Fit], [$HalveResolution], [$Set], [$Reset], [NIL]] ]]; TweakHScale: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = { viewer: Viewer = NARROW[view]; hv: HistogramView = NARROW[instanceData]; cw: NAT = hv.bs.QuaViewer[TRUE].cw; EnterAndTweakH: ENTRY PROC [h: Histogram] = { ENABLE UNWIND => NULL; TweakHWithLock[h]; RETURN}; TweakHWithLock: INTERNAL PROC [h: Histogram] = { SELECT key FROM $DoubleResolution => IF hv.dWidth < 16384 THEN hv.dWidth _ Real.Ceiling[hv.dWidth * 2] ELSE RETURN; $HalveResolution => IF hv.dWidth > 1 THEN hv.dWidth _ Real.Ceiling[hv.dWidth / 2] ELSE RETURN; $Fit => { vMin, vMax: BS.Vec; [vMin, vMax] _ hv.bs.ViewportExtrema[[1, 0]]; IF NOT h.maxValid THEN ComputeMax[h]; IF h.maxCount # hv.maxCountForR OR hv.vFreqForR # hv.vFreq THEN ComputeR[hv]; hv.dWidth _ IntMax[Real.Floor[(vMax.x - vMin.x + axorg.x-axsr - tl - ls - hv.rxmax + hv.rxmin - leftFudge) / (IMax[h]+1)], 1]; view _ view}; $Reset => IF hv.dWidth # 5 THEN hv.dWidth _ 5 ELSE RETURN; $Set => { ENABLE IO.Error => { MessageWindow.Append["Select or when you do that", TRUE]; GOTO Crapout}; in: IO.STREAM ~ IO.RIS[ViewerTools.GetSelectionContents[]]; hv.dWidth _ in.GetReal[]; hv.cWidth _ IF minEven<=hv.dWidth AND hv.dWidth<=5 THEN hv.dWidth-1 ELSE (0.8*hv.dWidth); [] _ in.SkipWhitespace[]; IF in.EndOf[] THEN hv.iFreq _ MAX[Real.Ceiling[IntMax[hv.minHLabSep, cw/maxILabs]/hv.dWidth], 1] ELSE hv.iFreq _ in.GetInt[]; VFk.ForkPaint[viewer: hv.bsOuter, hint: client, clearClient: TRUE]; RETURN}; ENDCASE => ERROR; hv.cWidth _ IF minEven<=hv.dWidth AND hv.dWidth<=5 THEN hv.dWidth-1 ELSE (0.8*hv.dWidth); hv.iFreq _ MAX[Real.Ceiling[IntMax[hv.minHLabSep, cw/maxILabs]/hv.dWidth], 1]; VFk.ForkPaint[viewer: hv.bsOuter, hint: client, clearClient: TRUE]; RETURN; EXITS Crapout => key _ key}; EnterAndTweakH[hv.h]; }; 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}; ToIP: PROC [self: Viewer, fileName: ROPE _ NIL] RETURNS [writtenName: ROPE, width, height: REAL] ~ { hv: HistogramView ~ NARROW[MJSContainers.GetClientData[self]]; asBS: BiScroller ~ hv.bs; xfm: BS.Transform ~ asBS.style.GetTransforms[asBS].clientToViewer; IF fileName.Length=0 THEN fileName _ self.name.Concat[".ip"] ELSE IF fileName.Find["."]<0 THEN fileName _ fileName.Concat[".ip"]; {file: ImagerInterpress.Ref ~ ImagerInterpress.Create[fileName]; PaintPage: PROC [context: Imager.Context] ~ { context.ConcatT[xfm]; SELECT hv.h.dimensionality FROM 1 => Paint1D[self, asBS, hv.h, hv, context, NIL, printFont, TRUE, FALSE]; 2 => Paint2D[self, asBS, hv.h, hv, context, NIL, printFont, TRUE, FALSE]; ENDCASE => ERROR; RETURN}; file.DoPage[PaintPage, Imager.metersPerInch/ppi]; file.Close[]; RETURN [fileName, self.cw/ppi, self.ch/ppi]}}; ppi: REAL _ 72.0; Paint: PROC [self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL _ FALSE] --ViewerClasses.PaintProc-- ~ { asBS: BiScroller = BS.QuaBiScroller[self]; hv: HistogramView = NARROW[asBS.ClientDataOf[]]; {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, whatChanged, screenFont, clear, TRUE]; 2 => Paint2D[self, asBS, hv.h, hv, context, whatChanged, screenFont, clear, TRUE]; ENDCASE => ERROR; RETURN}}; Paint1D: ENTRY PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, context: Imager.Context, whatChanged: REF ANY, font: Font, clear, latch: BOOL] = { ENABLE UNWIND => NULL; InnerPaint1D[self, asBS, h, hv, context, whatChanged, font, clear, latch]; RETURN}; InnerPaint1D: INTERNAL PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, context: Imager.Context, whatChanged: REF ANY, font: Font, clear, latch: BOOL] ~ { dwr: REAL = hv.dWidth; maxi: INT ~ IMax[h]; i, iMin, iMax, k, kMin, kMax: INT; xMin, xMax, yMin, yMax: BS.Vec; IF NOT h.maxValid THEN ComputeMax[h]; {incremental: BOOL = NOT clear; mz: REAL ~ DispCount[hv, h.maxCount]; [xMin, xMax] _ asBS.ViewportExtrema[[1, 0]]; iMin _ MAX[Real.Floor[xMin.x/hv.dWidth], 0]; iMax _ MIN[Real.Floor[xMax.x/hv.dWidth], 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]; IF NOT incremental THEN { showns: DataRef = hv.shown; actuals: DataRef = h.data; iMax2: INT ~ MIN[iMax, maxi]; iMinS: INT ~ CeilDiv[iMin, hv.iFreq] * hv.iFreq; iMaxS: INT ~ hv.iFreq * MIN[ CeilDiv[iMax2, hv.iFreq], Real.Floor[xMax.x/(hv.dWidth*hv.iFreq)]]; [yMin, yMax] _ asBS.ViewportExtrema[[0, 1]]; kMin _ hv.vFreq * MAX[Real.Ceiling[yMin.y/(hv.dHeight*hv.vFreq)], 0]; kMax _ hv.vFreq * MAX[MIN[ Real.Floor[yMax.y/(hv.dHeight*hv.vFreq)], Real.Ceiling[mz/hv.vFreq], Real.Floor[DispCount[hv, MIN[Count.LAST, INT.LAST]]/hv.vFreq]], 0]; IF NOT clear THEN { context.SetColor[Imager.white]; context.MaskBox[[xMin.x, yMin.y, xMax.x, yMax.y]]; context.SetColor[Imager.black]; }; context.SetStrokeWidth[axsr*2]; context.SetStrokeEnd[butt]; context.MaskVector[[axorg.x, axorg.y-axsr], [axorg.x, hv.dHeight*kMax]]; context.MaskVector[[axorg.x-axsr, axorg.y], [dwr*(MAX[iMax2, iMaxS]+1), axorg.y]]; Imager.SetFont[context, font]; context.SetStrokeWidth[ts*2]; FOR i _ iMinS, i+hv.iFreq WHILE i <= iMaxS DO r: ROPE = IO.PutFR[hv.iFormat, IO.real[ExvertI[h, i]]]; xmin, xmax, ymin, ymax, cx: REAL; cx _ dwr*i + hv.cWidth/2; context.MaskVector[[cx, axorg.y-axsr], [cx, axorg.y-axsr-tl]]; [[xmin, ymin, xmax, ymax]] _ ImagerBox.BoxFromExtents[font.RopeBoundingBox[r]]; context.SetXY[[cx - (xmin+xmax)/2, axorg.y-axsr-tl-ls-ymax]]; context.ShowRope[r]; ENDLOOP; FOR k _ kMin, k+hv.vFreq WHILE k <= kMax DO r: ROPE = DispToRope[hv, k]; xmin, ymin, xmax, ymax, cy: REAL; cy _ hv.dHeight*k; context.MaskVector[[axorg.x-axsr-tl, cy], [axorg.x-axsr, cy]]; [[xmin, ymin, xmax, ymax]] _ ImagerBox.BoxFromExtents[font.RopeBoundingBox[r]]; context.SetXY[[axorg.x-axsr-tl-ls-xmax, cy - (ymin+ymax)/2]]; context.ShowRope[r]; ENDLOOP; context.SetStrokeWidth[hv.cWidth]; FOR i _ iMin, i+1 WHILE i <= iMax DO IF actuals[i]>0 THEN { cx: REAL ~ i*dwr+hv.cWidth/2; context.MaskVector[[cx, 0], [cx, DispCount[hv, actuals[i]]*hv.dHeight]]}; 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]]; SELECT <0 => context.MaskRectangle[[i*dwr, ay*hv.dHeight, hv.cWidth, - =0 => NULL; >0 => context.MaskRectangle[[i*dwr, sy*hv.dHeight, hv.cWidth, ENDCASE => ERROR; showns[i] _ actuals[i]; ENDLOOP; }; hv.bad _ nullRange2; }}; Paint2D: ENTRY PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, context: Imager.Context, whatChanged: REF ANY, font: Font, clear, latch: BOOL] = { ENABLE UNWIND => NULL; InnerPaint2D[self, asBS, h, hv, context, whatChanged, font, clear, latch]; RETURN}; InnerPaint2D: INTERNAL PROC [self: Viewer, asBS: BiScroller, h: Histogram, hv: HistogramView, context: Imager.Context, whatChanged: REF ANY, font: Font, clear, latch: BOOL] = { viMin, viMax, vjMin, vjMax: INT; iMin, iMax, jMin, jMax: INT; xMin, xMax, yMin, yMax: VEC; 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; [xMin, xMax] _ asBS.ViewportExtrema[[1, 0]]; [yMin, yMax] _ asBS.ViewportExtrema[[0, 1]]; viMin _ MAX[Real.Round[xMin.x], 0]; viMax _ MIN[Real.Round[xMax.x], h.nI-1]; vjMin _ MAX[Real.Round[yMin.y], 0]; vjMax _ MIN[Real.Round[yMax.y], 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]; nb, ny: INTEGER; 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]; IF h.maxCount # hv.maxCountForR OR hv.vFreqForR # hv.vFreq THEN ComputeR[hv]; nb _ CeilDiv[h.data.length-1, hv.iFreq]; ny _ Real.Ceiling[DispCount[hv, h.maxCount] / hv.vFreq]; [min, max] _ Geom2D.ExtremaOfRect[ ImagerBox.RectangleFromBox[[ axorg.x-axsr - tl - ls - hv.rxmax + hv.rxmin - leftFudge, axorg.y-axsr-tl-ls-fontHeight, hv.dWidth*REAL[IMax[h]+1], hv.dHeight*ny*hv.vFreq+fontHeight*0.5]], direction]; }; 2 => [min, max] _ Geom2D.ExtremaOfRect[ [-0.5, -0.5, h.nI, h.nJ], direction]; ENDCASE => ERROR; }; RETURN WithLock[hv.h]}; ComputeR: INTERNAL PROC [hv: HistogramView] = { r: ROPE ~ DispToRope[hv, DispCount[hv, hv.h.maxCount]]; [[hv.rxmin, , hv.rxmax, ]] _ ImagerBox.BoxFromExtents[screenFont.RopeBoundingBox[r]]; hv.vFreqForR _ hv.vFreq; hv.maxCountForR _ hv.h.maxCount; }; Vanilla: PROC [bs: BS.BiScroller] RETURNS [t: BS.Transform] --BS.TransformGenerator-- = { hv: HistogramView = NARROW[bs.ClientDataOf[]]; WithLock: ENTRY PROC [h: Histogram] = { ENABLE UNWIND => NULL; IF NOT h.maxValid THEN ComputeMax[h]; IF h.maxCount # hv.maxCountForR OR hv.vFreqForR # hv.vFreq THEN ComputeR[hv]; t _ IT.Translate[[axsr-axorg.x + tl + ls + hv.rxmax - hv.rxmin + leftFudge, axsr-axorg.y+tl+ls+fontHeight]]; }; WithLock[hv.h]; }; Find1D: INTERNAL PROC [hv: HistogramView, wo: BS.ClientCoords] RETURNS [index: NAT, valid: BOOL] ~ { i: INT; IF wo.x < -hv.dWidth OR wo.x > hv.dWidth * (INT[hv.h.data.length] + 1) THEN RETURN [0, FALSE]; i _ Real.Round[(wo.x - hv.cWidth/2.0) / hv.dWidth]; 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[asBS.ClientDataOf[]]; 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.fit 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.fit 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, 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+ 2 => IO.PutFR["<%g, %g>", [real[ExvertI[h, i+ 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[asBS.ClientDataOf[]]; 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.fit RETURN [[FmtErr[hv], TRUE]]}; }; FmtErr: PROC [hv: HistogramView] RETURNS [ans: ROPE] ~ { ans _ IO.PutFR["sigma = %g", [real[hv.fit IF hv.fitDegree=1 THEN ans _ ans.Concat[IO.PutFR["; rho = %g", [real[hv.fit 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, IF {ENABLE Real.RealException => CONTINUE; ak _ LinearSystem.SolveN[LinearSystem.Copy[sums. [ RETURN}}; EvalError: PUBLIC PROC [sums: Sums2D, ak: ColumnN] RETURNS [ IF sums.degree > 0 THEN { d2: REAL ~ RealFns.SqRt[MAX[( IF d2#0.0 THEN IF ak]]) / ( 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; someI: BOOL _ FALSE; iMin, iMax, jMin, jMax: INTEGER _ 0; {ENABLE Real.RealException => {sums.exception _ TRUE; CONTINUE}; sums _ [ degree: degree, exception: FALSE, ]; FOR k: NATURAL IN [0 .. degree] DO FOR k: NATURAL IN (degree .. twiceDegree] DO 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; sums. sums. FOR k: NATURAL IN [1 .. degree] DO sums. twoK _ twoK + 1; twoK _ twoK + 1; 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. 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.