[_CDMiwok_01_]<cedarcommon2.0>Histograms>HistogramsImpl.mesa!1

HistogramsImpl.Mesa

Last tweaked by Mike Spreitzer on March 16, 1989 4:26:26 pm PST

DIRECTORY Histograms, HistogramsExtras, HistogramsPrivate, IO, Real, RealFns, Rope;

HistogramsImpl: CEDAR MONITOR

LOCKS h USING h: Histogram

IMPORTS HistogramsPrivate, IO, Real, RealFns, Rope

EXPORTS Histograms, HistogramsExtras, HistogramsPrivate =

BEGIN OPEN Histograms, HistogramsExtras, HistogramsPrivate;

Error: PUBLIC ERROR [msg: ROPE] = CODE;

Histogram: TYPE = REF HistogramRep;

HistogramRep: PUBLIC TYPE = HistogramsPrivate.HistogramRep;

BinNameProc: TYPE ~ Histograms.BinNameProc;

Create1D: PUBLIC PROC

[

factor: REAL ← 1.0,

offset: REAL ← 0.0,

logarithmic: BOOL ← FALSE,

BinNamer: BinNameProc ← NIL,

clientData: REF ANY ← NIL]

RETURNS [h: Histogram] =

BEGIN

d: DataRef ← NEW[Data[0]];

h ← NEW [HistogramRep ← [

dimensionality: 1,

BinNamer: BinNamer,

clientData: clientData,

data: d,

iFactor: factor, iOffset: offset, jFactor: 1, jOffset: 0,

xChg: factor, x0: offset, yChg: 1, y0: 0,

log: [logarithmic, FALSE]

]];

IF h.log[X] THEN {h.iOffset ← RealFns.Ln[offset]; h.iFactor ← RealFns.Ln[factor]};

END;

Create2D: PUBLIC PROC

[ --sorry, no labelling yet

iFactor, jFactor: REAL ← 1.0,

iOffset, jOffset: REAL ← 0.0,

logI, logJ: BOOL ← FALSE,

BinNamer: BinNameProc ← NIL,

clientData: REF ANY ← NIL]

RETURNS [h: Histogram] ~ {

h ← NEW [HistogramRep ← [

dimensionality: 2,

BinNamer: BinNamer,

clientData: clientData,

data: NIL,

nI: 1, nJ: 1,

iFactor: iFactor, iOffset: iOffset, jFactor: jFactor, jOffset: jOffset,

xChg: iFactor, x0: iOffset, yChg: jFactor, y0: jOffset,

log: [logI, logJ]

]];

h.data ← NEW [Data[h.nI * h.nJ]];

FOR k: NAT IN [0 .. h.data.length) DO h.data[k] ← 0 ENDLOOP;

IF h.log[X] THEN {h.iOffset←RealFns.Ln[iOffset]; h.iFactor←RealFns.Ln[iFactor]};

IF h.log[Y] THEN {h.jOffset←RealFns.Ln[jOffset]; h.jFactor←RealFns.Ln[jFactor]};

RETURN};

Ensure1: PUBLIC PROC [old: DataRef, n: INT] RETURNS [new: DataRef] = {

oldLen: NAT = IF old # NIL THEN old.length ELSE 0;

n ← MAX[n, 0];

new ← NEW[Data[MIN[n+n/2+1, NAT.LAST]]];

FOR i: NAT ← 0, i+1 WHILE i<oldLen DO

new.counts[i] ← old.counts[i];

ENDLOOP;

FOR i: NAT ← oldLen, i+1 WHILE i<new.length DO

new.counts[i] ← 0;

ENDLOOP;

RETURN};

Ensure2: PROC [h: Histogram, i, j: INT] RETURNS [errMsg: ROPE] ~ {

IF i < h.nI AND j < h.nJ THEN RETURN [NIL];

IF i>=NAT.LAST OR j>=NAT.LAST THEN RETURN ["too much data"];

{oldLen: IntPair ~ [h.nI, h.nJ];

newLen: IntPair ~ [

i: MIN[MAX[i+i/2+1, h.nI], NAT.LAST],

j: MIN[MAX[j+j/2+1, h.nJ], NAT.LAST]];

newArea: INT ~ INT[newLen.i]*newLen.j;

IF newArea>=NAT.LAST THEN RETURN ["too much data"];

{old: DataRef ~ h.data;

new: DataRef ~ h.data ← NEW[Data[newArea]];

nk, ok: NAT ← 0;

FOR i: NAT IN [0 .. oldLen.i) DO

FOR j: NAT IN [0 .. oldLen.j) DO

new[nk] ← old[ok];

nk ← nk + 1;

ok ← ok + 1;

ENDLOOP;

FOR j: NAT IN [oldLen.j .. newLen.j) DO

new[nk] ← 0;

nk ← nk + 1;

ENDLOOP;

FOR i: NAT IN [oldLen.i .. newLen.i) DO

FOR j: NAT IN [0 .. newLen.j) DO

new[nk] ← 0;

nk ← nk + 1;

ENDLOOP;

[h.nI, h.nJ] ← newLen;

RETURN}}};

AddNoter: PUBLIC ENTRY PROC [h: Histogram, n: Noter] ~ {

ENABLE UNWIND => NULL;

h.noters ← CONS[n, h.noters];

RETURN};

RemNoter: PUBLIC ENTRY PROC [h: Histogram, n: Noter] ~ {

ENABLE UNWIND => NULL;

last: NoterList ← NIL;

FOR nl: NoterList ← h.noters, nl.rest WHILE nl # NIL DO

IF nl.first # n THEN last ← nl

ELSE IF last=NIL THEN h.noters ← nl.rest

ELSE last.rest ← nl.rest;

ENDLOOP;

last ← last; RETURN};

BroadcastChange: INTERNAL PROC [h: Histogram, c: ChangeNote] ~ {

h ← h;

FOR nl: NoterList ← h.noters, nl.rest WHILE nl#NIL DO

nl.first.Note[nl.first.data, h, c];

ENDLOOP;

RETURN};

Change: PUBLIC ENTRY PROC [h: Histogram, i: NAT, howMuch: INTEGER] = {

ENABLE UNWIND => NULL;

IF h.dimensionality # 1 THEN RETURN WITH ERROR Error["This is a 1-D proc, stupid"];

{errMsg: ROPE = ChangeInt[h, i, howMuch];

IF errMsg # NIL THEN RETURN WITH ERROR Error[errMsg];

}};

ChangeInt: INTERNAL PROC [h: Histogram, i: NAT, howMuch: INTEGER] RETURNS [errMsg: ROPE ← NIL] = {

IF i < h.data.length THEN NULL

ELSE IF i >= NAT.LAST THEN RETURN["too much data"]

ELSE h.data ← Ensure1[h.data, i];

IF (IF howMuch < 0 THEN h.data.counts[i] < Count[-howMuch] ELSE h.data.counts[i] > Count.LAST-Count[howMuch]) THEN RETURN["counter tried to go out of bounds"];

h.data.counts[i] ← h.data.counts[i] + howMuch;

IF h.maxValid THEN SELECT howMuch FROM

< 0 => h.maxValid ← FALSE;

>= 0 => h.maxCount ← MAX[h.maxCount, h.data.counts[i]];

ENDCASE => ERROR;

BroadcastChange[h, [range: [[i, i], [0, 0]], change: add[howMuch]]];

};

Change2: INTERNAL PROC [h: Histogram, i, j: INT, delta: INTEGER] RETURNS [errMsg: ROPE ← NIL] = {

IF (errMsg ← Ensure2[h, i, j])#NIL THEN RETURN;

{index: INT ~ i*h.nJ + j;

oc: Count ~ h.data.counts[index];

IF (IF delta < 0 THEN oc < Count[-delta] ELSE oc > Count.LAST-Count[delta]) THEN RETURN["counter tried to go out of bounds"];

{nc: Count ~ oc + delta;

h.data.counts[index] ← nc;

IF h.maxValid THEN SELECT delta FROM

< 0 => h.maxValid ← FALSE;

>= 0 => h.maxCount ← MAX[h.maxCount, nc];

ENDCASE => ERROR;

BroadcastChange[h, [[[i, i], [j, j]], add[delta]]];

RETURN}}};

IncrementTransformed: PUBLIC ENTRY PROC [h: Histogram, xmin, xmax, x: REAL] = {

ENABLE UNWIND => NULL;

i: INTEGER ~ InvertI[h, MIN[xmax, MAX[xmin, x]]];

IF i<0 THEN RETURN WITH ERROR Error["That goes to a negative bin, you fool"];

{errMsg: ROPE = ChangeInt[h, i, 1];

IF errMsg # NIL THEN RETURN WITH ERROR Error[errMsg];

}};

Change1DTransformed: PUBLIC ENTRY PROC [h: Histogram, x: REAL, delta: INTEGER ← 1] ~ {

i: INTEGER ~ InvertI[h, x];

IF h.dimensionality#1 THEN RETURN WITH ERROR Error["not 1d"];

IF i<0 THEN RETURN WITH ERROR Error["sample out of range"];

{errMsg: ROPE ~ ChangeInt[h, i, delta];

IF errMsg # NIL THEN RETURN WITH ERROR Error[errMsg];

RETURN}};

ChangeTransformed: PUBLIC ENTRY PROC [h: Histogram, x: REAL, y: REAL ← 0, delta: INTEGER ← 1] = {

ENABLE UNWIND => NULL;

ip: IntPair ~ IF h.dimensionality=2 THEN Invert2[h, x, y] ELSE [InvertI[h, x], 0];

IF ip.i<0 OR ip.j<0 THEN RETURN WITH ERROR Error["sample point out of range"];

{errMsg: ROPE = SELECT h.dimensionality FROM

1 => ChangeInt[h, ip.i, delta],

2 => Change2[h, ip.i, ip.j, delta],

ENDCASE => ERROR;

IF errMsg # NIL THEN RETURN WITH ERROR Error[errMsg];

}};

ClearAll: PUBLIC ENTRY PROC [h: Histogram] = {

ENABLE UNWIND => NULL;

FOR i: NAT IN [0 .. h.data.length) DO h.data[i] ← 0 ENDLOOP;

h.maxCount ← 0; h.maxValid ← TRUE;

SELECT h.dimensionality FROM

1 => BroadcastChange[h, [[[0, h.data.length-1], [0, 0]], set[0]]];

2 => BroadcastChange[h, [[[0, h.nI-1], [0, h.nJ-1]], set[0]]];

ENDCASE => ERROR;

};

ReadSpecs: PUBLIC PROC [from: IO.STREAM] RETURNS [create: CreateData ← NIL, show: ShowData ← NIL] ~ {

ENABLE IO.Error => IF ec=SyntaxError THEN Error["Syntax"];

dim: NATURAL ← 0;

[] ← from.SkipWhitespace[];

SELECT from.PeekChar[] FROM

'1 => {dim ← 1; EXIT};

'2 => {dim ← 2; EXIT};

's => {

show ← NEW [ShowDataPrivate ← []];

IF NOT from.GetID[].Equal["show"] THEN Error["Syntax"];

IF NOT from.GetCedarTokenRope[].token.Equal["["] THEN Error["Syntax"];

IF NOT from.GetID[].Equal["format"] THEN Error["Syntax"];

IF NOT from.GetCedarTokenRope[].token.Equal[":"] THEN Error["Syntax"];

show.format ← from.GetRopeLiteral[];

IF NOT from.GetCedarTokenRope[].token.Equal[","] THEN Error["Syntax"];

IF NOT from.GetID[].Equal["width"] THEN Error["Syntax"];

IF NOT from.GetCedarTokenRope[].token.Equal[":"] THEN Error["Syntax"];

show.width ← from.GetInt[];

IF NOT from.GetCedarTokenRope[].token.Equal[","] THEN Error["Syntax"];

IF NOT from.GetID[].Equal["base"] THEN Error["Syntax"];

IF NOT from.GetCedarTokenRope[].token.Equal[":"] THEN Error["Syntax"];

show.base ← from.GetReal[];

IF NOT from.GetCedarTokenRope[].token.Equal["]"] THEN Error["Syntax"];

};

'o => {

cd: REF CreateDataPrivate[oneD] ~ NEW [CreateDataPrivate[oneD] ← [oneD[]]];

IF NOT from.GetID[].Equal["oneD"] THEN Error["Syntax"];

IF NOT from.GetCedarTokenRope[].token.Equal["["] THEN Error["Syntax"];

IF NOT from.GetID[].Equal["factor"] THEN Error["Syntax"];

IF NOT from.GetCedarTokenRope[].token.Equal[":"] THEN Error["Syntax"];

cd.factor ← from.GetReal[];

IF NOT from.GetCedarTokenRope[].token.Equal[","] THEN Error["Syntax"];

IF NOT from.GetID[].Equal["offset"] THEN Error["Syntax"];

IF NOT from.GetCedarTokenRope[].token.Equal[":"] THEN Error["Syntax"];

cd.offset ← from.GetReal[];

IF NOT from.GetCedarTokenRope[].token.Equal[","] THEN Error["Syntax"];

IF NOT from.GetID[].Equal["log"] THEN Error["Syntax"];

IF NOT from.GetCedarTokenRope[].token.Equal[":"] THEN Error["Syntax"];

cd.log ← from.GetBool[];

IF NOT from.GetCedarTokenRope[].token.Equal["]"] THEN Error["Syntax"];

create ← cd};

't => {

cd: REF CreateDataPrivate[twoD] ~ NEW [CreateDataPrivate[twoD] ← [twoD[]]];

IF NOT from.GetID[].Equal["twoD"] THEN Error["Syntax"];

IF NOT from.GetCedarTokenRope[].token.Equal["["] THEN Error["Syntax"];

IF NOT from.GetID[].Equal["factors"] THEN Error["Syntax"];

IF NOT from.GetCedarTokenRope[].token.Equal[":"] THEN Error["Syntax"];

cd.iFactor ← from.GetReal[];

cd.jFactor ← from.GetReal[];

IF NOT from.GetCedarTokenRope[].token.Equal[","] THEN Error["Syntax"];

IF NOT from.GetID[].Equal["offsets"] THEN Error["Syntax"];

IF NOT from.GetCedarTokenRope[].token.Equal[":"] THEN Error["Syntax"];

cd.iOffset ← from.GetReal[];

cd.jOffset ← from.GetReal[];

IF NOT from.GetCedarTokenRope[].token.Equal[","] THEN Error["Syntax"];

IF NOT from.GetID[].Equal["log"] THEN Error["Syntax"];

IF NOT from.GetCedarTokenRope[].token.Equal[":"] THEN Error["Syntax"];

cd.log[X] ← from.GetBool[];

cd.log[Y] ← from.GetBool[];

IF NOT from.GetCedarTokenRope[].token.Equal["]"] THEN Error["Syntax"];

create ← cd};

ENDCASE => Error["Syntax"];

ENDLOOP;

IF show=NIL THEN show ← NEW [ShowDataPrivate ← [base: 2]];

IF create=NIL THEN SELECT dim FROM

1 => create ← NEW [CreateDataPrivate ← [oneD[]]];

2 => create ← NEW [CreateDataPrivate ← [twoD[]]];

ENDCASE => ERROR;

RETURN};

AddFrom: PUBLIC PROC [h: Histogram, from: IO.STREAM] ~ {

ENABLE IO.Error => IF ec=SyntaxError THEN Error["Syntax"];

dimKey: CHAR ~ from.GetChar[];

IF NOT dimKey IN ['1 .. '2] THEN Error["Syntax"];

IF h.dimensionality # dimKey - '0 THEN ERROR;

IF from.GetChar[] # '[ THEN Error["Syntax"];

SELECT h.dimensionality FROM

1 => {

first: BOOL ← TRUE;

WHILE from.PeekChar[] # '] DO

x: REAL;

c: CARD;

IF first THEN first ← FALSE ELSE IF from.GetChar[] # ', THEN Error["Syntax"];

c ← from.GetCard[];

IF NOT from.GetTokenRope[IO.IDProc].token.Equal["of"] THEN Error["Syntax"];

x ← from.GetReal[];

WHILE c>0 DO

d: INTEGER ~ MIN[c, INTEGER.LAST];

ChangeTransformed[h, x, 0, d];

c ← c - d;

ENDLOOP;

IF from.PeekChar[] = '" THEN [] ← from.GetRopeLiteral[];

ENDLOOP;

h ← h};

2 => {

firstI: BOOL ← TRUE;

WHILE from.PeekChar[] # '] DO

firstJ: BOOL ← TRUE;

x: REAL;

IF firstI THEN firstI ← FALSE ELSE IF from.GetChar[] # ', THEN Error["Syntax"];

x ← from.GetReal[];

IF from.GetChar[] # ': THEN Error["Syntax"];

IF from.GetChar[] # ' THEN Error["Syntax"];

IF from.GetChar[] # '[ THEN Error["Syntax"];

WHILE from.PeekChar[] # '] DO

y: REAL;

c: CARD;

IF firstJ THEN firstJ ← FALSE ELSE IF from.GetChar[] # ', THEN Error["Syntax"];

y ← from.GetReal[];

IF from.PeekChar[] = '" THEN [] ← from.GetRopeLiteral[];

IF from.GetChar[] # ': THEN Error["Syntax"];

c ← from.GetCard[];

WHILE c>0 DO

d: INTEGER ~ MIN[c, INTEGER.LAST];

ChangeTransformed[h, x, y, d];

c ← c - d;

ENDLOOP;

IF NOT firstJ THEN IF from.GetChar[] # '] THEN Error["Syntax"];

ENDLOOP;

h ← h};

ENDCASE => ERROR;

IF from.GetChar[] # '] THEN Error["Syntax"];

RETURN};

Enumerate: PUBLIC PROC [h: Histogram, range: RealRange2 ← fullRealRange2, Consume: PROC [x, y: REAL, n: CARD] RETURNS [BOOL--TRUE to stop--]] RETURNS [found: BOOL ← FALSE, x, y: REAL ← 0.0] ~ {

d: DataRef ~ h.data;

min: IntPair ~ Invert2[h, MAX[range[X].min, ExvertI[h, 0]], MAX[range[Y].min, ExvertJ[h, 0]]];

max: IntPair ~ Invert2[h, MIN[range[X].max, ExvertI[h, h.nI-1]], MIN[range[Y].max, ExvertJ[h, h.nJ-1]]];

SELECT h.dimensionality FROM

1 => {

FOR i: NAT IN [min.i .. max.i] DO

n: CARDINAL ~ d[i];

IF n#0 THEN {

x ← ExvertI[h, i];

IF Consume[x, 0.0, n] THEN RETURN [TRUE, x, 0.0]};

ENDLOOP;

RETURN [FALSE]};

2 => {

FOR i: INT IN [min.i .. max.i] DO

index: INT ← i*h.nJ + min.j;

x ← ExvertI[h, i];

FOR j: INT IN [min.j .. max.j] DO

n: CARDINAL ~ d[index];

IF n#0 THEN {

y ← ExvertJ[h, j];

IF Consume[x, y, n] THEN RETURN [TRUE, x, y]};

index ← index + 1;

ENDLOOP;

RETURN [FALSE]};

ENDCASE => ERROR};

Project: PUBLIC PROC [h: Histogram, cx, cy: REAL] RETURNS [p: Histogram] ~ {

Consume: PROC [x, y: REAL, n: CARD] RETURNS [BOOL] ~ {

Change1DTransformed[p, cx*x + cy*y, n];

RETURN [FALSE]};

xo: REAL ~ ExvertI[h, 0]*cx;

yo: REAL ~ ExvertJ[h, 0]*cy;

IF h.dimensionality#2 THEN ERROR;

IF h.log[X] # h.log[Y] THEN ERROR;

p ← Create1D[MaybeEx[(h.iFactor*cx+h.jFactor*cy)/(cx+cy), h.log[X]], IF cx=0 THEN yo ELSE IF cy=0 THEN xo ELSE MIN[xo, yo], h.log[X], NIL, NIL];

IF Enumerate[h, fullRealRange2, Consume].found THEN ERROR;

RETURN};

END.