HistogramsViewingImpl.Mesa
Copyright Ó 1990 by Xerox Corporation. All rights reserved.
Last tweaked by Mike Spreitzer on March 23, 1992 4:53 pm PST
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 i<d.length
DO
IF d.counts[i]>0
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 [a
k: 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 a
k.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 i<d.length
DO
IF d.counts[i]>0
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 [a
k: 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, a
k: 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.