#pragma mode( separator(.,;) integer(h32) )

// ============================================================
// DNAMIXLR - beta 3c
// Likelihood ratio for a DNA mixture, with coancestry (theta)
// ============================================================
// Author: Roger Metcalf, 2026.  Written with AI assistance
//   (Anthropic Claude); concept, direction and all hardware
//   testing by the author.
//
// The statistics follow the NRC II report (1996), recommendation
//   4.2, as extended to mixtures by Weir, Triggs, Starling, Stowell,
//   Walsh and Buckleton (J Forensic Sci 1997;42:213-222) and, with
//   coancestry, by Curran, Triggs, Buckleton and Weir (J Forensic
//   Sci 1999;44:987-995).  Fung and Hu's DNAMIXTURE program (2000)
//   implements the same model; this is a new implementation for
//   the Prime, written for the classroom, not a translation.
//
// FREE FOR EDUCATIONAL AND PERSONAL USE.  Keep this header with
//   the file and credit the author if you pass it on.  Not for
//   sale or commercial redistribution.  Provided as is, with no
//   warranty: this is a TEACHING tool.  Casework needs validated
//   software and a qualified analyst.
// DISCLAIMER: a teaching and demonstration aid. Not validated for forensic, clinical or legal use; do not rely on its results for legal purposes.
//
// Firmware: written for the 2026-09-09 firmware (2.4.2).  No beta
//   (1 to 3c) has been run on hardware.  On the HP Prime Virtual
//   Calculator (2.4.2, build 2026-09-09, the calculators' firmware):
//   beta 2 passed round 1 (17 Oct 2026); beta 3a ran in round 2 (17
//   Oct 2026), where the main menu still cut "Results table (tap a
//   row to drop it)" (fixed in 3b); beta 3b ran in the retest that
//   afternoon (the LR formula for all three loci, exact).  Beta 3c
//   has run only in the PC harness.  The CAS's fallback has never
//   been needed on the emulator.
//
// Run DNAMixLR() from the Program Catalog.
//
// What changed in beta 3c (19 Oct 2026): B1, B2 and B4 of the fleet
//   review (19 Oct 2026, findings_E), dmProb without cancellation,
//   and the teaching-aid notice.  Line numbers are beta 3b's.
//   Nothing else changed; dmKnowns, dmTyped and dmEval are still
//   byte for byte beta 2's.
//   * B1, A REFUSED UNKNOWN COUNT WAS KEPT.  dmSetHyp's custom path
//     stored the new hypotheses (1338-1339) and only then tested the
//     unknown counts (1340): "Unknown contributors: 5" showed the
//     "0 to 4" box, but dmHp kept the 5, the menu read "V + S + 5
//     unknowns" and every locus was worked with five (a typed -1 was
//     kept the same way, and gave P = 0 everywhere).  The counts are
//     now tested FIRST, and nothing is stored when one is refused.
//     The yes/no answers are forced to 1 or 0 (1327, 1338-1339):
//     "Victim typed? = 2" was stored as 2, which every "== 1" test
//     read as "not typed" while dmAskGen still asked for the
//     victim's genotype.  Now anything but 1 is "no".
//   * B2, THE RIGHT REASON FOR AN LR OF 0.  The locus page (2429-
//     2432) and its formula view (2346-2350) always said "a known
//     contributor under Hp has an allele the mixture does not show".
//     dmProb also gives 0 when the knowns plus the x unknowns cannot
//     supply every allele of M (804): V 12/13 + S 14/14 cannot
//     explain {12, 13, 14, 15}, though S's alleles are all in M.  The
//     page now tests which reason holds, as dmProb does, and says
//     that one; if neither holds, P(E|Hp) underflowed (below the
//     smallest number the calculator holds) and the page says so.
//     "1 alleles" in the caption under the boxes (2474) is "1 allele".
//   * dmProb ADDS WITHOUT SUBTRACTING (785-838).  Its inclusion-
//     exclusion sum alternated in sign, and with rare alleles and
//     three or four unknowns the terms cancelled below the 12th
//     digit: a custom S + 4 unknowns vs V + 4 unknowns with exact LR
//     6.64E-7 was reported as an EXCLUSION, and V + S + 3 unknowns
//     vs V + 4 unknowns, exact LR 3.6E5, as "Hd cannot produce this
//     mixture" (the review's 12-digit model; the PC's 16 digits fail
//     the same way).  The same probability, the same model, is now
//     summed allele by allele over how many of the 2x unknown alleles
//     each allele takes (dmProb's comment has the algebra): every
//     term is positive, so about 10 digits survive however small the
//     answer.  It is also about 10 times less work at the limits.
//   * B4, THE ENFSI SCALE IN HELP (2868).  Help page 2 said "LR 1-10
//     weak"; dmVerbal and dmBand call 1 to 2 "about equal support"
//     and start "weak" at 2, as the ENFSI 2015 scale does.  The help
//     line now says "LR 2-10 weak".
//   * THE NOTICE ON SCREEN (Roger, 19 Oct 2026, 12:48): the DISCLAIMER
//     line above, and on the screen "Teaching aid; not for casework or
//     legal use." in red on help page 1 (the program has no opening or
//     About page; its later lines move up 3 and 6 px to make room), on
//     the Results table (dmCombLines), the locus page and the
//     prosecutor's fallacy page.  There the two red lines "The LR is
//     NOT the probability that the / suspect contributed." are now
//     "The LR is NOT P(the suspect contributed)." and the notice, so no
//     page grows (the Results table is full at 12 loci).  The three
//     plots have no free line, so they carry "Teaching aid only" in red
//     at the right of the title row; their titles move left to make
//     room, and the ladder's reads "ENFSI ladder by locus".
//
// What changed in beta 3b (17 Oct 2026): the round-2 emulator fixes.
//   Line numbers are beta 3a's.  Nothing else changed.
//   * THE EMPTY STRING.  Typed in Home on the emulator,
//     INSTRING("", "a") is "Error: Invalid input".  dmCas (509-529)
//     sets its answer to "" when the CAS fails and then searched it
//     for "undef"; dmFxMake (2219, 2231) searched that "" for a
//     decimal point; dmRepl (535-547) searched what was left of the
//     text, which is "" once the pattern was the LAST thing in it (a
//     formula ending in "dmq3", say) -- TrendTest's crash on the
//     emulator.  dmCas and dmFxMake now search only a non-empty
//     answer; dmRepl is the loop of the round-2 brief (it returns the
//     text unchanged for an empty pattern, and asks INSTRING only
//     while text is left).  The note under the formula (dmDrawFx
//     2322) asks INSTRING only inside its own IF, so it never depends
//     on AND skipping its right side.  The six LEFTs take 1, 22, 26
//     characters, rpI - 1 > 0 or a break point of at least 1; every
//     MID starts at 2 or later, or at 1 inside a loop from 1.
//   * THE MENU FITS ITS BOX.  "Results table (tap a row to drop it)"
//     was still cut on the emulator ("...to dro"); it is now
//     "Results (tap a row to drop)" (DNAMixLR 3002).
//   * FIXED DECIMALS.  STRING(x, 2, d) prints SCIENTIFIC when
//     0 < |x| < 10^-d (STRING(0.096, 2, 1) is "9.6E-2" with a small-
//     capital E, emulator, round 2).  dmF (361-364), which prints the
//     log10 LRs, the percentages, the frequencies and theta on the
//     plots, now rounds first, STRING(ROUND(x, d) + 0, 2, d) ("+ 0"
//     turns a rounded -0 into 0): an LR of 1.0003 has log10 0.00013,
//     which printed "1.288E-4".  The y labels of the two LR plots
//     (dmDrawLoci 1495, dmThStatic 1789) are counted up from a
//     negative bottom, so the tick at 0 could land a hair off it
//     (-2.8E-17 in PC arithmetic): they now go through dmF.  dmThS
//     (431-437) shows a typed theta below 0.0001 with the decimals it
//     needs.  An allele box (dmPicture 2184) shows a frequency that
//     would round to ".000" with four decimals (".0004").  dmBig and
//     dmPStr already write small numbers in their own E form; the
//     counts and the theta axis (0.00 to 0.05) cannot reach the case.
//
// What changed in beta 3a (17 Oct 2026): the CAS call form only.
//   CASProbe beta 1b found that CAS(s) with s a variable hands the
//   text back UNEVALUATED, so beta 3's dmCas (485-506) returned its
//   own input: the formula view would have shown the program's own
//   unsimplified sum (it has no decimal point, so it passed) as if
//   the CAS had written it.  Its IFERR line is now
//     STRING(EXPR("CAS(" + CHAR(34) + "string(" + s + ")" + CHAR(34) + ")"))
//   (BRIEF_CAS_v2), the quotes STRING() adds are dropped, and an
//   answer holding the infinity sign is refused like undef.  No
//   reader changed: the LR formula is a ratio of polynomials in the
//   p's and theta, which the Prime prints as desktop Giac does, and
//   the one test (a decimal point = approximate mode) reads the same
//   everywhere.  Nothing else changed.
//
// What changed in beta 3 (16 Oct 2026; built ON TOP OF beta 2,
//   every beta 2 change kept; line numbers are beta 2's):
//   * THE LR AS A FORMULA, on the locus page (1882-1911): press -
//     (or tap the footer row) and the allele picture gives way to
//     the locus's LR written in the allele frequencies (p12, p13
//     ...) and theta (th).  The program writes out the very sum
//     dmProb adds up -- inclusion-exclusion over the alleles the
//     unknowns must supply, with NRC II's theta factors -- as CAS
//     text, symbols in place of numbers (dmCasP); the CAS
//     simplifies it (factor(normal(...))).  Under it: the formula
//     at theta = 0 (the product rule, e.g. 1/(2 p14 p15)), and the
//     LR with your numbers, which is the program's own value.  A
//     formula longer than four lines is not shown ("too long to
//     show"), and then the theta = 0 formula is shown if it fits.
//     A badge says "exact (CAS)", or "decimal" when the CAS did
//     not answer.  Every preset was checked in desktop Giac, and
//     the CAS formulas agree with dmEval to 1e-10
//     (verify_DNAMixLR_beta3.py).
//   * THETA AT THE LADDER EDGE, on the theta plot (1356-1434): the
//     theta at which the combined LR crosses the next ENFSI band
//     edge as theta rises from yours -- how far theta must go
//     before the verbal conclusion changes.  Found in PPL (dmEdge):
//     the cached curve brackets it, then bisection on dmCombAt;
//     past 0.05 it looks at 0.06 ... 0.25.  Drawn in orange: a
//     dotted line at that theta and one at the edge's height, a
//     dot where they meet, and "band edge LR 1,000 / at theta
//     0.0873".  No CAS is used for it.
//   * The CAS is reached through ONE routine, dmCas (the house CAS
//     kit, with dmIStr writing whole numbers), so CASProbe's
//     verdict is a one-line change (made in beta 3a).  Only whole numbers go into
//     CAS text.  The CAS is asked when the formula view opens or
//     the locus changes, never during the theta drag.  dmCas drops
//     one pair of quotes round an answer (HP: answers in numerical
//     mode come back as strings), and an answer with a decimal
//     point (the CAS's approximate mode) is not shown as exact.
//   * Help page 4 explains the formula and the band edge.
//   * dmProb, dmKnowns, dmTyped and dmEval are unchanged, byte for
//     byte.  dmRecalc and dmClearLoci gain one line each (the band
//     edge's cache flag); dmDrawPanel, dmLocusPanel, dmThStatic and
//     the help pages grow as described above.
//
// What changed in beta 2 (16 Oct 2026; built ON TOP OF beta 1a,
//   every beta 1a fix kept; line numbers are beta 1a's):
//   * SHOWCASE: drag theta on the theta plot.  A finger anywhere in
//     the plot box sets theta = 0.05 (x - left)/(right - left),
//     snapped to 0.0025; the green line follows, a readout gives
//     theta, log10 LR and LR from the 21 CACHED curve points (read
//     by interpolation -- the loci are never re-evaluated during a
//     drag), and an ENFSI verbal ladder at the right carries a red
//     "you are here" marker.  Left/Right do the same from the keys;
//     Enter adopts the theta (868-948 rebuilt as dmPlotTheta).  The
//     static plot is composed once into G2; each drag sample copies
//     G2 to G1, adds the line, readout and marker, and blits.
//   * The theta plot shades the usual range 0.01-0.03 and draws a
//     second curve for the same loci with every allele frequency
//     halved (computed once and cached, dmCurves), with the drop
//     from theta 0 to 0.03 printed for both: theta bites harder
//     when p is small.  The dotted red lines at 0.01 and 0.03 are
//     replaced by the shaded band.
//   * Tap a bar on the locus plot (or Left/Right): a strip in place
//     of the footer gives its alleles, P(E|Hp), P(E|Hd), LR, log10
//     LR and verbal, and the bar turns solid.  Tap it again (or
//     Enter) for the locus page.  The + key or a tap on the title
//     switches to a WATERFALL: floating bars from the running total
//     before a locus to the total after it, blue for Hp, red for
//     Hd, thin grey links, an "all" bar at the end; an excluded
//     locus is marked EXCLUDED and the running total stops there.
//   * The locus page (511-554, rebuilt) draws the mixture's alleles
//     as boxes: victim green, suspect magenta, and the alleles the
//     unknowns must supply outlined red -- the U set dmProb builds.
//     A tap on the boxes (or +) switches Hp / Hd, so the suspect's
//     fill disappears and U grows: WHY the LR is what it is.  It
//     also works the NRC II theta formula through for the next
//     allele, and under preset 3 says the LR is 1/RMP.
//   * Tap a row of the Results table (or Up/Down and Enter) to drop
//     that locus from the product -- "what if it had not been
//     typed?"; the row greys and the combined LR and verbal update.
//     Tap again to restore.  dmInc holds one include flag per locus;
//     dmRecalc and dmCombAt skip a dropped locus and never change
//     any locus's own LR.
//   * New menu item: the PROSECUTOR'S FALLACY page.  Tap a prior
//     (the suspect and N others; N = 1 ... 10,000,000) and see prior
//     odds x LR = posterior odds as three stacked bars on a log
//     scale, and the posterior probability.  "The LR is NOT the
//     probability that the suspect contributed" is said there, on
//     the locus page and under the Results table.
//   * New menu item and soft key: the LADDER, which steps the red
//     marker up one locus at a time (a TICKS pause; any key skips).
//   * Soft keys Locus, Theta, Table, Ladder, Help, Menu on every
//     page (DRAWMENU after the blit); the footers moved above y 218.
//   * The locus page, the Results table and the help pages are now
//     composed in G1 and blitted once (they drew on G0).  Every page
//     waits on keys AND touch with a capped finger-lift drain
//     (dmDrain); dmWaitKey, which ignored touch, is gone.
//   * Help: a third page for the gestures and soft keys.
//   * Theta is shown with four decimals when it needs them (an
//     adopted 0.0125 no longer reads as 0.013).
//   * The locus plot's running total now stops at an exclusion, as
//     the waterfall's does (beta 1a carried it on over the other
//     loci; the red EXCLUDED line was already the result shown).
//   * dmProb, dmKnowns, dmTyped and dmEval are unchanged, and so is
//     every number beta 1a showed.  MAKELIST in dmProb keeps Home's
//     K as its counter (GfxProbe T19 still to settle a LOCAL one);
//     the theta plot's MAKELIST is gone (a FOR loop builds the list).
//
// What changed in beta 1a (16 Oct 2026; line numbers are beta 1's):
//   * An EXCLUSION is reported as one.  A locus with LR = 0 was
//     skipped in the combined product (353, 372) and the combined
//     LR was then shown without qualification (476, 651, 731, 895).
//     dmExcl now holds the number of the first excluded locus;
//     every place that shows the combined LR shows "EXCLUDED at
//     locus n (LR = 0)" in red instead, the Results verbal line
//     says it is not rescued without a dropout model, and DM_LR
//     is 0 in Home.  The plots still draw: the excluded locus is
//     a red column marked "excl." and the theta curve is labelled
//     as the other loci only.
//   * dmBig (116-127) printed "0.000" for values between 0.0001
//     and 0.0005; scientific notation now starts below 0.01.
//   * dmAskGen's LOCALs g1..g6 (410) renamed dmGV1, dmGV2, dmGS1,
//     dmGS2, dmGT1, dmGT2: G1..G6 are the graphics variables.
//   * Menu strings no longer carry numbers (the Prime numbers them
//     itself: 1-9, then A for Quit), and Hypotheses is now item 1,
//     Enter a locus item 2, as the header and the "choose the
//     hypotheses, then enter a locus" message always said.
//   * Theta plot: a session theta above 0.05 had no green line
//     while the legend promised one (791, 805); the legend now says
//     the theta is off the plot.  The three LRs under the plot are
//     read from the cached curve (804) instead of being recomputed.
//   * Locus plot: at 12 loci the value labels (26-33 px) collided
//     on a 21-px bar pitch; below a 30-px pitch they alternate
//     between two rows (an even locus's label sits above the higher
//     of its neighbours, so it clears both).  The "locus" axis
//     title (728) overlapped the last locus number from about 6
//     loci up: moved down a row, with the legend (729) shifted
//     left to make room.  A
//     locus with no LR (Hd impossible) is now marked "no LR"
//     rather than "excl." (724).
//   * Footers in dodger blue and the house form ("any key = menu").
//   * Panel fill #FFF8F0 -> house #FFF0DC; negative-bar fill
//     #FFE0E0 -> house #FFEBEB.
//   * dmPreset was written and never read: removed.
//   * The program ends with RETURN "DNAMixLR: ..." (combined LR or
//     the exclusion line) instead of falling off END.
//   * MAKELIST counter (255, 267, 751) left as Home's K: whether a
//     LOCAL counter works there is not device-verified (GfxProbe
//     T19 will settle it; the fleet-wide change comes after).
// ============================================================
//
// THE QUESTION
//   A crime-scene stain shows a MIXTURE of alleles at a locus.
//   Prosecution hypothesis Hp:  the suspect is one contributor
//   (perhaps with the victim, perhaps with unknown people).
//   Defence hypothesis Hd:  the suspect is not; someone unknown
//   contributed instead.
//   LR = P(mixture | Hp) / P(mixture | Hd), locus by locus, and
//   the loci multiply (independent loci).
//
// THE MODEL
//   At one locus the mixture shows the set of alleles M.  Under a
//   hypothesis the KNOWN contributors (victim, suspect ...) must
//   have all their alleles inside M, and the x UNKNOWN contributors
//   must supply every allele of M the knowns do not, and nothing
//   outside M.  The probability that 2x random alleles do exactly
//   that is summed allele by allele, from positive terms only (beta
//   3c; betas 1-3b used inclusion-exclusion, which cancelled).
//   With coancestry theta, allele probabilities are the NRC II
//   conditional ones: an allele already seen among the TYPED people
//   becomes more likely to be seen again,
//        P(allele a next | n seen, n_a of them a)
//            = [n_a*theta + (1-theta)*p_a] / [1 + (n-1)*theta].
//   theta = 0 gives the plain product rule.  0.01 is typical for a
//   broad population; 0.03 is the conservative value NRC II suggests
//   for small isolated subpopulations.
//
// THE LR IS NOT A PROBABILITY OF GUILT OR CONTRIBUTION
//   The LR says how much more probable the EVIDENCE is under Hp
//   than under Hd.  Turning it into the probability that the
//   suspect contributed needs prior odds:
//        posterior odds = LR x prior odds.
//   Reading 1/LR as P(Hd | evidence) is the prosecutor's fallacy;
//   the Prosecutor's fallacy page shows the arithmetic.
//
// HOW TO USE IT
//   1  Hypotheses: pick a preset (victim + suspect vs victim +
//      unknown, and so on) or build your own.
//   2  Enter a locus: alleles in the mixture, their population
//      frequencies, and the typed people's genotypes.  Repeat
//      for each locus.  The locus page is shown after every locus.
//   3  Results and the plots: LR by locus (tap a bar; + for the
//      waterfall), LR against theta (drag; the orange mark is the
//      theta at the next band edge), the ladder, and the
//      prosecutor's fallacy page.  The soft keys along the bottom
//      move between the pages; Esc goes back to the menu.
//   4  On a locus page, - shows the LR as a formula (CAS).
//
// FILE MAP (beta 3)
//   state and palette; small helpers; touch kit (dmDrain, dmPoll,
//   dmPause, dmMenu, dmSoft); the CAS kit (dmIStr, dmCas) and its
//   text helpers (dmRepl, dmWrap); the probability engine (dmProb,
//   rewritten in beta 3c to add without subtracting; dmKnowns ...
//   dmCombAt, unchanged apart from the include flags); the LR
//   as CAS text (dmCasP, dmCasLR) and the band edge (dmBand,
//   dmEdge), beside the engine; entering a locus; hypotheses and
//   theta; the ladder drawing; the pages (locus plot, theta plot,
//   Results table, locus page with its formula view, ladder,
//   prosecutor's fallacy, help); worked example; dmInit; the page
//   dispatcher dmViews; dmEnterLocus; the main menu.
//
// HOME EXPORTS
//   DM_LR    combined likelihood ratio        DM_LOG  its log10
//            (0 when a locus excludes the suspect; DM_LOG is 0 then;
//            loci dropped on the Results page are left out)
//   DM_LOCI  list of per-locus LRs            DM_TH   theta used
//            (0 = excluded at that locus, -1 = Hd impossible there;
//            dropping a locus does not change its entry here)
// ============================================================


// ---- forward declaration: called before it is defined ----
dmClearLoci();

// ------------------------------------------------------------
// RESULTS VISIBLE FROM HOME
// ------------------------------------------------------------
EXPORT DM_LR, DM_LOG, DM_LOCI, DM_TH;

// ------------------------------------------------------------
// SESSION STATE (private to this program; set in dmInit)
// ------------------------------------------------------------
LOCAL dmTh, dmNL, dmLoc, dmLR, dmPp, dmPd;
//  dmTh   coancestry theta           dmNL   number of loci entered
//  dmLoc  one record per locus: {labels, frequencies, genotypes}
//  dmLR   per-locus LR (0 = suspect excluded, -1 = Hd impossible)
//  dmPp, dmPd  per-locus P(E|Hp) and P(E|Hd)
LOCAL dmPres, dmHp, dmHd, dmExcl, dmComb;
//  dmPres  {victim?, suspect?, third?}: which typed persons exist
//  dmHp    {V contributes?, S?, T?, unknowns}  under Hp
//  dmHd    the same under Hd
//  dmExcl  number of the first INCLUDED locus with LR = 0 (the
//          suspect is EXCLUDED there), or 0 when none excludes
//  dmComb  product of the per-locus LRs that are included, defined
//          and positive.  When dmExcl > 0 the true combined LR is 0;
//          dmComb is then only "the other loci", and every screen
//          says EXCLUDED instead of showing it as the result
LOCAL dmLab, dmFq, dmGen, dmM;
//  the locus being worked on: labels, frequencies, the six genotype
//  entries {V1, V2, S1, S2, T1, T2} as indices into the allele list
//  (0 = an allele that is NOT in the mixture), and m = SIZE(dmLab)

// beta 2: what-if flags, the pages' memory, and the cached curves
LOCAL dmInc, dmNDrop, dmSel, dmShow, dmWF, dmPicH;
//  dmInc   one flag per locus: 1 = in the product, 0 = dropped on
//          the Results page ("what if it had not been typed?")
//  dmNDrop how many loci are dropped
//  dmSel   the locus selected on the locus plot / shown on the
//          locus page;  dmShow 1 = its strip is shown on the plot
//  dmWF    the locus plot as bars (0) or as a waterfall (1)
//  dmPicH  the locus page's allele picture under Hp (1) or Hd (2)
LOCAL dmTSel, dmPri, dmCuV, dmCuS, dmTX, dmTY;
//  dmTSel  the Results row the arrow keys have selected
//  dmPri   the prior chosen on the prosecutor's-fallacy page:
//          the suspect and 10^(dmPri-1) others (1 ... 8)
//  dmCuV   running total of log10 LR after each locus (dmCum)
//  dmCuS   each locus's part in it: 1 counted, 0 dropped, 2 no LR,
//          3 EXCLUDED here (the total stops), 4 after the exclusion
//  dmTX, dmTY  where the last tap was (dmPoll)
LOCAL dmPtV, dmPtH, dmCvOK, dmYLo, dmYHi;
//  dmPtV   log10 combined LR at theta = 0, 0.0025 ... 0.05 (21)
//  dmPtH   the same with every allele frequency halved
//  dmCvOK  1 while those two lists are up to date
//  dmYLo, dmYHi  the theta plot's vertical range (log10 LR)

// Geometry: the drawing code AND the touch handlers read these, so
// a tap and the thing drawn under it can never disagree.
LOCAL dmP1L, dmP1R, dmP1T, dmP1B, dmTbY, dmTbH;
//  dmP1L..dmP1B  the locus plot's box;  dmTbY, dmTbH  the Results
//  table's first row top and row pitch (set while it is drawn)
LOCAL dmP2L, dmP2R, dmP2T, dmP2B, dmPcY, dmFaT;
//  dmP2L..dmP2B  the theta plot's box;  dmPcY  top of the locus
//  page's allele boxes;  dmFaT  top of the prior ladder's first rung
LOCAL dmLdX1, dmLdX2, dmLdT, dmLdB;
//  the theta plot's verbal ladder: left, right, top, bottom

// beta 3: the LR as a formula (CAS) and theta at the ladder edge
LOCAL dmFrm, dmFxK, dmFxT, dmFxS, dmF0K, dmF0T;
//  dmFrm   the locus page shows the allele picture (0) or the LR as
//          a formula (1)
//  dmFxK   the CAS text last sent for the LR with theta; dmFxT the
//          CAS's answer; dmFxS what happened: 1 answered, 2 the CAS
//          did not answer, 3 too long to send, 0 not asked yet
//  dmF0K, dmF0T  the same for the formula at theta = 0 (dmF0S)
LOCAL dmF0S, dmCasOK, dmTHG, dmCasMx, dmEdT, dmEdV;
//  dmCasOK 1 = the CAS answered ("exact (CAS)" badge), 0 = it did
//          not, and only the program's decimals are shown ("decimal")
//  dmTHG   how theta is written in a formula: "th" until GfxProbe
//          T14 shows that CHAR(952) renders
//  dmCasMx the longest CAS text the program sends (characters)
//  dmEdT   theta at the ladder edge; -1 = no edge up to theta 0.25,
//          -2 = nothing to look for (no loci, or an exclusion)
//  dmEdV   the LR at that edge (1000, 100, 0.1 ...)
LOCAL dmEdOK;
//  dmEdOK  1 while dmEdT and dmEdV are up to date; dmRecalc and
//          dmClearLoci clear it

// Colours (house palette)
LOCAL dmBLUE, dmMAG, dmGRN, dmRED, dmGRAY, dmFOOT;
LOCAL dmORNG, dmPANL, dmGRID, dmLBLU, dmSHAD, dmLRED;
LOCAL dmLGRN;


// ------------------------------------------------------------
// SMALL HELPERS
// ------------------------------------------------------------

// Fixed decimals (STRING mode 2 keeps trailing zeros).
// beta 3b: rounded first.  On the Prime STRING(x, 2, d) turns
// SCIENTIFIC when 0 < |x| < 10^-d (the rule: emulator, 17 Oct 2026;
// a log10 LR of 0.00013 at 3 decimals printed "1.288E-4"); ROUND makes x
// either 0 or at least 10^-d, so the fixed form always holds.  "+ 0"
// turns a rounded -0 into 0, so a hair below 0 reads 0.000.
dmF(fv, fd)
BEGIN
  RETURN STRING(ROUND(fv, fd) + 0, 2, fd);
END;

// A likelihood ratio (or a probability) as text: 3 decimals when
// small, 1 when large, and mantissa-E-exponent beyond a million or
// below 0.01 (STRING has no reliable scientific mode, so it is built
// by hand with LOG).  Beta 1 switched to E-notation only below
// 0.0001, so 0.0003 printed as "0.000" and read as impossible.
dmBig(bgV)
BEGIN
  LOCAL bgE, bgM;
  IF bgV == 0 THEN RETURN "0"; END;
  IF bgV >= 1000000 OR bgV < 0.01 THEN
    bgE := FLOOR(LOG(bgV));
    bgM := bgV / 10^bgE;
    RETURN STRING(bgM, 2, 2) + "E" + STRING(bgE, 2, 0);
  END;
  IF bgV >= 100 THEN RETURN STRING(bgV, 2, 1); END;
  RETURN STRING(bgV, 2, 3);
END;

// The ENFSI verbal scale for a likelihood ratio.
dmVerbal(vbLR)
BEGIN
  LOCAL vbV, vbS;
  IF vbLR <= 0 THEN RETURN ""; END;
  vbV := vbLR;
  vbS := "Hp";
  IF vbLR < 1 THEN vbV := 1 / vbLR; vbS := "Hd"; END;
  CASE
    IF vbV < 2 THEN RETURN "about equal support for Hp and Hd"; END;
    IF vbV < 10 THEN RETURN "weak support for " + vbS; END;
    IF vbV < 100 THEN RETURN "moderate support for " + vbS; END;
    IF vbV < 1000 THEN RETURN "moderately strong support for " + vbS; END;
    IF vbV < 10000 THEN RETURN "strong support for " + vbS; END;
    IF vbV < 1000000 THEN RETURN "very strong support for " + vbS; END;
    DEFAULT RETURN "extremely strong support for " + vbS;
  END;
END;

// "Nice" numbers for axis ticks: 1, 2 or 5 times a power of ten.
dmNice(nnV, nnRound)
BEGIN
  LOCAL nnE, nnF, nnN;
  IF nnV <= 0 THEN RETURN 1; END;
  nnE := FLOOR(LOG(nnV));
  nnF := nnV / 10^nnE;
  IF nnRound THEN
    CASE
      IF nnF < 1.5 THEN nnN := 1; END;
      IF nnF < 3 THEN nnN := 2; END;
      IF nnF < 7 THEN nnN := 5; END;
      DEFAULT nnN := 10;
    END;
  ELSE
    CASE
      IF nnF <= 1 THEN nnN := 1; END;
      IF nnF <= 2 THEN nnN := 2; END;
      IF nnF <= 5 THEN nnN := 5; END;
      DEFAULT nnN := 10;
    END;
  END;
  RETURN nnN * 10^nnE;
END;

// Theta as text: three decimals, or four when it needs them (a
// theta adopted from the drag can be 0.0125, which three decimals
// would show as 0.013).
// beta 3b: a typed theta below 0.0001 (any theta from 0 to 0.5 is
// allowed) gets two significant digits -- four decimals would print
// it in scientific form ("4.0000E-5") -- and every form is rounded
// before STRING, so the fixed form always holds.
dmThS(tsV)
BEGIN
  IF ABS(tsV * 1000 - ROUND(tsV * 1000, 0)) < 0.000001 THEN
    RETURN STRING(ROUND(tsV, 3), 2, 3);
  END;
  IF tsV > 0 AND tsV < 0.0001 THEN RETURN dmF(tsV, MIN(11, 1 - FLOOR(LOG(tsV)))); END;
  RETURN STRING(ROUND(tsV, 4), 2, 4);
END;

// A whole number with thousands separators: 100000 -> "100,000".
dmCom(cmV)
BEGIN
  LOCAL cmR, cmG, cmS, cmP;
  cmR := ROUND(cmV, 0);
  cmS := "";
  WHILE cmR >= 1000 DO
    cmG := cmR MOD 1000;
    cmP := "";
    IF cmG < 100 THEN cmP := "0"; END;
    IF cmG < 10 THEN cmP := "00"; END;
    cmS := "," + cmP + STRING(cmG, 2, 0) + cmS;
    cmR := (cmR - cmG) / 1000;
  END;
  RETURN STRING(cmR, 2, 0) + cmS;
END;

// A likelihood ratio (or odds) for a sentence: 5333.3 -> "5,333";
// below 1000 or from ten million up, as dmBig writes it.
dmLRS(lsV)
BEGIN
  IF lsV >= 1000 AND lsV < 10000000 THEN RETURN dmCom(lsV); END;
  RETURN dmBig(lsV);
END;

// A probability p (with its complement q = 1 - p computed
// separately, so nothing is lost to rounding near 1) as text:
// four decimals, or "1 - 1.88E-4" near 1, or E-notation near 0.
dmPStr(psP, psQ)
BEGIN
  IF psQ < 0.001 THEN RETURN "1 - " + dmBig(psQ); END;
  IF psP < 0.001 THEN RETURN dmBig(psP); END;
  RETURN STRING(psP, 2, 4);
END;


// ------------------------------------------------------------
// THE CAS KIT (the house shapes, BRIEF_CAS 16 Oct 2026)
// beta 3a: dmCas in the call form CASProbe beta 1b found on the
// emulator (BRIEF_CAS_v2), not yet run on a calculator.  Every CAS
// feature here has a
// decimal fallback: the program's own numbers are always shown.
// ------------------------------------------------------------

// A whole number as plain digits: no digit-grouping marks, no decimal point, no
// exponent.  Home's STRING() follows the Home number format (PyProbe saw grouping
// marks and a special minus sign), which the CAS cannot read, so CAS text is built
// only from this routine.
dmIStr(dmN)
BEGIN
  LOCAL dS, dV, dD;
  dV := ROUND(ABS(dmN), 0);
  IF dV == 0 THEN RETURN "0"; END;
  dS := "";
  WHILE dV > 0 DO
    dD := dV MOD 10;
    dS := CHAR(48 + dD) + dS;
    dV := (dV - dD) / 10;
  END;
  IF dmN < 0 THEN dS := "-" + dS; END;
  RETURN dS;
END;

// The ONE place this program calls the CAS.  It returns the CAS answer as text,
// or "" if the CAS failed, gave undef, an error or an infinity.
// The call form is the one CASProbe beta 1b found on the HP Prime Virtual
// Calculator (build 2026-09-09, 17 Oct 2026): CAS(s) with s a variable hands
// the text back UNEVALUATED, so the text is built into a literal CAS("...")
// that EXPR reads at run time, and the CAS is asked for string(...) of the
// answer, so a big integer crosses into PPL whole, not as a 12-digit real.
dmCas(dmS)
BEGIN
  LOCAL cR;
  cR := "";
  IFERR
    cR := STRING(EXPR("CAS(" + CHAR(34) + "string(" + dmS + ")" + CHAR(34) + ")"));
  THEN
    cR := "";
  END;
  // The answer is a PPL string, and STRING() of it adds one pair of quotes
  // (CASProbe beta 1b T12, emulator): drop that pair.
  IF DIM(cR) >= 2 THEN
    IF LEFT(cR, 1) == CHAR(34) AND MID(cR, DIM(cR), 1) == CHAR(34) THEN
      cR := MID(cR, 2, DIM(cR) - 2);
    END;
  END;
  // undef, an error, or an infinity (CHAR(8734) is the infinity sign; it
  // also catches the Prime's plus-minus infinity, 1/0): no usable answer
  // beta 3b: an empty answer is already a failure; INSTRING("", ...) is
  // "Invalid input" on the Prime (emulator, 17 Oct 2026), so the checks
  // run only on a non-empty answer
  IF DIM(cR) > 0 THEN
    IF INSTRING(cR, "undef") > 0 OR INSTRING(cR, "rror") > 0 OR INSTRING(cR, CHAR(8734)) > 0 THEN cR := ""; END;
  END;
  RETURN cR;
END;

// Every rpO in the text rpT replaced by rpN.  INSTRING, LEFT and
// MID only (INSTRING ran in PyProbe; LEFT and MID on the device).
// Used to write a CAS answer for people: dmq3 -> p14, dmt -> th,
// * -> the times sign.
// beta 3b: INSTRING("", ...) is "Invalid input" on the Prime (emulator,
// 17 Oct 2026), and what is left of the text is "" as soon as the
// pattern was its LAST part (a formula ending in "dmq3").  So the
// position is asked only while text is left, and an empty pattern
// (INSTRING(s, "") is 1: the loop would never end) returns the text
// unchanged.  (The round-2 brief's loop, the same in every program.)
dmRepl(rpT, rpO, rpN)
BEGIN
  LOCAL rpR, rpS, rpI, rpK;
  IF DIM(rpO) == 0 THEN RETURN rpT; END;
  rpR := ""; rpS := rpT; rpK := DIM(rpO);
  rpI := 0; IF DIM(rpS) > 0 THEN rpI := INSTRING(rpS, rpO); END;
  WHILE rpI > 0 DO
    IF rpI > 1 THEN rpR := rpR + LEFT(rpS, rpI - 1); END;
    rpR := rpR + rpN;
    IF rpI + rpK > DIM(rpS) THEN rpS := ""; ELSE rpS := MID(rpS, rpI + rpK); END;
    rpI := 0; IF DIM(rpS) > 0 THEN rpI := INSTRING(rpS, rpO); END;
  END;
  RETURN rpR + rpS;
END;

// Cut a long formula into lines of at most wpW characters, at the
// best place in the second half of each line: just after a closing
// bracket or a times sign, just before a + or - that joins two
// terms, or just after a / that is followed by a bracket -- and of
// those, the one with the fewest brackets open, so that a factor
// such as (p14xth-p14-th) stays on one line.  A number or a
// fraction such as 2608/5 is never split; only a formula with no
// such place is cut at the width.  Returns the list of lines.
dmWrap(wpT, wpW)
BEGIN
  LOCAL wpL, wpS, wpI, wpB, wpC, wpD;
  LOCAL wpBd, wpP, wpN, wpOk;
  wpL := {}; wpS := wpT;
  WHILE DIM(wpS) > wpW DO
    wpB := 0; wpBd := 999; wpD := 0;
    FOR wpI FROM 1 TO wpW DO
      wpC := MID(wpS, wpI, 1);
      wpP := ""; IF wpI > 1 THEN wpP := MID(wpS, wpI - 1, 1); END;
      wpN := MID(wpS, wpI + 1, 1);
      // a break BEFORE a + or - (one that joins terms, not a sign)
      IF wpI > IP(wpW / 2) AND (wpC == "+" OR wpC == "-") THEN
        IF wpP <> "(" AND wpP <> "^" AND wpP <> CHAR(215) AND wpP <> "/" AND wpD <= wpBd THEN
          wpB := wpI - 1; wpBd := wpD;
        END;
      END;
      IF wpC == "(" THEN wpD := wpD + 1; END;
      IF wpC == ")" THEN wpD := wpD - 1; END;
      // a break AFTER a ), a times sign, or a / followed by a bracket
      wpOk := 0;
      IF wpC == ")" OR wpC == CHAR(215) THEN wpOk := 1; END;
      IF wpC == "/" AND wpN == "(" THEN wpOk := 1; END;
      IF wpI > IP(wpW / 2) AND wpOk == 1 AND wpD <= wpBd THEN
        wpB := wpI; wpBd := wpD;
      END;
    END;
    IF wpB == 0 THEN wpB := wpW; END;
    wpL := CONCAT(wpL, {LEFT(wpS, wpB)});
    wpS := MID(wpS, wpB + 1);
  END;
  IF DIM(wpS) > 0 THEN wpL := CONCAT(wpL, {wpS}); END;
  RETURN wpL;
END;


// ------------------------------------------------------------
// THE TOUCH KIT (the house shapes: ChiTable beta 1k, TouchKit v1)
// ------------------------------------------------------------

// Wait for the finger to lift -- but never for more than a second,
// so a stuck touch reading cannot freeze the program.
dmDrain()
BEGIN
  LOCAL drT;
  drT := TICKS;                                  // milliseconds
  REPEAT UNTIL MOUSE(1) == -1 OR TICKS - drT > 1000;
END;

// Wait for a key OR a touch.  Returns the key code, or -1 for a
// touch, whose x and y are left in dmTX, dmTY.  It does NOT drain
// afterwards: the finger may still be down, and the theta plot
// follows it as a drag.  Every caller drains (dmDrain, or the key
// drain) once it has acted.
dmPoll()
BEGIN
  LOCAL poK, poM, poM1;
  REPEAT
    poK := GETKEY;
    poM := MOUSE;
    poM1 := poM(1);
  UNTIL poK > -1 OR SIZE(poM1) > 0;
  dmTX := -1; dmTY := -1;
  IF SIZE(poM1) > 0 THEN
    dmTX := poM1(1); dmTY := poM1(2); poK := -1;
  END;
  RETURN poK;
END;

// Pause for paMs milliseconds, watching for a key or a tap.
// Returns 1 if the student pressed or tapped (skip the animation),
// 0 if the time ran out.  WAIT(0.4) would also pause, but it is not
// in the device-verified list; TICKS is.
dmPause(paMs)
BEGIN
  LOCAL paT, paK, paM, paM1;
  paT := TICKS;
  REPEAT
    paK := GETKEY;
    paM := MOUSE;
    paM1 := paM(1);
    IF paK > -1 OR SIZE(paM1) > 0 THEN RETURN 1; END;
  UNTIL TICKS - paT > paMs;
  RETURN 0;
END;

// Show the page composed in G1, then the soft keys.  DRAWMENU
// paints the SCREEN, so it goes after the blit, every frame.
dmMenu()
BEGIN
  BLIT_P(G0, 0, 0, G1);
  DRAWMENU({"Locus", "Theta", "Table", "Ladder", "Help", "Menu"});
END;

// Which page a tap on the soft-key strip (y >= 218) asks for:
// slots 1-5 are pages 1-5 (locus plot, theta plot, Results table,
// ladder, help); slot 6, Menu, is 0 = back to the menu.  The
// labels never produce a key code, so every page also has keys.
dmSoft(sfX)
BEGIN
  LOCAL sfS;
  sfS := MIN(6, IP(sfX / 53.4) + 1);
  IF sfS == 6 THEN RETURN 0; END;
  RETURN sfS;
END;


// Describe a hypothesis: which typed persons contribute, how many
// unknowns.  hsH is {V?, S?, T?, x}.
dmHypStr(hsH)
BEGIN
  LOCAL hsS, hsU;
  hsS := "";
  IF dmPres(1) == 1 AND hsH(1) == 1 THEN hsS := "V"; END;
  IF dmPres(2) == 1 AND hsH(2) == 1 THEN
    IF hsS <> "" THEN hsS := hsS + " + "; END;
    hsS := hsS + "S";
  END;
  IF dmPres(3) == 1 AND hsH(3) == 1 THEN
    IF hsS <> "" THEN hsS := hsS + " + "; END;
    hsS := hsS + "T";
  END;
  hsU := "";
  IF hsH(4) == 1 THEN hsU := "1 unknown"; END;
  IF hsH(4) > 1 THEN hsU := STRING(hsH(4), 2, 0) + " unknowns"; END;
  IF hsU <> "" THEN
    IF hsS <> "" THEN hsS := hsS + " + "; END;
    hsS := hsS + hsU;
  ELSE
    IF hsS == "" THEN hsS := "nobody"; ELSE hsS := hsS + ", no unknown"; END;
  END;
  RETURN hsS;
END;

// The alleles of a locus as text, e.g. "12, 13, 14, 15".
dmAllStr(alL)
BEGIN
  LOCAL alI, alS;
  alS := "";
  FOR alI FROM 1 TO SIZE(alL) DO
    IF alI > 1 THEN alS := alS + ", "; END;
    alS := alS + STRING(alL(alI), 2, IFTE(FP(alL(alI)) == 0, 0, 1));
  END;
  RETURN alS;
END;


// ------------------------------------------------------------
// THE PROBABILITY ENGINE
//
// dmProb(x, knowns, typed) = probability that the mixture shows
// exactly the allele set M, given x unknown contributors, the
// known contributors' alleles (indices into dmFq; a 0 means an
// allele outside M, which makes the hypothesis impossible) and
// the alleles of EVERY typed person (contributor or not), which
// condition the theta-corrected probabilities.
//
// THE MODEL (unchanged since beta 1).  The 2x unknown alleles are
// drawn one after another with NRC II's conditional probability
//     P(next is a) = [ (t_a + c_a) th + (1 - th) p_a ]
//                    / [ 1 + (n - 1) th ],
// where t_a is how many TYPED alleles are a, c_a how many of the
// unknowns drawn so far were a, and n everything seen so far (nT
// typed alleles + the unknowns drawn).  The event: every unknown
// allele is in M, and every allele of U -- the alleles of M that
// no known contributor carries -- turns up at least once.
//
// BETA 3c: HOW IT IS ADDED UP.  Betas 1 to 3b used inclusion-
// exclusion:
//   P = sum over subsets S of U of (-1)^|S| x
//       prod_{j=0}^{2x-1} [ (t(M\S) + j) th + (1 - th) p(M\S) ]
//                       / [ 1 + (nT + j - 1) th ].
// Exact on paper, but an ALTERNATING sum: its terms are large and
// nearly cancel.  The first term is about p(M)^(2x) -- 0.9 to the
// 8th, say -- while the answer can be a product of rare
// frequencies, 1E-19 or less.  The calculator keeps 12 significant
// digits, so each term carries an error near 1E-12 of ITS size;
// when the answer is smaller than that error, what is left after
// the cancelling is rounding noise, or 0, or below 0 (which MAX(0,
// ...) then made 0).  The fleet review found it (19 Oct 2026): a
// custom S + 4 unknowns vs V + 4 unknowns with five rare alleles
// at theta 0 has an exact LR of 6.64E-7, and beta 3b reported an
// EXCLUSION; V + S + 3 unknowns vs V + 4 unknowns with the same
// frequencies, exact LR 3.6E5, was "Hd cannot produce this
// mixture".  (The PC's 16 digits fail on the same two cases.)
//
// Now the same probability is added up with NO subtraction at all.
// The probability of one ORDER of draws depends only on how many
// copies of each allele it holds, c_1 ... c_m (the order changes
// which factor comes when, not their product), and is
//     prod_a g_a(c_a)  /  D,   with
//     g_a(c) = prod_{i=0}^{c-1} [ (t_a + i) th + (1 - th) p_a ]
//     D      = prod_{j=0}^{2x-1} [ 1 + (nT + j - 1) th ].
// There are (2x)! / (c_1! ... c_m!) orders with those counts, so
//     P = (2x)!/D x sum over (c_1 ... c_m) of prod_a g_a(c_a)/c_a!,
// summed over every way to share the 2x draws among the alleles of
// M with c_a >= 1 for each allele of U (and c_a >= 0 for the
// others).  That sum is built ONE ALLELE AT A TIME: pbW(s + 1)
// holds the total, over the alleles taken so far, for the ways that
// use s of the 2x draws; taking allele a, every s passes its total
// on to s + c, times g_a(c)/c!, for each c it may take.  Every
// number added is a product of positive numbers, so nothing
// cancels and every step loses at most one rounding in the 12th
// digit: the answer keeps about 10 good digits however small it
// is.  It IS the inclusion-exclusion sum, rearranged -- verify
// checks the two equal in exact fractions (3,000 random loci, theta
// 0 to 0.499) and against brute-force enumeration of every order.
// The CAS formula view still writes the inclusion-exclusion form
// (dmCasP): the CAS works in exact fractions, where cancelling
// costs nothing.
//
// The size, at the program's limits (8 alleles, 4 unknowns: 2x =
// 8 draws): g for each allele, 8 x 8 = 64 products; the passes, at
// most 9 x 10 / 2 = 45 multiply-adds per allele, 360 in all; 8 for
// the final factor -- about 430 operations per call, where the old
// sum took up to 2^8 x 16 = 4,096 (|U| = 8).
//
// A result of exactly 0 now means one of the two rules below, or
// a probability below the smallest number the calculator holds
// (about 1E-499; frequencies would have to be absurdly small).
// ------------------------------------------------------------
dmProb(pbX, pbKn, pbTy)
BEGIN
  LOCAL pbIn, pbNU, pbNT, pbT, pbI, pbJ;
  LOCAL pbN, pbW, pbV, pbG, pbLo, pbK;
  LOCAL pbS, pbTot;

  // rule 1: a known contributor with an allele outside the mixture
  // (dmKnowns writes it as 0) -- impossible
  IF SIZE(pbKn) > 0 THEN
    FOR pbI FROM 1 TO SIZE(pbKn) DO
      IF pbKn(pbI) == 0 THEN RETURN 0; END;
    END;
  END;

  // which alleles of M still have to come from the unknowns: pbIn(a)
  // is 1 for an allele of U, 0 for one a known carries
  pbIn := MAKELIST(1, pbI, 1, dmM, 1);
  IF SIZE(pbKn) > 0 THEN
    FOR pbI FROM 1 TO SIZE(pbKn) DO pbIn(pbKn(pbI)) := 0; END;
  END;
  pbNU := 0;
  FOR pbI FROM 1 TO dmM DO pbNU := pbNU + pbIn(pbI); END;
  // rule 2: x unknowns bring 2x alleles; fewer than |U| cannot cover U
  IF pbNU > 2 * pbX THEN RETURN 0; END;
  IF pbX == 0 THEN RETURN 1; END;           // knowns explain M exactly
  pbN := 2 * pbX;                           // the unknown alleles drawn

  // typed alleles: how many in all (nT), and how many of each M
  // allele (t_a); a typed allele outside M counts in nT only
  pbNT := SIZE(pbTy);
  pbT := MAKELIST(0, pbI, 1, dmM, 1);
  FOR pbI FROM 1 TO pbNT DO
    IF pbTy(pbI) > 0 THEN pbT(pbTy(pbI)) := pbT(pbTy(pbI)) + 1; END;
  END;

  // pbW(s + 1): the summed weight of the ways the alleles taken so
  // far use s of the pbN draws.  Before any allele: one way, s = 0.
  pbW := MAKELIST(0, pbJ, 0, pbN, 1);
  pbW(1) := 1;
  FOR pbI FROM 1 TO dmM DO
    // pbG(c + 1) = g_a(c) / c! for this allele, c = 0 ... pbN: each
    // further copy multiplies by its NRC II numerator and divides by
    // c (building c! as it goes).  All of it positive.
    pbG := MAKELIST(1, pbJ, 0, pbN, 1);
    FOR pbK FROM 1 TO pbN DO
      pbG(pbK + 1) := pbG(pbK) * ((pbT(pbI) + pbK - 1) * dmTh + (1 - dmTh) * dmFq(pbI)) / pbK;
    END;
    // an allele of U must turn up at least once; the others may not
    pbLo := 0;
    IF pbIn(pbI) == 1 THEN pbLo := 1; END;
    // pass the totals on: s draws used so far, c more for this allele
    pbV := MAKELIST(0, pbJ, 0, pbN, 1);
    FOR pbS FROM 0 TO pbN DO
      IF pbW(pbS + 1) > 0 AND pbLo <= pbN - pbS THEN
        FOR pbK FROM pbLo TO pbN - pbS DO
          pbV(pbS + pbK + 1) := pbV(pbS + pbK + 1) + pbW(pbS + 1) * pbG(pbK + 1);
        END;
      END;
    END;
    pbW := pbV;
  END;

  // every one of the pbN draws used: times the (2x)! orders and over
  // the NRC II denominators, 1 + (nT + j - 1) th for j = 0 ... 2x-1
  pbTot := pbW(pbN + 1);
  FOR pbJ FROM 1 TO pbN DO
    pbTot := pbTot * pbJ / (1 + (pbNT + pbJ - 2) * dmTh);
  END;
  RETURN pbTot;
END;

// The alleles a hypothesis treats as KNOWN contributors', and the
// alleles of every typed person, both from the six genotype entries.
dmKnowns(knH)
BEGIN
  LOCAL knL;
  knL := {};
  IF dmPres(1) == 1 AND knH(1) == 1 THEN knL := CONCAT(knL, {dmGen(1), dmGen(2)}); END;
  IF dmPres(2) == 1 AND knH(2) == 1 THEN knL := CONCAT(knL, {dmGen(3), dmGen(4)}); END;
  IF dmPres(3) == 1 AND knH(3) == 1 THEN knL := CONCAT(knL, {dmGen(5), dmGen(6)}); END;
  RETURN knL;
END;

dmTyped()
BEGIN
  LOCAL tyL;
  tyL := {};
  IF dmPres(1) == 1 THEN tyL := CONCAT(tyL, {dmGen(1), dmGen(2)}); END;
  IF dmPres(2) == 1 THEN tyL := CONCAT(tyL, {dmGen(3), dmGen(4)}); END;
  IF dmPres(3) == 1 THEN tyL := CONCAT(tyL, {dmGen(5), dmGen(6)}); END;
  RETURN tyL;
END;

// Evaluate the locus held in dmLab / dmFq / dmGen under both
// hypotheses.  Returns {P(E|Hp), P(E|Hd), LR}, with LR = 0 when the
// suspect is excluded and -1 when Hd cannot explain the mixture.
dmEval()
BEGIN
  LOCAL evTy, evP, evD, evLR;
  dmM := SIZE(dmLab);
  evTy := dmTyped();
  evP := dmProb(dmHp(4), dmKnowns(dmHp), evTy);
  evD := dmProb(dmHd(4), dmKnowns(dmHd), evTy);
  IF evD <= 0 THEN
    evLR := -1;
  ELSE
    evLR := evP / evD;
  END;
  RETURN {evP, evD, evLR};
END;

// Recompute every stored locus (after theta changes) and the
// combined LR.  A locus with LR 0 or -1 is left out of the product
// and reported on its own -- and an LR of 0 is an EXCLUSION: the
// suspect cannot have contributed, so the true combined LR is 0
// whatever the other loci say.  dmExcl remembers the first such
// locus and every screen reports it instead of the product.  (Only
// a dropout model, which this teaching tool does not have, could
// rescue an exclusion.)
// Beta 2: a locus DROPPED on the Results page (dmInc = 0) is left
// out of the product and cannot exclude -- it is treated as if it
// had not been typed.  Its own LR, P(E|Hp) and P(E|Hd) are still
// computed and stored exactly as before; the flag only skips it.
dmRecalc()
BEGIN
  LOCAL rcI, rcRec, rcR;
  dmPp := {}; dmPd := {}; dmLR := {};
  dmComb := 1; dmExcl := 0; dmNDrop := 0;
  dmCvOK := 0;                  // the theta plot's cached curves are stale
  dmEdOK := 0;                  // beta 3: and so is theta at the ladder edge
  FOR rcI FROM 1 TO dmNL DO
    rcRec := dmLoc(rcI);
    dmLab := rcRec(1); dmFq := rcRec(2); dmGen := rcRec(3);
    rcR := dmEval();
    dmPp := CONCAT(dmPp, {rcR(1)});
    dmPd := CONCAT(dmPd, {rcR(2)});
    dmLR := CONCAT(dmLR, {rcR(3)});
    IF dmInc(rcI) == 1 THEN
      IF rcR(3) > 0 THEN dmComb := dmComb * rcR(3); END;
      IF rcR(3) == 0 AND dmExcl == 0 THEN dmExcl := rcI; END;
    ELSE
      dmNDrop := dmNDrop + 1;
    END;
  END;
  IF dmNL == 0 THEN dmComb := 0; END;
  DM_LOCI := dmLR; DM_TH := dmTh;
  IF dmExcl > 0 THEN
    DM_LR := 0; DM_LOG := 0;                 // excluded: the LR is 0
  ELSE
    DM_LR := dmComb;
    IF dmComb > 0 THEN DM_LOG := LOG(dmComb); ELSE DM_LOG := 0; END;
  END;
END;

// Combined LR at some other theta, without disturbing the session.
// Used by the theta plot.  Like dmRecalc it multiplies only the
// positive LRs of the included loci, so with an exclusion it is
// "the other loci" and the plot says so.
dmCombAt(caTh)
BEGIN
  LOCAL caSave, caI, caRec, caR, caC;
  caSave := dmTh;
  dmTh := caTh;
  caC := 1;
  FOR caI FROM 1 TO dmNL DO
    caRec := dmLoc(caI);
    dmLab := caRec(1); dmFq := caRec(2); dmGen := caRec(3);
    caR := dmEval();
    IF caR(3) > 0 AND dmInc(caI) == 1 THEN caC := caC * caR(3); END;
  END;
  dmTh := caSave;
  RETURN caC;
END;

// The running total of log10 LR, locus by locus, for the waterfall
// and the ladder.  dmCuV(i) is the total after locus i; dmCuS(i)
// says what locus i did to it: 1 added its log10 LR, 0 dropped
// (skipped), 2 no LR (Hd impossible: skipped, as in the product),
// 3 EXCLUDED here (LR = 0: log10 is minus infinity, so the total
// stops), 4 after an exclusion (nothing more is added).
dmCum()
BEGIN
  LOCAL cuI, cuC, cuStop, cuSt;
  dmCuV := {}; dmCuS := {};
  cuC := 0; cuStop := 0;
  FOR cuI FROM 1 TO dmNL DO
    cuSt := 1;
    IF dmInc(cuI) == 0 THEN
      cuSt := 0;
    ELSE
      IF cuStop == 1 THEN
        cuSt := 4;
      ELSE
        IF dmLR(cuI) == 0 THEN
          cuSt := 3; cuStop := 1;
        ELSE
          IF dmLR(cuI) < 0 THEN
            cuSt := 2;
          ELSE
            cuC := cuC + LOG(dmLR(cuI));
          END;
        END;
      END;
    END;
    dmCuV := CONCAT(dmCuV, {cuC});
    dmCuS := CONCAT(dmCuS, {cuSt});
  END;
END;

// The theta plot's two curves, computed once and cached: the
// combined log10 LR at the 21 thetas 0, 0.0025 ... 0.05, then the
// same with every allele frequency halved.  The halving is done on
// a temporary copy of the loci; the originals are put back before
// anything else runs.  42 passes over every locus -- never during
// a drag.
dmCurves()
BEGIN
  LOCAL cvI, cvJ, cvV, cvSave, cvRec, cvH;
  LOCAL cvF, cvF2;
  dmPtV := {}; dmPtH := {};
  FOR cvI FROM 0 TO 20 DO
    cvV := dmCombAt(0.05 * cvI / 20);
    IF cvV > 0 THEN cvV := LOG(cvV); ELSE cvV := 0; END;
    dmPtV := CONCAT(dmPtV, {cvV});
  END;
  // a copy of the loci with every frequency halved
  cvSave := dmLoc;
  cvH := {};
  FOR cvI FROM 1 TO dmNL DO
    cvRec := dmLoc(cvI);
    cvF := cvRec(2);
    cvF2 := {};
    FOR cvJ FROM 1 TO SIZE(cvF) DO cvF2 := CONCAT(cvF2, {cvF(cvJ) / 2}); END;
    cvH := CONCAT(cvH, {{cvRec(1), cvF2, cvRec(3)}});
  END;
  dmLoc := cvH;
  FOR cvI FROM 0 TO 20 DO
    cvV := dmCombAt(0.05 * cvI / 20);
    IF cvV > 0 THEN cvV := LOG(cvV); ELSE cvV := 0; END;
    dmPtH := CONCAT(dmPtH, {cvV});
  END;
  dmLoc := cvSave;                         // the originals back
  dmCvOK := 1;
END;

// log10 LR at any theta in 0 ... 0.05, read from a cached curve
// (21 points 0.0025 apart) by straight-line interpolation.  At a
// theta on the 0.0025 grid -- every theta the drag can set -- it is
// the cached value itself.
dmInterp(ipL, ipTh)
BEGIN
  LOCAL ipF, ipI, ipW;
  ipF := MAX(0, MIN(20, ipTh / 0.0025));
  ipI := MIN(19, FLOOR(ipF));
  ipW := ipF - ipI;
  RETURN ipL(ipI + 1) * (1 - ipW) + ipL(ipI + 2) * ipW;
END;


// ------------------------------------------------------------
// BETA 3, BESIDE THE ENGINE: THE SAME PROBABILITY AS CAS TEXT
//
// dmCasP writes out the inclusion-exclusion sum that dmProb added
// up in betas 1-3b (beta 3c's dmProb sums the same probability
// another way, to avoid cancelling; in the CAS's exact fractions
// cancelling costs nothing), step for step, but as
// TEXT, with the symbol dmq1 ... dmqm for the frequency of allele
// 1 ... m and dmt for theta in place of their values.  Only whole
// numbers appear in it (the typed-allele counts, written by
// dmIStr), so the CAS can read it whatever the Home settings.  For
// the classic locus (victim 12/13, suspect 14/15, Hd = victim + 1
// unknown) P(E|Hd) comes out as
//   ((4*dmt+(1-dmt)*(dmq1+dmq2+dmq3+dmq4))*(5*dmt+ ...) - ... )
//      / ((1+(3)*dmt)*(1+(4)*dmt))
// and the CAS simplifies the ratio to
//   (3*dmt+1)*(4*dmt+1)/(2*(dmt*dmq4-dmt-dmq4)*(dmq3*dmt-dmq3-dmt))
// which at theta = 0 is 1/(2*dmq3*dmq4) = 1/(2 p14 p15).
// dmProb itself is not touched by it: this is a separate copy of
// beta 2's structure, and the verify scripts check that the two
// agree to 1e-10 at many thetas and frequencies.
// ------------------------------------------------------------

// P(mixture | x unknowns) as CAS text.  cpKn, cpTy as for dmProb.
// cpZ = 1 writes it at theta = 0: every factor is then just
// p(M\S), and there is no denominator.  "0" when the hypothesis
// cannot produce the mixture, "1" when the knowns explain it.
dmCasP(cpX, cpKn, cpTy, cpZ)
BEGIN
  LOCAL cpIn, cpU, cpNU, cpNT, cpT, cpI;
  LOCAL cpMask, cpQ, cpBit, cpNS, cpTA, cpJ;
  LOCAL cpS, cpTerm, cpPs, cpC, cpDen, cpTM;
  LOCAL cpSel;

  // a known contributor with an allele outside the mixture: impossible
  FOR cpI FROM 1 TO SIZE(cpKn) DO
    IF cpKn(cpI) == 0 THEN RETURN "0"; END;
  END;
  // U: the alleles of M no known carries (as in dmProb; the lists are
  // built with FOR loops, so no MAKELIST counter is involved)
  cpIn := {};
  FOR cpI FROM 1 TO dmM DO cpIn := CONCAT(cpIn, {1}); END;
  FOR cpI FROM 1 TO SIZE(cpKn) DO cpIn(cpKn(cpI)) := 0; END;
  cpU := {};
  FOR cpI FROM 1 TO dmM DO
    IF cpIn(cpI) == 1 THEN cpU := CONCAT(cpU, {cpI}); END;
  END;
  cpNU := SIZE(cpU);
  IF cpNU > 2 * cpX THEN RETURN "0"; END;   // too few unknown alleles to cover M
  IF cpX == 0 THEN RETURN "1"; END;         // knowns explain M exactly

  // typed alleles: how many in all, and how many of each M allele
  cpNT := SIZE(cpTy);
  cpT := {};
  FOR cpI FROM 1 TO dmM DO cpT := CONCAT(cpT, {0}); END;
  FOR cpI FROM 1 TO cpNT DO
    IF cpTy(cpI) > 0 THEN cpT(cpTy(cpI)) := cpT(cpTy(cpI)) + 1; END;
  END;
  cpTM := 0;
  FOR cpI FROM 1 TO dmM DO cpTM := cpTM + cpT(cpI); END;

  // inclusion-exclusion over the subsets S of U, coded as bit masks
  cpS := "";
  FOR cpMask FROM 0 TO 2^cpNU - 1 DO
    // cpSel(i) = 1 while allele i is in M \ S
    cpSel := {};
    FOR cpI FROM 1 TO dmM DO cpSel := CONCAT(cpSel, {1}); END;
    cpTA := cpTM; cpNS := 0;
    cpQ := cpMask;
    FOR cpI FROM 1 TO cpNU DO
      cpBit := cpQ MOD 2;
      cpQ := (cpQ - cpBit) / 2;
      IF cpBit == 1 THEN
        cpNS := cpNS + 1;
        cpSel(cpU(cpI)) := 0;
        cpTA := cpTA - cpT(cpU(cpI));
      END;
    END;
    // p(M \ S): the sum of the symbols of the alleles left
    cpPs := ""; cpC := 0;
    FOR cpI FROM 1 TO dmM DO
      IF cpSel(cpI) == 1 THEN
        IF cpC > 0 THEN cpPs := cpPs + "+"; END;
        cpPs := cpPs + "dmq" + dmIStr(cpI);
        cpC := cpC + 1;
      END;
    END;
    IF cpC == 0 THEN cpPs := "0"; END;
    IF cpC > 1 THEN cpPs := "(" + cpPs + ")"; END;
    // the 2x factors (t(M\S) + j) theta + (1 - theta) p(M\S)
    cpTerm := "";
    FOR cpJ FROM 0 TO 2 * cpX - 1 DO
      IF cpJ > 0 THEN cpTerm := cpTerm + "*"; END;
      IF cpZ == 1 THEN
        cpTerm := cpTerm + cpPs;
      ELSE
        cpTerm := cpTerm + "(" + dmIStr(cpTA + cpJ) + "*dmt+(1-dmt)*" + cpPs + ")";
      END;
    END;
    // added when |S| is even, taken away when it is odd
    IF (cpNS MOD 2) == 1 THEN
      cpS := cpS + "-" + cpTerm;
    ELSE
      IF cpMask > 0 THEN cpS := cpS + "+"; END;
      cpS := cpS + cpTerm;
    END;
  END;
  IF cpZ == 1 THEN RETURN "(" + cpS + ")"; END;
  // the denominators 1 + (nT + j - 1) theta are the same for every
  // term, so they are written once, under the whole sum
  cpDen := "";
  FOR cpJ FROM 0 TO 2 * cpX - 1 DO
    IF cpJ > 0 THEN cpDen := cpDen + "*"; END;
    cpDen := cpDen + "(1+(" + dmIStr(cpNT + cpJ - 1) + ")*dmt)";
  END;
  RETURN "(" + cpS + ")/(" + cpDen + ")";
END;

// The LR of the locus held in dmLab / dmFq / dmGen as CAS text:
// P(E|Hp) / P(E|Hd), each written by dmCasP, inside
// factor(normal(...)) so that the CAS puts the ratio over one
// denominator and factors it.  lzZ = 1 writes it at theta = 0.
dmCasLR(lzZ)
BEGIN
  LOCAL lzTy, lzP, lzD;
  lzTy := dmTyped();
  lzP := dmCasP(dmHp(4), dmKnowns(dmHp), lzTy, lzZ);
  lzD := dmCasP(dmHd(4), dmKnowns(dmHd), lzTy, lzZ);
  RETURN "factor(normal((" + lzP + ")/(" + lzD + ")))";
END;

// The ENFSI band of a likelihood ratio, as a number: how many of
// the band edges (LR 10^-6, 10^-4, 0.001, 0.01, 0.1, 1/2, 2, 10,
// 100, 1000, 10^4 and 10^6 -- dmVerbal's, both sides) lie at or
// below it, 0 to 12.  Two LRs with the same number get the same
// words from dmVerbal.
dmBand(bnL)
BEGIN
  LOCAL bnE, bnI, bnN;
  bnE := {0.000001, 0.0001, 0.001, 0.01, 0.1, 0.5, 2, 10, 100, 1000, 10000, 1000000};
  bnN := 0;
  FOR bnI FROM 1 TO 12 DO
    IF bnL >= bnE(bnI) THEN bnN := bnN + 1; END;
  END;
  RETURN bnN;
END;

// THETA AT THE LADDER EDGE: as theta rises from the session theta,
// the first theta at which the combined LR leaves its ENFSI band.
// A numeric answer, so it is found in PPL (no CAS):
//   1. bracket it: walk up the 21 cached curve points (0.0025
//      apart, dmPtV) above the session theta, then 0.06, 0.08,
//      0.1, 0.15, 0.2 and 0.25 (dmCombAt), until the band changes;
//   2. bisect that bracket on log10 LR(theta) - log10(edge), with
//      dmCombAt, until it is less than 1E-8 wide.
// The edge is the lower edge of the starting band when the LR has
// fallen, the upper one when it has risen.  Sets dmEdT (the theta,
// or -1 when the band does not change up to 0.25, or -2 when there
// is nothing to look for) and dmEdV (the LR at the edge).
dmEdge()
BEGIN
  LOCAL egE, egB0, egI, egTa, egTb, egVa;
  LOCAL egVb, egTg, egF, egTm, egVm, egN;
  LOCAL egX;
  dmEdT := -2; dmEdV := 0; dmEdOK := 1;
  IF dmNL == 0 OR dmExcl > 0 OR dmComb <= 0 THEN RETURN; END;
  IF dmCvOK == 0 THEN dmCurves(); END;
  egE := {0.000001, 0.0001, 0.001, 0.01, 0.1, 0.5, 2, 10, 100, 1000, 10000, 1000000};
  egX := {0.06, 0.08, 0.1, 0.15, 0.2, 0.25};
  egB0 := dmBand(dmComb);                    // the band at the session theta
  egTa := dmTh; egVa := dmComb;              // the bracket's left end
  egTb := 0; egVb := 0; egN := 0;
  egI := 1;
  WHILE egI <= 27 AND egN == 0 DO
    IF egI <= 21 THEN egTm := 0.0025 * (egI - 1); ELSE egTm := egX(egI - 21); END;
    IF egTm > dmTh + 0.0000001 THEN
      IF egI <= 21 THEN egVm := 10^dmPtV(egI); ELSE egVm := dmCombAt(egTm); END;
      IF dmBand(egVm) <> egB0 THEN
        egN := 1; egTb := egTm; egVb := egVm;      // the band changed in here
      ELSE
        egTa := egTm; egVa := egVm;                // not yet: move the left end up
      END;
    END;
    egI := egI + 1;
  END;
  dmEdT := -1;
  IF egN == 0 THEN RETURN; END;              // no edge crossed up to theta 0.25
  IF dmBand(egVb) < egB0 THEN egTg := egE(egB0); ELSE egTg := egE(egB0 + 1); END;
  // bisection: keep the half where log10 LR - log10 edge changes sign
  egF := LOG(egVa) - LOG(egTg);
  WHILE egTb - egTa > 0.00000001 DO
    egTm := (egTa + egTb) / 2;
    egVm := LOG(dmCombAt(egTm)) - LOG(egTg);
    IF egVm * egF > 0 THEN egTa := egTm; ELSE egTb := egTm; END;
  END;
  dmEdT := (egTa + egTb) / 2;
  dmEdV := egTg;
END;



// ------------------------------------------------------------
// ENTERING A LOCUS
// ------------------------------------------------------------

// Ask for liM numbers with a common label; returns the list, or {}
// if cancelled.  INPUT needs a literal list of variable NAMES, so
// there is one call per size.  liD is the default for every field.
dmAskList(liM, liTtl, liLbl, liHlp, liD)
BEGIN
  LOCAL a1, a2, a3, a4, a5, a6;
  LOCAL a7, a8, liOK;
  a1 := liD; a2 := liD; a3 := liD; a4 := liD; a5 := liD; a6 := liD; a7 := liD; a8 := liD;
  liOK := 0;
  CASE
    IF liM == 2 THEN liOK := INPUT({a1, a2}, liTtl, {liLbl + " 1:", liLbl + " 2:"}, {liHlp, liHlp}); END;
    IF liM == 3 THEN liOK := INPUT({a1, a2, a3}, liTtl, {liLbl + " 1:", liLbl + " 2:", liLbl + " 3:"}, {liHlp, liHlp, liHlp}); END;
    IF liM == 4 THEN liOK := INPUT({a1, a2, a3, a4}, liTtl, {liLbl + " 1:", liLbl + " 2:", liLbl + " 3:", liLbl + " 4:"}, {liHlp, liHlp, liHlp, liHlp}); END;
    IF liM == 5 THEN liOK := INPUT({a1, a2, a3, a4, a5}, liTtl, {liLbl + " 1:", liLbl + " 2:", liLbl + " 3:", liLbl + " 4:", liLbl + " 5:"}, {liHlp, liHlp, liHlp, liHlp, liHlp}); END;
    IF liM == 6 THEN liOK := INPUT({a1, a2, a3, a4, a5, a6}, liTtl, {liLbl + " 1:", liLbl + " 2:", liLbl + " 3:", liLbl + " 4:", liLbl + " 5:", liLbl + " 6:"}, {liHlp, liHlp, liHlp, liHlp, liHlp, liHlp}); END;
    IF liM == 7 THEN liOK := INPUT({a1, a2, a3, a4, a5, a6, a7}, liTtl, {liLbl + " 1:", liLbl + " 2:", liLbl + " 3:", liLbl + " 4:", liLbl + " 5:", liLbl + " 6:", liLbl + " 7:"}, {liHlp, liHlp, liHlp, liHlp, liHlp, liHlp, liHlp}); END;
    IF liM == 8 THEN liOK := INPUT({a1, a2, a3, a4, a5, a6, a7, a8}, liTtl, {liLbl + " 1:", liLbl + " 2:", liLbl + " 3:", liLbl + " 4:", liLbl + " 5:", liLbl + " 6:", liLbl + " 7:", liLbl + " 8:"}, {liHlp, liHlp, liHlp, liHlp, liHlp, liHlp, liHlp, liHlp}); END;
  END;
  IF liOK == 0 THEN RETURN {}; END;
  RETURN SUB({a1, a2, a3, a4, a5, a6, a7, a8}, 1, liM);
END;

// Ask for the genotypes of the typed persons: two allele indices
// each (1..m, or 0 for an allele that is not in the mixture).
// Returns 1 if dmGen was filled in, 0 if cancelled.
// The six INPUT targets are dmGV1/2 (victim), dmGS1/2 (suspect) and
// dmGT1/2 (third person); beta 1 called them g1..g6, which are the
// names of the Prime's graphics variables G1..G6.
dmAskGen()
BEGIN
  LOCAL dmGV1, dmGV2, dmGS1, dmGS2, dmGT1, dmGT2;
  LOCAL gnOK, gnHlp, gnI;
  gnHlp := "1 to " + STRING(dmM, 2, 0) + " = allele number in the list; 0 = not in the mixture";
  dmGV1 := 1; dmGV2 := 2; dmGS1 := 1; dmGS2 := 2; dmGT1 := 1; dmGT2 := 2;
  gnOK := 0;
  CASE
    IF dmPres(1) == 1 AND dmPres(2) == 1 AND dmPres(3) == 0 THEN
      gnOK := INPUT({dmGV1, dmGV2, dmGS1, dmGS2}, "Genotypes (allele numbers)",
        {"Victim 1:", "Victim 2:", "Suspect 1:", "Suspect 2:"}, {gnHlp, gnHlp, gnHlp, gnHlp});
    END;
    IF dmPres(1) == 0 AND dmPres(2) == 1 AND dmPres(3) == 0 THEN
      gnOK := INPUT({dmGS1, dmGS2}, "Suspect genotype (allele numbers)",
        {"Suspect 1:", "Suspect 2:"}, {gnHlp, gnHlp});
    END;
    DEFAULT
      gnOK := INPUT({dmGV1, dmGV2, dmGS1, dmGS2, dmGT1, dmGT2}, "Genotypes (allele numbers)",
        {"Victim 1:", "Victim 2:", "Suspect 1:", "Suspect 2:", "Third 1:", "Third 2:"},
        {gnHlp, gnHlp, gnHlp, gnHlp, gnHlp, gnHlp});
  END;
  IF gnOK == 0 THEN RETURN 0; END;
  dmGen := {IP(dmGV1), IP(dmGV2), IP(dmGS1), IP(dmGS2), IP(dmGT1), IP(dmGT2)};
  // persons who are not part of the hypotheses carry no alleles
  IF dmPres(1) == 0 THEN dmGen(1) := 0; dmGen(2) := 0; END;
  IF dmPres(2) == 0 THEN dmGen(3) := 0; dmGen(4) := 0; END;
  IF dmPres(3) == 0 THEN dmGen(5) := 0; dmGen(6) := 0; END;
  FOR gnI FROM 1 TO 6 DO
    IF dmGen(gnI) < 0 OR dmGen(gnI) > dmM THEN
      MSGBOX("Allele numbers run from 1 to " + STRING(dmM, 2, 0) + " (0 = not in the mixture).");
      RETURN 0;
    END;
  END;
  RETURN 1;
END;



// ------------------------------------------------------------
// HYPOTHESES AND THETA
// ------------------------------------------------------------

// Set the typed persons and both hypotheses.  Changing WHO is typed
// makes the stored genotypes meaningless, so the loci are cleared
// then; changing only the contributor flags keeps them.
dmSetHyp()
BEGIN
  LOCAL shI, shPres, cuV, cuS, cuT, cuX;
  LOCAL hdV, hdS, hdT, hdX, shOK;
  shI := 0;
  CHOOSE(shI, "Hypotheses  Hp  vs  Hd", {
    "Victim + suspect   vs   victim + 1 unknown",
    "Suspect + 1 unknown   vs   2 unknowns",
    "Suspect alone   vs   1 unknown  (single source)",
    "Victim + suspect + 1 unknown   vs   victim + 2 unknowns",
    "Custom: choose the persons and contributors"});
  IF shI == 0 THEN RETURN; END;
  shPres := dmPres;
  CASE
    IF shI == 1 THEN shPres := {1, 1, 0}; dmHp := {1, 1, 0, 0}; dmHd := {1, 0, 0, 1}; END;
    IF shI == 2 THEN shPres := {0, 1, 0}; dmHp := {0, 1, 0, 1}; dmHd := {0, 0, 0, 2}; END;
    IF shI == 3 THEN shPres := {0, 1, 0}; dmHp := {0, 1, 0, 0}; dmHd := {0, 0, 0, 1}; END;
    IF shI == 4 THEN shPres := {1, 1, 0}; dmHp := {1, 1, 0, 1}; dmHd := {1, 0, 0, 2}; END;
    DEFAULT
      cuV := dmPres(1); cuS := dmPres(2); cuT := dmPres(3);
      shOK := INPUT({cuV, cuS, cuT}, "Typed persons (1 = yes, 0 = no)",
        {"Victim typed?", "Suspect typed?", "Third person typed?"},
        {"A victim whose profile is known", "The suspect", "Another typed person, e.g. a consensual partner"});
      IF shOK == 0 THEN RETURN; END;
      // beta 3c (B1): a yes/no answer is 1 or 0.  Any other number
      // (a typed 2, say) is "no", because every test in the program
      // asks "== 1"; storing the 2 left the victim untyped in the
      // maths while dmAskGen still asked for the victim's genotype.
      shPres := {IFTE(IP(cuV) == 1, 1, 0), IFTE(IP(cuS) == 1, 1, 0), IFTE(IP(cuT) == 1, 1, 0)};
      cuV := dmHp(1); cuS := dmHp(2); cuT := dmHp(3); cuX := dmHp(4);
      shOK := INPUT({cuV, cuS, cuT, cuX}, "Hp (prosecution): who contributed?",
        {"Victim contributes?", "Suspect contributes?", "Third contributes?", "Unknown contributors:"},
        {"1 = yes, 0 = no", "1 = yes, 0 = no", "1 = yes, 0 = no", "0 to 4 unknown people"});
      IF shOK == 0 THEN RETURN; END;
      hdV := dmHd(1); hdS := dmHd(2); hdT := dmHd(3); hdX := dmHd(4);
      shOK := INPUT({hdV, hdS, hdT, hdX}, "Hd (defence): who contributed?",
        {"Victim contributes?", "Suspect contributes?", "Third contributes?", "Unknown contributors:"},
        {"1 = yes, 0 = no", "1 = yes, 0 = no", "1 = yes, 0 = no", "0 to 4 unknown people"});
      IF shOK == 0 THEN RETURN; END;
      // beta 3c (B1): test the unknown counts FIRST.  Beta 3b stored
      // dmHp and dmHd and only then tested them, so after the "0 to 4"
      // box the refused count (5, or -1) stayed in force for every
      // locus.  Now a refused count leaves both hypotheses (and the
      // typed persons) exactly as they were.
      IF IP(cuX) < 0 OR IP(cuX) > 4 OR IP(hdX) < 0 OR IP(hdX) > 4 THEN
        MSGBOX("Unknown contributors: 0 to 4 under each hypothesis.");
        RETURN;
      END;
      // the counts are good: store both hypotheses, each yes/no
      // answer forced to 1 or 0 (as for the typed persons above)
      dmHp := {IFTE(IP(cuV) == 1, 1, 0), IFTE(IP(cuS) == 1, 1, 0), IFTE(IP(cuT) == 1, 1, 0), IP(cuX)};
      dmHd := {IFTE(IP(hdV) == 1, 1, 0), IFTE(IP(hdS) == 1, 1, 0), IFTE(IP(hdT) == 1, 1, 0), IP(hdX)};
  END;
  IF shPres(1) <> dmPres(1) OR shPres(2) <> dmPres(2) OR shPres(3) <> dmPres(3) THEN
    IF dmNL > 0 THEN
      MSGBOX("The typed persons changed, so the " + STRING(dmNL, 2, 0) + " stored loci were cleared: their genotypes no longer match.");
    END;
    dmPres := shPres;
    dmClearLoci();
  ELSE
    dmRecalc();
  END;
END;

dmClearLoci()
BEGIN
  dmNL := 0; dmLoc := {}; dmLR := {}; dmPp := {}; dmPd := {}; dmComb := 0;
  dmExcl := 0;
  dmInc := {}; dmNDrop := 0; dmSel := 1; dmShow := 0; dmTSel := 1;
  dmCuV := {}; dmCuS := {}; dmCvOK := 0;
  dmEdOK := 0;                  // beta 3: theta at the ladder edge is stale
  DM_LR := 0; DM_LOG := 0; DM_LOCI := {}; DM_TH := dmTh;
END;

dmSetTheta()
BEGIN
  LOCAL stT, stCv;
  stT := dmTh;
  IF INPUT({stT}, "Coancestry coefficient", {"theta:"},
    {"0 = product rule; 0.01 typical; 0.03 conservative (NRC II)"}) == 1 THEN
    IF stT < 0 OR stT >= 0.5 THEN
      MSGBOX("theta must be at least 0 and well below 0.5; 0.01 to 0.03 is the usual range.");
      RETURN;
    END;
    dmTh := stT;
    // the theta plot's curves run over every theta, so a new session
    // theta does not make them stale: keep the cache
    stCv := dmCvOK;
    dmRecalc();
    dmCvOK := stCv;
  END;
END;


// ------------------------------------------------------------
// THE ENFSI VERBAL LADDER
// The bands are dmVerbal's: an LR (or 1/LR, for Hd) under 2 is
// "about equal", 2-10 weak, 10-100 moderate, 100-1000 moderately
// strong, 1000-10^4 strong, 10^4-10^6 very strong, above 10^6
// extremely strong.  On a log10 scale the edges are 0.301 (log10
// 2), 1, 2, 3, 4 and 6, the same on the Hd side with a minus sign.
// The ladder runs from log10 LR = +7 at the top to -7 at the
// bottom, so the extremely-strong bands show; a value beyond +-7
// is drawn at the end.
// ------------------------------------------------------------

// The y pixel of a log10 LR on a ladder from lyT (log10 +7) to
// lyB (log10 -7).
dmLadY(lyV, lyT, lyB)
BEGIN
  RETURN lyT + IP((7 - MAX(-7, MIN(7, lyV))) / 14 * (lyB - lyT));
END;

// Draw the ladder into the grob lgG between x lgX1..lgX2 and y
// lgT..lgB, with the band names to the right: short names (lgMode
// 1, the theta plot) or full names (lgMode 2, the ladder page).
// Hp bands light blue with blue names, Hd bands light red with red
// names, "about equal" light orange.  Each band is one RECT_P with
// a grey border, so the borders are the band edges.
dmLadDraw(lgG, lgX1, lgX2, lgT, lgB, lgMode)
BEGIN
  LOCAL lgE, lgI, lgY1, lgY2, lgS, lgC;
  LOCAL lgN, lgYm, lgTc;
  lgE := {7, 6, 4, 3, 2, 1, 0.30103, -0.30103, -1, -2, -3, -4, -6, -7};
  lgN := {"extreme", "v.strong", "strong", "mod.str", "moderate", "weak"};
  IF lgMode == 2 THEN
    lgN := {"extremely strong", "very strong", "strong", "moderately strong", "moderate", "weak"};
  END;
  FOR lgI FROM 1 TO 13 DO
    lgY1 := dmLadY(lgE(lgI), lgT, lgB);
    lgY2 := dmLadY(lgE(lgI + 1), lgT, lgB);
    lgC := dmLRED;
    IF lgI <= 6 THEN lgC := dmLBLU; END;
    IF lgI == 7 THEN lgC := dmPANL; END;
    RECT_P(lgG, lgX1, lgY1, lgX2, lgY2, dmGRAY, lgC);
    // the band's name, centred on it (font 1 is about 10 px tall);
    // the two "weak" names are nudged 2 px toward the zero line so
    // they clear "moderate"
    lgS := "";
    lgTc := dmBLUE;
    IF lgI <= 6 THEN lgS := lgN(lgI); END;
    IF lgI >= 8 THEN lgS := lgN(14 - lgI); lgTc := dmRED; END;
    IF lgS <> "" THEN
      lgYm := IP((lgY1 + lgY2) / 2) - 5;
      IF lgI == 6 THEN lgYm := lgYm + 2; END;
      IF lgI == 8 THEN lgYm := lgYm - 2; END;
      TEXTOUT_P(lgS, lgG, lgX2 + 4, lgYm, 1, lgTc);
    END;
  END;
END;

// The red "you are here" marker on a ladder at log10 LR mkV: a bar
// across the ladder and a block to its left.
dmMark(mkX1, mkX2, mkT, mkB, mkV)
BEGIN
  LOCAL mkY;
  mkY := dmLadY(mkV, mkT, mkB);
  RECT_P(G1, mkX1 - 4, mkY - 1, mkX2 + 1, mkY + 1, dmRED, dmRED);
  RECT_P(G1, mkX1 - 8, mkY - 3, mkX1 - 4, mkY + 3, dmRED, dmRED);
END;


// ------------------------------------------------------------
// PAGE 1: THE LOCUS PLOT -- log10 LR by locus as bars with the
// running total (magenta line), or as a WATERFALL.  Tap a bar for
// its numbers.
// ------------------------------------------------------------

// The strip that takes the footer's place when a locus is
// selected: its alleles, P(E|Hp), P(E|Hd), LR, log10 LR and verbal.
// Three rows, y 184-215, above the soft keys.
dmStrip(stI)
BEGIN
  LOCAL stRec, stS, stLR;
  stRec := dmLoc(stI);
  stLR := dmLR(stI);
  stS := "Locus " + STRING(stI, 2, 0) + ": " + dmAllStr(stRec(1));
  IF SIZE(stS) > 28 THEN stS := LEFT(stS, 26) + ".."; END;
  TEXTOUT_P(stS, G1, 6, 184, 1, #000000h);
  TEXTOUT_P("P(E|Hp) = " + dmBig(dmPp(stI)), G1, 176, 184, 1, dmBLUE);
  TEXTOUT_P("P(E|Hd) = " + dmBig(dmPd(stI)), G1, 176, 195, 1, dmBLUE);
  CASE
    IF stLR == 0 THEN TEXTOUT_P("LR = 0: excluded here", G1, 6, 195, 1, dmRED); END;
    IF stLR < 0 THEN TEXTOUT_P("no LR: Hd impossible", G1, 6, 195, 1, dmRED); END;
    DEFAULT
      TEXTOUT_P("LR = " + dmBig(stLR) + ", log10 = " + dmF(LOG(stLR), 3), G1, 6, 195, 1, dmMAG);
      TEXTOUT_P(dmVerbal(stLR), G1, 6, 206, 1, dmGRN);
  END;
  IF dmInc(stI) == 0 THEN
    TEXTOUT_P("dropped", G1, 262, 206, 1, dmGRAY);
  ELSE
    TEXTOUT_P("Ent = more", G1, 254, 206, 1, dmFOOT);
  END;
END;

// Which locus a tap at (htX, htY) is on, or 0.  It uses the same
// plot box (dmP1L ... dmP1B) and the same column width as the
// drawing: a column runs the full height of the box, down to the
// locus numbers under it.  The waterfall has one more column, the
// total, which is not a locus.
dmHitLocus(htX, htY)
BEGIN
  LOCAL htN, htBw, htI;
  htN := dmNL;
  IF dmWF == 1 THEN htN := dmNL + 1; END;
  htBw := IP((dmP1R - dmP1L) / htN);
  IF htY < 22 OR htY > dmP1B + 16 OR htX < dmP1L THEN RETURN 0; END;
  htI := IP((htX - dmP1L) / htBw) + 1;
  IF htI > dmNL THEN RETURN 0; END;
  RETURN htI;
END;

// Compose the locus plot in G1 (shown by dmMenu).
dmDrawLoci()
BEGIN
  LOCAL plI, plLo, plHi, plStp, plV, plY;
  LOCAL plX, plBw, plPX, plPrev, plZero, plL;
  LOCAL plT, plB, plR, plDec, plS, plH;
  LOCAL plOff, plLy, plTop, plRef, plN, plY0;
  LOCAL plC1, plFill, plSt, plTc, plCx, plPC;
  //  plOff, plLy: how far above a bar its label sits, and where.
  //  With 12 loci the bars are 21 px apart and a label is up to 33
  //  px wide, so it overlaps its two neighbours' labels sideways
  //  (never the labels two bars away, 42 px off).  Below a 30-px
  //  pitch the labels therefore alternate between two rows: an odd
  //  locus 12 px above its own bar, an even locus 23 px above the
  //  HIGHEST of itself and its two neighbours (plRef), so it always
  //  clears both neighbours' labels by 11 px, whatever the heights.
  //  plTop holds the top of every locus's mark (bar top, or the zero
  //  line for a locus with no bar), built in a plain FOR loop.
  plL := dmP1L; plR := dmP1R; plT := dmP1T; plB := dmP1B;   // the plot box
  dmCum();
  // vertical range: every bar (bars view) and the running total,
  // including 0
  plLo := 0; plHi := 0;
  FOR plI FROM 1 TO dmNL DO
    IF dmWF == 0 AND dmLR(plI) > 0 THEN
      plV := LOG(dmLR(plI));
      plLo := MIN(plLo, plV); plHi := MAX(plHi, plV);
    END;
    IF dmCuS(plI) == 1 THEN
      plLo := MIN(plLo, dmCuV(plI)); plHi := MAX(plHi, dmCuV(plI));
    END;
  END;
  IF plHi - plLo < 0.5 THEN plHi := plLo + 0.5; END;
  plStp := dmNice((plHi - plLo) / 5, 1);
  plLo := FLOOR(plLo / plStp) * plStp;
  plHi := CEILING(plHi / plStp) * plStp;
  IF plHi == plLo THEN plHi := plLo + plStp; END;
  plDec := MAX(0, -FLOOR(LOG(plStp)));
  plH := plB - plT;

  DIMGROB_P(G1, 320, 240, #FFFFFFh);
  // beta 3c: the titles moved left (x 100 and 70 before) to leave the
  // right of the title row for the teaching-aid notice (x 202 on)
  IF dmWF == 0 THEN
    TEXTOUT_P("log10 LR by locus", G1, 60, 2, 2, dmBLUE);
  ELSE
    TEXTOUT_P("Waterfall: log10 LRs add", G1, 8, 2, 2, dmBLUE);
  END;
  // beta 3c (Roger, 19 Oct 2026): the page states the combined LR, so it
  // says it is a teaching aid -- short, the only room left on a plot page
  TEXTOUT_P("Teaching aid only", G1, 202, 6, 1, dmRED);
  // grid and y labels
  plV := plLo;
  WHILE plV <= plHi + plStp / 1000 DO
    plY := plB - IP((plV - plLo) / (plHi - plLo) * plH);
    LINE_P(G1, plL, plY, plR, plY, dmGRID);
    // beta 3b: through dmF (rounded): counted up from a negative
    // bottom, the tick at 0 can land a hair off it
    plS := dmF(plV, plDec);
    TEXTOUT_P(plS, G1, plL - 4 - 6 * SIZE(plS), plY - 5, 1, dmGRAY);
    plV := plV + plStp;
  END;
  plZero := plB - IP((0 - plLo) / (plHi - plLo) * plH);
  LINE_P(G1, plL, plZero, plR, plZero, #000000h);
  LINE_P(G1, plL, plT, plL, plB, #000000h);

  // columns: one per locus, plus the total in the waterfall; the
  // touch handler (dmHitLocus) divides the box the same way
  plN := dmNL;
  IF dmWF == 1 THEN plN := dmNL + 1; END;
  plBw := IP((plR - plL) / plN);

  // the top of each locus's mark, for the label rows below
  plTop := {};
  plPC := 0;                                   // running total before the locus
  FOR plI FROM 1 TO dmNL DO
    plY := plZero;
    IF dmWF == 0 THEN
      IF dmLR(plI) > 0 THEN
        plY := MIN(plZero, plB - IP((LOG(dmLR(plI)) - plLo) / (plHi - plLo) * plH));
      END;
    ELSE
      plY := plB - IP((plPC - plLo) / (plHi - plLo) * plH);
      IF dmCuS(plI) == 1 THEN
        plY := MIN(plY, plB - IP((dmCuV(plI) - plLo) / (plHi - plLo) * plH));
      END;
      IF dmCuS(plI) == 3 OR dmCuS(plI) == 4 THEN plY := plT; END;
      plPC := dmCuV(plI);
    END;
    plTop := CONCAT(plTop, {plY});
  END;

  plPrev := -1; plPX := 0; plPC := 0;
  FOR plI FROM 1 TO dmNL DO
    plX := plL + (plI - 1) * plBw;
    plCx := plX + IP(plBw / 2);                // the column's centre
    plSt := dmCuS(plI);
    // label row: 12 px above the bar; when the bars are too close
    // for one row, every second locus goes 23 px above the highest
    // of itself and its neighbours; never into the title (y < 18)
    plOff := 12;
    plRef := plTop(plI);
    IF plBw < 30 AND (plI MOD 2) == 0 THEN
      plOff := 23;
      plRef := MIN(plRef, plTop(plI - 1));
      IF plI < dmNL THEN plRef := MIN(plRef, plTop(plI + 1)); END;
    END;
    plLy := MAX(18, plRef - plOff);
    IF dmWF == 0 THEN
      // ---- bars: log10 LR of each locus from the zero line ----
      IF dmLR(plI) > 0 THEN
        plV := LOG(dmLR(plI));
        plY := plB - IP((plV - plLo) / (plHi - plLo) * plH);
        plC1 := dmBLUE; plTc := dmBLUE;
        IF plY < plZero THEN plFill := dmSHAD; ELSE plFill := dmLRED; END;
        IF dmInc(plI) == 0 THEN plC1 := dmGRAY; plTc := dmGRAY; plFill := #FFFFFFh; END;
        IF plI == dmSel AND dmShow == 1 THEN plFill := plC1; END;    // selected: solid
        RECT_P(G1, plX + 3, MIN(plY, plZero), plX + plBw - 3, MAX(plY, plZero), plC1, plFill);
        plS := dmF(plV, 2);
        TEXTOUT_P(plS, G1, plCx - 3 * SIZE(plS), plLy, 1, plTc);
      ELSE
        IF dmLR(plI) == 0 THEN
          // excluded: log10(0) has no bar height, so the whole column
          // goes red, which is the point -- this locus ends the case
          // (grey if the locus is dropped)
          IF dmInc(plI) == 1 THEN
            RECT_P(G1, plX + 3, plT, plX + plBw - 3, plB, dmRED, dmLRED);
            TEXTOUT_P("excl.", G1, plCx - 15, plLy, 1, dmRED);
          ELSE
            RECT_P(G1, plX + 3, plT, plX + plBw - 3, plB, dmGRAY, #FFFFFFh);
            TEXTOUT_P("excl.", G1, plCx - 15, plLy, 1, dmGRAY);
          END;
        ELSE
          TEXTOUT_P("no LR", G1, plCx - 15, plLy, 1, dmRED);
        END;
        IF plI == dmSel AND dmShow == 1 THEN
          RECT_P(G1, plCx - 2, plZero - 2, plCx + 2, plZero + 2, dmRED, dmRED);
        END;
      END;
      // the running total, as a magenta line through the loci that
      // count; it stops at an exclusion
      IF plSt == 1 THEN
        plY := plB - IP((dmCuV(plI) - plLo) / (plHi - plLo) * plH);
        IF plPrev >= 0 THEN LINE_P(G1, plPX, plPrev, plCx, plY, dmMAG); END;
        RECT_P(G1, plCx - 2, plY - 2, plCx + 2, plY + 2, dmMAG, dmMAG);
        plPrev := plY; plPX := plCx;
      END;
    ELSE
      // ---- waterfall: a floating bar from the total before this
      // locus to the total after it ----
      plY0 := plB - IP((plPC - plLo) / (plHi - plLo) * plH);
      CASE
        IF plSt == 1 THEN
          plY := plB - IP((dmCuV(plI) - plLo) / (plHi - plLo) * plH);
          plC1 := dmBLUE; plFill := dmSHAD;               // supports Hp
          IF dmLR(plI) < 1 THEN plC1 := dmRED; plFill := dmLRED; END;   // supports Hd
          IF plI == dmSel AND dmShow == 1 THEN plFill := plC1; END;
          RECT_P(G1, plX + 3, MIN(plY, plY0), plX + plBw - 3, MAX(plY, plY0), plC1, plFill);
          plV := dmCuV(plI) - plPC;
          plS := dmF(plV, 2);
          IF plV > 0 THEN plS := "+" + plS; END;
          TEXTOUT_P(plS, G1, plCx - 3 * SIZE(plS), plLy, 1, plC1);
          plPC := dmCuV(plI);
        END;
        IF plSt == 0 THEN
          LINE_P(G1, plX + 3, plY0, plX + plBw - 3, plY0, dmGRAY);
          TEXTOUT_P("drop", G1, plCx - 12, plLy, 1, dmGRAY);
        END;
        IF plSt == 2 THEN
          LINE_P(G1, plX + 3, plY0, plX + plBw - 3, plY0, dmRED);
          TEXTOUT_P("no LR", G1, plCx - 15, plLy, 1, dmRED);
        END;
        IF plSt == 3 THEN
          // the exclusion: the running total stops here.  The word
          // runs to the right, over the columns after it, which stay
          // empty
          RECT_P(G1, plX + 3, plT, plX + plBw - 3, plB, dmRED, dmLRED);
          TEXTOUT_P("EXCLUDED", G1, plX + 2, plT + 2, 1, dmRED);
        END;
      END;
      IF plSt == 3 OR plSt == 4 THEN
        IF plI == dmSel AND dmShow == 1 THEN
          RECT_P(G1, plCx - 2, plB - 6, plCx + 2, plB - 2, dmRED, dmRED);
        END;
      ELSE
        // thin grey link from this bar's end to the next column
        plY := plB - IP((plPC - plLo) / (plHi - plLo) * plH);
        LINE_P(G1, plX + plBw - 3, plY, plX + plBw + 3, plY, dmGRAY);
        IF plSt <> 1 AND plI == dmSel AND dmShow == 1 THEN
          RECT_P(G1, plCx - 2, plY - 2, plCx + 2, plY + 2, dmRED, dmRED);
        END;
      END;
    END;
    plTc := dmGRAY;
    IF plI == dmSel AND dmShow == 1 THEN plTc := dmRED; END;
    TEXTOUT_P(STRING(plI, 2, 0), G1, plCx - 3, plB + 6, 1, plTc);
  END;
  // the waterfall's last column: the total, from 0 (magenta frame)
  IF dmWF == 1 THEN
    plX := plL + dmNL * plBw;
    plCx := plX + IP(plBw / 2);
    IF dmExcl > 0 THEN
      TEXTOUT_P("excl.", G1, plCx - 15, plB - 14, 1, dmRED);
    ELSE
      plY := plB - IP((plPC - plLo) / (plHi - plLo) * plH);
      RECT_P(G1, plX + 3, MIN(plY, plZero), plX + plBw - 3, MAX(plY, plZero), dmMAG, #FFFFFFh);
      RECT_P(G1, plX + 4, MIN(plY, plZero) + 1, plX + plBw - 4, MAX(plY, plZero) - 1, dmMAG, #FFFFFFh);
      plS := dmF(plPC, 2);
      TEXTOUT_P(plS, G1, plCx - 3 * SIZE(plS), MAX(18, MIN(plY, plZero) - 12), 1, dmMAG);
    END;
    TEXTOUT_P("all", G1, plCx - 9, plB + 6, 1, dmMAG);
  END;
  // the axis title sits at the left, level with the locus numbers
  TEXTOUT_P("locus", G1, 6, plB + 6, 1, dmGRAY);

  // the bottom rows: the selected locus's strip, or the legend,
  // the combined result and the footer
  IF dmShow == 1 THEN
    dmStrip(dmSel);
  ELSE
    IF dmWF == 0 THEN
      TEXTOUT_P("bars: log10 LR per locus; line: running total", G1, 6, 184, 1, dmGRAY);
    ELSE
      TEXTOUT_P("blue: supports Hp, red: supports Hd, grey: links", G1, 6, 184, 1, dmGRAY);
    END;
    IF dmExcl > 0 THEN
      TEXTOUT_P("EXCLUDED at locus " + STRING(dmExcl, 2, 0) + " (LR = 0)", G1, 6, 195, 1, dmRED);
    ELSE
      IF dmComb > 0 THEN
        plS := "combined LR = " + dmBig(dmComb);
        IF dmNDrop > 0 THEN plS := plS + "  (" + STRING(dmNDrop, 2, 0) + " dropped)"; END;
        TEXTOUT_P(plS, G1, 6, 195, 1, dmMAG);
      END;
    END;
    IF dmWF == 0 THEN
      TEXTOUT_P("tap bar = numbers, + = waterfall, Esc = menu", G1, 6, 206, 1, dmFOOT);
    ELSE
      TEXTOUT_P("tap bar = numbers, + = bars, Esc = menu", G1, 6, 206, 1, dmFOOT);
    END;
  END;
END;

// The locus plot as a page: tap a bar (or Left/Right) to select a
// locus -- its strip replaces the footer and the bar turns solid;
// tap it again (or Enter) for the locus page; + or a tap on the
// title switches bars / waterfall.  Returns the next page.
dmPlotLoci()
BEGIN
  LOCAL lvK, lvGo, lvRet, lvI;
  IF dmNL == 0 THEN
    MSGBOX("No loci yet.  Enter a locus first.");
    RETURN 0;
  END;
  IF dmSel < 1 OR dmSel > dmNL THEN dmSel := 1; dmShow := 0; END;
  lvGo := 1; lvRet := 0;
  REPEAT lvK := GETKEY; UNTIL lvK == -1;
  dmDrain();
  WHILE lvGo == 1 DO
    dmDrawLoci();
    dmMenu();
    lvK := dmPoll();
    IF lvK == -1 THEN
      dmDrain();                              // act on the press, after the lift
      IF dmTY >= 218 THEN
        lvRet := dmSoft(dmTX);
        IF lvRet == 1 THEN dmShow := 0; ELSE lvGo := 0; END;   // Locus: this page
      ELSE
        IF dmTY < 22 THEN
          dmWF := 1 - dmWF;                   // a tap on the title
        ELSE
          lvI := dmHitLocus(dmTX, dmTY);
          IF lvI > 0 THEN
            IF lvI == dmSel AND dmShow == 1 THEN
              lvRet := 7; lvGo := 0;          // tapped again: the locus page
            ELSE
              dmSel := lvI; dmShow := 1;
            END;
          ELSE
            dmShow := 0;                      // off the bars: hide the strip
          END;
        END;
      END;
    ELSE
      IF lvK == 7 THEN dmSel := MAX(1, dmSel - 1); dmShow := 1; END;        // Left
      IF lvK == 8 THEN dmSel := MIN(dmNL, dmSel + 1); dmShow := 1; END;     // Right
      IF lvK == 50 THEN dmWF := 1 - dmWF; END;                              // +
      IF lvK == 30 THEN                                                     // Enter
        IF dmShow == 1 THEN lvRet := 7; lvGo := 0; ELSE dmShow := 1; END;
      END;
      IF lvK == 4 THEN lvRet := 0; lvGo := 0; END;                          // Esc
      REPEAT lvK := GETKEY; UNTIL lvK == -1;
    END;
  END;
  RETURN lvRet;
END;


// ------------------------------------------------------------
// PAGE 2: THE THETA PLOT -- the combined log10 LR as theta runs
// from 0 to 0.05, for your frequencies (blue) and with every
// frequency halved (magenta); the usual range 0.01-0.03 shaded;
// drag a finger across it to move theta, with the ENFSI ladder at
// the right showing where that LR falls.
// ------------------------------------------------------------

// The theta a finger at x stands for: 0.05 (x - left)/(right -
// left), snapped to 0.0025 (one of the 21 cached points) and kept
// inside 0 ... 0.05.
dmThX(txX)
BEGIN
  LOCAL txT;
  txT := 0.05 * (txX - dmP2L) / (dmP2R - dmP2L);
  txT := ROUND(txT / 0.0025, 0) * 0.0025;
  RETURN MAX(0, MIN(0.05, txT));
END;

// Compose everything on the theta plot that does NOT move with the
// finger, once, into G2: axes, the shaded band, both curves, the
// ladder, the legends and the footer.  The drag then only copies
// G2 to G1 and draws the moving parts on top (dmThFrame).
dmThStatic()
BEGIN
  LOCAL tsI, tsV, tsY, tsX, tsS, tsStp;
  LOCAL tsDec, tsPrev, tsH, tsX2, tsLo, tsHi;
  LOCAL tsW, tsS2;
  // the vertical range covers both curves
  tsLo := 1E10; tsHi := -1E10;
  FOR tsI FROM 1 TO 21 DO
    tsLo := MIN(tsLo, MIN(dmPtV(tsI), dmPtH(tsI)));
    tsHi := MAX(tsHi, MAX(dmPtV(tsI), dmPtH(tsI)));
  END;
  IF tsHi - tsLo < 0.2 THEN tsHi := tsHi + 0.1; tsLo := tsLo - 0.1; END;
  tsStp := dmNice((tsHi - tsLo) / 4, 1);
  tsLo := FLOOR(tsLo / tsStp) * tsStp;
  tsHi := CEILING(tsHi / tsStp) * tsStp;
  IF tsHi == tsLo THEN tsHi := tsLo + tsStp; END;
  tsDec := MAX(0, -FLOOR(LOG(tsStp)));
  dmYLo := tsLo; dmYHi := tsHi;               // dmThFrame maps with these
  tsH := dmP2B - dmP2T;
  tsW := dmP2R - dmP2L;

  DIMGROB_P(G2, 320, 240, #FFFFFFh);
  // beta 3c: the title moved left (x 30 before), and the teaching-aid
  // notice sits at the right of the title row (Roger, 19 Oct 2026)
  TEXTOUT_P("log10 LR against theta", G2, 24, 2, 2, dmBLUE);
  TEXTOUT_P("Teaching aid only", G2, 202, 6, 1, dmRED);
  // the usual range, theta 0.01 to 0.03, as a light green band
  tsX := dmP2L + IP(0.2 * tsW);
  tsX2 := dmP2L + IP(0.6 * tsW);
  RECT_P(G2, tsX, dmP2T, tsX2, dmP2B, dmLGRN, dmLGRN);
  // grid and y labels
  tsV := tsLo;
  WHILE tsV <= tsHi + tsStp / 1000 DO
    tsY := dmP2B - IP((tsV - tsLo) / (tsHi - tsLo) * tsH);
    LINE_P(G2, dmP2L, tsY, dmP2R, tsY, dmGRID);
    // beta 3b: through dmF (rounded), as on the locus plot
    tsS := dmF(tsV, tsDec);
    TEXTOUT_P(tsS, G2, dmP2L - 4 - 6 * SIZE(tsS), tsY - 5, 1, dmGRAY);
    tsV := tsV + tsStp;
  END;
  LINE_P(G2, dmP2L, dmP2B, dmP2R, dmP2B, #000000h);
  LINE_P(G2, dmP2L, dmP2T, dmP2L, dmP2B, #000000h);
  FOR tsI FROM 0 TO 5 DO
    tsX := dmP2L + IP(tsI / 5 * tsW);
    LINE_P(G2, tsX, dmP2B, tsX, dmP2B + 3, #000000h);
    tsS := STRING(0.01 * tsI, 2, 2);
    TEXTOUT_P(tsS, G2, MIN(tsX - 3 * SIZE(tsS), 236 - 6 * SIZE(tsS)), dmP2B + 5, 1, dmGRAY);
  END;
  // the session theta, dotted green (the solid green line is the
  // theta under the finger)
  IF dmTh <= 0.05 THEN
    tsX := dmP2L + IP(dmTh / 0.05 * tsW);
    FOR tsY FROM dmP2T TO dmP2B STEP 3 DO PIXON_P(G2, tsX, tsY, dmGRN); END;
  END;
  // the curve with every frequency halved (magenta), then yours
  // (blue, with its 21 points), read from the caches
  tsPrev := -1;
  FOR tsI FROM 0 TO 20 DO
    tsX := dmP2L + IP(tsI / 20 * tsW);
    tsY := dmP2B - IP((dmPtH(tsI + 1) - tsLo) / (tsHi - tsLo) * tsH);
    IF tsPrev >= 0 THEN LINE_P(G2, dmP2L + IP((tsI - 1) / 20 * tsW), tsPrev, tsX, tsY, dmMAG); END;
    tsPrev := tsY;
  END;
  tsPrev := -1;
  FOR tsI FROM 0 TO 20 DO
    tsX := dmP2L + IP(tsI / 20 * tsW);
    tsY := dmP2B - IP((dmPtV(tsI + 1) - tsLo) / (tsHi - tsLo) * tsH);
    IF tsPrev >= 0 THEN LINE_P(G2, dmP2L + IP((tsI - 1) / 20 * tsW), tsPrev, tsX, tsY, dmBLUE); END;
    RECT_P(G2, tsX - 1, tsY - 1, tsX + 1, tsY + 1, dmBLUE, dmBLUE);
    tsPrev := tsY;
  END;
  // beta 3: THETA AT THE LADDER EDGE (dmEdge; PPL bisection, no
  // CAS), in orange: a dotted line at that theta, a dotted line at
  // the edge's height from the axis, a dot where the blue curve
  // crosses the edge, and two lines of text at the top right of
  // the box (where falling curves leave room).  Past 0.05 only the
  // text, which says the edge is off the plot.
  IF dmEdOK == 0 THEN dmEdge(); END;
  IF dmEdT >= 0 THEN
    tsS := "band edge LR " + dmLRS(dmEdV);
    IF dmEdT <= 0.05 THEN
      tsX := dmP2L + IP(dmEdT / 0.05 * tsW);
      tsY := dmP2B - IP((LOG(dmEdV) - tsLo) / (tsHi - tsLo) * tsH);
      FOR tsI FROM dmP2T TO dmP2B STEP 3 DO PIXON_P(G2, tsX, tsI, dmORNG); END;
      FOR tsI FROM dmP2L TO tsX STEP 3 DO PIXON_P(G2, tsI, tsY, dmORNG); END;
      RECT_P(G2, tsX - 2, tsY - 2, tsX + 2, tsY + 2, dmORNG, dmORNG);
      tsS2 := "at theta " + dmF(dmEdT, 4);
    ELSE
      tsS2 := "at theta " + dmF(dmEdT, 4) + " (off plot)";
    END;
    TEXTOUT_P(tsS, G2, dmP2R - 2 - 6 * DIM(tsS), dmP2T + 2, 1, dmORNG);
    TEXTOUT_P(tsS2, G2, dmP2R - 2 - 6 * DIM(tsS2), dmP2T + 12, 1, dmORNG);
  END;
  IF dmEdT == -1 THEN
    TEXTOUT_P("no band edge", G2, dmP2R - 74, dmP2T + 2, 1, dmORNG);
    TEXTOUT_P("up to theta 0.25", G2, dmP2R - 98, dmP2T + 12, 1, dmORNG);
  END;
  // the verbal ladder at the right
  dmLadDraw(G2, dmLdX1, dmLdX2, dmLdT, dmLdB, 1);
  // legends: what the curves are, and how far theta 0 -> 0.03
  // moves each (points 1 and 13 of 21) -- or the exclusion
  TEXTOUT_P("blue = your p, magenta = all p halved, band = usual", G2, 4, 184, 1, dmGRAY, 312);
  IF dmExcl > 0 THEN
    TEXTOUT_P("EXCLUDED at locus " + STRING(dmExcl, 2, 0) + " (LR = 0); curves = other loci", G2, 4, 195, 1, dmRED, 312);
  ELSE
    TEXTOUT_P("0 to 0.03: LR " + CHAR(215) + " " + dmF(10^(dmPtV(13) - dmPtV(1)), 3) + " (your p), " + CHAR(215) + " " + dmF(10^(dmPtH(13) - dmPtH(1)), 3) + " (halved)", G2, 4, 195, 1, #000000h, 312);
  END;
  TEXTOUT_P("drag or Left/Right = theta, Ent = adopt, Esc = menu", G2, 4, 206, 1, dmFOOT, 312);
END;

// One frame of the theta plot: the static picture from G2, then
// the green line at theta tfTh, the point on the curve, the readout
// and the ladder marker -- all from the cached curve, by
// interpolation (dmInterp); nothing is re-evaluated here.  tfOn = 0
// when the session theta is beyond 0.05 and the finger has not yet
// touched the plot.
dmThFrame(tfTh, tfOn)
BEGIN
  LOCAL tfX, tfV, tfY;
  BLIT_P(G1, 0, 0, G2);
  IF tfOn == 1 THEN
    tfX := dmP2L + IP(tfTh / 0.05 * (dmP2R - dmP2L));
    LINE_P(G1, tfX, dmP2T, tfX, dmP2B, dmGRN);
    LINE_P(G1, tfX + 1, dmP2T, tfX + 1, dmP2B, dmGRN);
    tfV := dmInterp(dmPtV, tfTh);
    tfY := dmP2B - IP((tfV - dmYLo) / (dmYHi - dmYLo) * (dmP2B - dmP2T));
    RECT_P(G1, tfX - 2, tfY - 2, tfX + 3, tfY + 2, dmGRN, dmGRN);
    TEXTOUT_P("theta " + dmF(tfTh, 4), G1, 4, 20, 1, dmGRN);
    IF dmExcl > 0 THEN
      // the curve is the other loci only: no place on the ladder
      TEXTOUT_P("other loci: LR " + dmLRS(10^tfV), G1, 80, 20, 1, dmRED);
    ELSE
      TEXTOUT_P("log10 LR " + dmF(tfV, 3), G1, 78, 20, 1, dmMAG);
      TEXTOUT_P("LR " + dmLRS(10^tfV), G1, 164, 20, 1, dmMAG);
      dmMark(dmLdX1, dmLdX2, dmLdT, dmLdB, tfV);
    END;
  ELSE
    TEXTOUT_P("your theta " + dmThS(dmTh) + " is off the plot: drag", G1, 4, 20, 1, dmGRN);
  END;
  dmMenu();
END;

// The theta plot as a page.  A finger anywhere in the plot box
// sets theta; while it stays down every MOUSE sample moves the
// green line, the readout and the ladder marker.  Left/Right step
// theta by 0.0025; Enter ADOPTS the theta shown (it becomes the
// session theta and every locus is recomputed).  Returns the next
// page.
dmPlotTheta()
BEGIN
  LOCAL ptK, ptGo, ptRet, ptPv, ptOn, ptX;
  LOCAL ptM, ptM1, ptNew, ptCv;
  IF dmNL == 0 THEN
    MSGBOX("No loci yet.  Enter a locus first.");
    RETURN 0;
  END;
  IF dmCvOK == 0 THEN dmCurves(); END;        // 42 passes, once, cached
  ptPv := dmTh; ptOn := 1;
  IF dmTh > 0.05 THEN ptPv := 0.05; ptOn := 0; END;
  dmThStatic();
  ptGo := 1; ptRet := 0;
  REPEAT ptK := GETKEY; UNTIL ptK == -1;
  dmDrain();
  WHILE ptGo == 1 DO
    dmThFrame(ptPv, ptOn);
    ptK := dmPoll();
    IF ptK == -1 THEN
      IF dmTY >= 218 THEN
        dmDrain();
        ptRet := dmSoft(dmTX); ptGo := 0;
      ELSE
        IF dmTX >= dmP2L - 8 AND dmTX <= dmP2R + 8 AND dmTY >= dmP2T AND dmTY <= dmP2B + 16 THEN
          // the drag: the first sample is the press; every later
          // sample while the finger stays down moves theta, and the
          // frame is redrawn only when the snapped theta changes
          ptX := dmTX;
          ptPv := dmThX(ptX); ptOn := 1;
          dmThFrame(ptPv, ptOn);
          REPEAT
            ptM := MOUSE;
            ptM1 := ptM(1);
            IF SIZE(ptM1) > 0 THEN
              ptNew := dmThX(ptM1(1));
              IF ptNew <> ptPv THEN
                ptPv := ptNew;
                dmThFrame(ptPv, ptOn);
              END;
            END;
          UNTIL SIZE(ptM1) == 0;
        END;
        dmDrain();
      END;
    ELSE
      IF ptK == 7 THEN ptPv := MAX(0, ROUND(ptPv / 0.0025, 0) * 0.0025 - 0.0025); ptOn := 1; END;     // Left
      IF ptK == 8 THEN ptPv := MIN(0.05, ROUND(ptPv / 0.0025, 0) * 0.0025 + 0.0025); ptOn := 1; END;  // Right
      IF ptK == 30 AND ptOn == 1 THEN                                       // Enter: adopt
        dmTh := ptPv;
        ptCv := dmCvOK;                       // the curves do not depend on the
        dmRecalc();                           // session theta: keep the cache
        dmCvOK := ptCv;
        dmThStatic();                         // the dotted line moves
      END;
      IF ptK == 4 THEN ptRet := 0; ptGo := 0; END;                          // Esc
      REPEAT ptK := GETKEY; UNTIL ptK == -1;
    END;
  END;
  RETURN ptRet;
END;


// ------------------------------------------------------------
// PAGE 3: THE RESULTS TABLE -- tap a row to drop that locus from
// the product ("what if it had not been typed?"), tap again to
// restore it.
// ------------------------------------------------------------

// The combined line and its verbal, shared by the table and the
// locus page: the combined LR (and how many loci it uses when some
// are dropped), or the exclusion.  Draws at y cbY and returns how
// many rows it used.
dmCombLines(cbY, cbVerb)
BEGIN
  LOCAL cbS;
  IF dmExcl > 0 THEN
    TEXTOUT_P("Combined: EXCLUDED at locus " + STRING(dmExcl, 2, 0) + " (LR = 0)", G1, 12, cbY, 1, dmRED);
    IF cbVerb == 1 THEN
      TEXTOUT_P("exclusion - not rescued without a dropout model", G1, 12, cbY + 11, 1, dmRED);
      // beta 3c (Roger, 19 Oct 2026): the result is stated, so is the notice
      TEXTOUT_P("Teaching aid; not for casework or legal use.", G1, 12, cbY + 22, 1, dmRED);
      RETURN 3;
    END;
    RETURN 1;
  END;
  IF dmComb <= 0 THEN RETURN 0; END;
  IF dmNDrop == 0 THEN
    cbS := "Combined LR = " + dmBig(dmComb) + "   log10 = " + dmF(LOG(dmComb), 3);
  ELSE
    cbS := "Combined (" + STRING(dmNL - dmNDrop, 2, 0) + " of " + STRING(dmNL, 2, 0) + " loci): LR " + dmBig(dmComb) + ", log10 " + dmF(LOG(dmComb), 3);
  END;
  TEXTOUT_P(cbS, G1, 12, cbY, 1, dmMAG, 300);
  IF cbVerb == 1 THEN
    TEXTOUT_P(dmVerbal(dmComb), G1, 12, cbY + 11, 1, dmGRN);
    // beta 3c (Roger, 19 Oct 2026): the caution in one line, and the
    // teaching-aid notice on the line it freed (the table is full at 12
    // loci, so the block cannot grow)
    TEXTOUT_P("The LR is NOT P(the suspect contributed).", G1, 12, cbY + 22, 1, dmRED);
    TEXTOUT_P("Teaching aid; not for casework or legal use.", G1, 12, cbY + 33, 1, dmRED);
    RETURN 4;
  END;
  RETURN 1;
END;

// Compose the Results table in G1.  The row pitch shrinks from 11
// to 10 px at 12 loci so everything fits above the soft keys; the
// first row's top and the pitch go into dmTbY and dmTbH, which the
// touch handler reads.
dmDrawTable()
BEGIN
  LOCAL rsI, rsY, rsRec, rsS, rsLR, rsC;
  LOCAL rsH;
  DIMGROB_P(G1, 320, 240, #FFFFFFh);
  RECT_P(G1, 4, 2, 315, 216, dmORNG, dmPANL);
  TEXTOUT_P("Likelihood ratios by locus", G1, 12, 5, 2, dmBLUE);
  TEXTOUT_P("Hp: " + dmHypStr(dmHp) + "    Hd: " + dmHypStr(dmHd), G1, 12, 22, 1, #000000h, 300);
  TEXTOUT_P("theta = " + dmThS(dmTh), G1, 12, 33, 1, dmGRAY);
  TEXTOUT_P("tap row/Ent = drop, Esc = menu", G1, 130, 33, 1, dmFOOT);
  rsH := MIN(11, IP(124 / dmNL));
  dmTbY := 43; dmTbH := rsH;
  rsY := 44;
  FOR rsI FROM 1 TO dmNL DO
    rsRec := dmLoc(rsI);
    rsLR := dmLR(rsI);
    IF rsI == dmTSel THEN
      RECT_P(G1, 8, rsY - 1, 311, rsY + rsH - 2, dmRED, dmPANL);   // the arrow keys' row
    END;
    rsC := #000000h;
    IF dmInc(rsI) == 0 THEN rsC := dmGRAY; END;
    rsS := STRING(rsI, 2, 0) + ". " + dmAllStr(rsRec(1));
    IF SIZE(rsS) > 24 THEN rsS := LEFT(rsS, 22) + ".."; END;
    TEXTOUT_P(rsS, G1, 12, rsY, 1, rsC);
    CASE
      IF rsLR == 0 THEN TEXTOUT_P("excluded (LR = 0)", G1, 160, rsY, 1, IFTE(dmInc(rsI) == 1, dmRED, dmGRAY)); END;
      IF rsLR < 0 THEN TEXTOUT_P("Hd impossible", G1, 160, rsY, 1, IFTE(dmInc(rsI) == 1, dmRED, dmGRAY)); END;
      DEFAULT
        TEXTOUT_P("LR " + dmBig(rsLR), G1, 160, rsY, 1, IFTE(dmInc(rsI) == 1, dmMAG, dmGRAY));
        IF dmInc(rsI) == 1 THEN TEXTOUT_P("log " + dmF(LOG(rsLR), 2), G1, 250, rsY, 1, dmGRAY); END;
    END;
    IF dmInc(rsI) == 0 THEN TEXTOUT_P("dropped", G1, 268, rsY, 1, dmGRAY); END;
    rsY := rsY + rsH;
  END;
  LINE_P(G1, 12, rsY + 1, 307, rsY + 1, dmGRAY);
  // the combined result and its verbal scale -- or the exclusion,
  // which no product of the other loci can undo
  dmCombLines(rsY + 4, 1);
END;

// Drop or restore one locus.  Only the include flag changes; the
// locus's own LR does not.
dmToggle(tgI)
BEGIN
  dmInc(tgI) := 1 - dmInc(tgI);
  dmRecalc();
END;

// The Results table as a page.  Returns the next page.
dmResults()
BEGIN
  LOCAL rtK, rtGo, rtRet, rtI;
  IF dmNL == 0 THEN
    MSGBOX("No loci yet.  Choose the hypotheses, then enter a locus.");
    RETURN 0;
  END;
  IF dmTSel < 1 OR dmTSel > dmNL THEN dmTSel := 1; END;
  rtGo := 1; rtRet := 0;
  REPEAT rtK := GETKEY; UNTIL rtK == -1;
  dmDrain();
  WHILE rtGo == 1 DO
    dmDrawTable();
    dmMenu();
    rtK := dmPoll();
    IF rtK == -1 THEN
      dmDrain();
      IF dmTY >= 218 THEN
        rtRet := dmSoft(dmTX);
        IF rtRet <> 3 THEN rtGo := 0; END;
      ELSE
        // which row: the same first-row top and pitch the drawing used
        IF dmTY >= dmTbY THEN
          rtI := IP((dmTY - dmTbY) / dmTbH) + 1;
          IF rtI >= 1 AND rtI <= dmNL THEN
            dmTSel := rtI;
            dmToggle(rtI);
          END;
        END;
      END;
    ELSE
      IF rtK == 2 THEN dmTSel := MAX(1, dmTSel - 1); END;          // Up
      IF rtK == 12 THEN dmTSel := MIN(dmNL, dmTSel + 1); END;      // Down
      IF rtK == 30 THEN dmToggle(dmTSel); END;                     // Enter
      IF rtK == 4 THEN rtRet := 0; rtGo := 0; END;                 // Esc
      REPEAT rtK := GETKEY; UNTIL rtK == -1;
    END;
  END;
  RETURN rtRet;
END;


// ------------------------------------------------------------
// THE LOCUS PAGE -- one locus in full: both probabilities, the LR
// and its verbal, the allele-set picture (WHY the LR is what it
// is), the NRC II theta formula worked through for the next
// allele, and the combined result.
// ------------------------------------------------------------

// The alleles of M (positions 1..dmM) that no allele in usKn
// covers: the set U that dmProb says the unknowns must supply.
// Built here the same way dmProb builds it (a 0 in usKn, an allele
// outside M, covers nothing), with a plain FOR loop.
dmUSet(usKn)
BEGIN
  LOCAL usI, usJ, usHit, usU;
  usU := {};
  FOR usI FROM 1 TO dmM DO
    usHit := 0;
    FOR usJ FROM 1 TO SIZE(usKn) DO
      IF usKn(usJ) == usI THEN usHit := 1; END;
    END;
    IF usHit == 0 THEN usU := CONCAT(usU, {usI}); END;
  END;
  RETURN usU;
END;

// 1 if typed person ctW (1 victim, 2 suspect, 3 third) carries
// allele position ctJ, else 0.
dmCarries(ctW, ctJ)
BEGIN
  IF dmPres(ctW) == 0 THEN RETURN 0; END;
  IF dmGen(2 * ctW - 1) == ctJ OR dmGen(2 * ctW) == ctJ THEN RETURN 1; END;
  RETURN 0;
END;

// The allele-set picture under hypothesis apH ({V?, S?, T?, x}):
// one box per allele of M, filled with the colour of the KNOWN
// contributor(s) who carry it under apH (victim green, suspect
// magenta, third person orange; half and half when two do), and
// outlined red when no known contributor carries it -- the alleles
// the x unknowns must supply.  A typed person who is NOT a
// contributor under apH (the suspect under Hd) leaves only a small
// dot of their colour: their alleles still condition theta, but
// they explain nothing.  Each box shows the allele and its p.
// Returns {number of alleles in U, 1 if a known contributor has an
// allele outside M}.
dmPicture(apH, apY)
BEGIN
  LOCAL apJ, apBw, apX, apX2, apV, apS;
  LOCAL apT, apF, apKn, apU, apIn, apBad;
  LOCAL apTx, apL, apPs, apC;
  apKn := dmKnowns(apH);
  apBad := 0;
  FOR apJ FROM 1 TO SIZE(apKn) DO
    IF apKn(apJ) == 0 THEN apBad := 1; END;
  END;
  apU := dmUSet(apKn);
  apBw := MIN(36, IP(296 / (dmM + apBad)));
  FOR apJ FROM 1 TO dmM DO
    apX := 12 + (apJ - 1) * apBw;
    apX2 := apX + apBw - 5;
    // which KNOWN contributors under apH carry this allele
    apV := 0; apS := 0; apT := 0;
    IF apH(1) == 1 THEN apV := dmCarries(1, apJ); END;
    IF apH(2) == 1 THEN apS := dmCarries(2, apJ); END;
    IF apH(3) == 1 THEN apT := dmCarries(3, apJ); END;
    apIn := 0;
    FOR apL FROM 1 TO SIZE(apU) DO
      IF apU(apL) == apJ THEN apIn := 1; END;
    END;
    apF := #FFFFFFh; apTx := #000000h;
    IF apT == 1 THEN apF := dmORNG; apTx := #FFFFFFh; END;
    IF apS == 1 THEN apF := dmMAG; apTx := #FFFFFFh; END;
    IF apV == 1 THEN apF := dmGRN; apTx := #FFFFFFh; END;
    apC := dmGRAY;
    IF apIn == 1 THEN apC := dmRED; END;
    RECT_P(G1, apX, apY, apX2, apY + 24, apC, apF);
    IF apV == 1 AND (apS == 1 OR apT == 1) THEN
      // carried by the victim AND another known: green | other colour
      RECT_P(G1, apX + IP((apX2 - apX) / 2), apY + 1, apX2 - 1, apY + 23, IFTE(apS == 1, dmMAG, dmORNG), IFTE(apS == 1, dmMAG, dmORNG));
    END;
    IF apIn == 1 THEN
      RECT_P(G1, apX + 1, apY + 1, apX2 - 1, apY + 23, dmRED, apF);   // the double red outline
    END;
    // a typed person who is not a contributor here: a dot only
    IF apH(1) == 0 AND dmCarries(1, apJ) == 1 THEN RECT_P(G1, apX2 - 5, apY + 2, apX2 - 2, apY + 5, dmGRN, dmGRN); END;
    IF apH(2) == 0 AND dmCarries(2, apJ) == 1 THEN RECT_P(G1, apX2 - 5, apY + 7, apX2 - 2, apY + 10, dmMAG, dmMAG); END;
    IF apH(3) == 0 AND dmCarries(3, apJ) == 1 THEN RECT_P(G1, apX2 - 5, apY + 12, apX2 - 2, apY + 15, dmORNG, dmORNG); END;
    // the allele and its frequency, "0.150" written ".150"
    TEXTOUT_P(dmAllStr({dmLab(apJ)}), G1, apX + 3, apY + 2, 1, apTx);
    apPs := dmF(dmFq(apJ), 3);
    // beta 3b: a frequency below 0.0005 would read ".000", as if the
    // allele could not occur: four decimals (".0004")
    IF dmFq(apJ) < 0.0005 THEN apPs := dmF(dmFq(apJ), 4); END;
    IF LEFT(apPs, 1) == "0" THEN apPs := MID(apPs, 2); END;
    TEXTOUT_P(apPs, G1, apX + 3, apY + 13, 1, apTx);
  END;
  IF apBad == 1 THEN
    // a known contributor's allele that the mixture does not show
    apX := 12 + dmM * apBw;
    RECT_P(G1, apX, apY, apX + apBw - 5, apY + 24, dmRED, dmLRED);
    TEXTOUT_P("out", G1, apX + 3, apY + 7, 1, dmRED);
  END;
  RETURN {SIZE(apU), apBad};
END;

// ---- beta 3: THE LR AS A FORMULA (the locus page's formula view) ----

// Ask the CAS for the LR of locus fmI as a formula, with theta and
// at theta = 0, and keep the answers (dmFxT, dmF0T).  dmLab, dmFq,
// dmGen and dmM must be the locus's (dmDrawPanel sets them).  The
// CAS is asked only when the CAS text differs from the one it last
// answered, so going back and forth costs nothing.  While it works
// the screen says so: its speed on a G1 is not known.
dmFxMake(fmI)
BEGIN
  LOCAL fmS, fmR;
  IF dmLR(fmI) <= 0 THEN RETURN; END;      // excluded, or no LR: no formula
  // the formula with theta
  fmS := dmCasLR(0);
  IF fmS <> dmFxK THEN
    dmFxK := fmS; dmFxT := ""; dmFxS := 3;
    IF DIM(fmS) <= dmCasMx THEN
      RECT_P(G0, 8, dmPcY - 2, 150, dmPcY + 12, dmFOOT, #FFFFFFh);
      TEXTOUT_P("asking the CAS ...", G0, 14, dmPcY, 1, dmFOOT);
      fmR := dmCas(fmS);
      // a decimal point means the CAS answered in its approximate
      // mode: that is not the exact formula, so it is not shown
      // (beta 3b: only a non-empty answer is searched -- dmCas gives ""
      // when the CAS fails, and INSTRING("", ...) is "Invalid input")
      IF DIM(fmR) > 0 THEN
        IF INSTRING(fmR, ".") > 0 THEN fmR := ""; END;
      END;
      dmFxT := fmR;
      dmFxS := 2;
      IF DIM(fmR) > 0 THEN dmFxS := 1; END;
    END;
  END;
  // the same at theta = 0
  fmS := dmCasLR(1);
  IF fmS <> dmF0K THEN
    dmF0K := fmS; dmF0T := ""; dmF0S := 3;
    IF DIM(fmS) <= dmCasMx THEN
      fmR := dmCas(fmS);
      IF DIM(fmR) > 0 THEN
        IF INSTRING(fmR, ".") > 0 THEN fmR := ""; END;
      END;
      dmF0T := fmR;
      dmF0S := 2;
      IF DIM(fmR) > 0 THEN dmF0S := 1; END;
    END;
  END;
  dmCasOK := 0;
  IF dmFxS == 1 OR dmF0S == 1 THEN dmCasOK := 1; END;
END;

// A CAS answer written for people: dmq1 ... dmqm become p and the
// allele's name (p12, p14.3), dmt becomes dmTHG ("th"), and * the
// times sign.  Otherwise the text is the CAS's own.
dmFxShow(fsT)
BEGIN
  LOCAL fsS, fsI;
  fsS := fsT;
  FOR fsI FROM 1 TO dmM DO
    fsS := dmRepl(fsS, "dmq" + dmIStr(fsI), "p" + dmAllStr({dmLab(fsI)}));
  END;
  fsS := dmRepl(fsS, "dmt", dmTHG);
  fsS := dmRepl(fsS, "*", CHAR(215));
  RETURN fsS;
END;

// The locus page's lower half in formula view (dmFrm = 1), y 96 to
// 183: the LR as the CAS wrote it (up to four lines), the same at
// theta = 0, a note on reading the CAS's signs, and the LR with
// your numbers -- the program's own value (dmLR), not the CAS's.
dmDrawFx(fxI)
BEGIN
  LOCAL fxY, fxL, fxJ, fxS, fxLR, fxOn;
  LOCAL fxMx;
  fxLR := dmLR(fxI);
  fxY := dmPcY - 11;
  TEXTOUT_P("LR as a formula in p and " + dmTHG + " (theta):", G1, 10, fxY, 1, #000000h, 230);
  IF dmCasOK == 1 AND fxLR > 0 THEN
    TEXTOUT_P("exact (CAS)", G1, 246, fxY, 1, dmFOOT);
  ELSE
    TEXTOUT_P("decimal", G1, 268, fxY, 1, dmFOOT);
  END;
  fxY := fxY + 11;
  CASE
    IF fxLR == 0 THEN
      // beta 3c (B2): say WHICH of dmProb's reasons gave P(E|Hp) = 0,
      // tested the way dmProb tests it.  fxOn holds the reason here
      // (it is reset below only on the formula path): 1 = a known
      // contributor under Hp carries an allele outside M (dmKnowns
      // writes such an allele as 0); 2 = the knowns plus the dmHp(4)
      // unknowns cannot supply every allele of M (more than 2 alleles
      // per unknown are needed); 0 = neither, so the probability
      // underflowed: smaller than the smallest number the calculator
      // holds (dmProb adds only positive terms since beta 3c, so this
      // needs absurdly small frequencies).
      fxL := dmKnowns(dmHp); fxOn := 0;
      FOR fxJ FROM 1 TO SIZE(fxL) DO
        IF fxL(fxJ) == 0 THEN fxOn := 1; END;
      END;
      IF fxOn == 0 THEN
        IF SIZE(dmUSet(fxL)) > 2 * dmHp(4) THEN fxOn := 2; END;
      END;
      IF fxOn == 1 THEN
        TEXTOUT_P("LR = 0 for every p and theta: a known", G1, 10, fxY, 1, dmRED, 300);
        TEXTOUT_P("contributor under Hp has an allele the", G1, 10, fxY + 11, 1, dmRED, 300);
        TEXTOUT_P("mixture does not show, so P(E|Hp) = 0.", G1, 10, fxY + 22, 1, dmRED, 300);
      END;
      IF fxOn == 2 THEN
        TEXTOUT_P("LR = 0 for every p and theta: under Hp", G1, 10, fxY, 1, dmRED, 300);
        TEXTOUT_P("the contributors cannot account for every", G1, 10, fxY + 11, 1, dmRED, 300);
        TEXTOUT_P("allele of M, so P(E|Hp) = 0.", G1, 10, fxY + 22, 1, dmRED, 300);
      END;
      IF fxOn == 0 THEN
        TEXTOUT_P("LR = 0 at these p and theta: P(E|Hp) is", G1, 10, fxY, 1, dmRED, 300);
        TEXTOUT_P("below the smallest number the calculator", G1, 10, fxY + 11, 1, dmRED, 300);
        TEXTOUT_P("holds (underflow), so it counts as 0.", G1, 10, fxY + 22, 1, dmRED, 300);
      END;
    END;
    IF fxLR < 0 THEN
      TEXTOUT_P("Hd cannot produce this mixture: P(E|Hd) = 0", G1, 10, fxY, 1, dmRED, 300);
      TEXTOUT_P("for every p and theta, so no LR, no formula.", G1, 10, fxY + 11, 1, dmRED, 300);
    END;
    DEFAULT
      // the formula with theta, if the CAS gave one that fits
      fxOn := 0;
      IF dmFxS == 1 THEN
        fxL := dmWrap("LR = " + dmFxShow(dmFxT), 48);
        IF SIZE(fxL) <= 4 THEN
          FOR fxJ FROM 1 TO SIZE(fxL) DO
            TEXTOUT_P(fxL(fxJ), G1, 10, fxY, 1, dmMAG, 304);
            fxY := fxY + 11;
          END;
          fxOn := 1;
        END;
      END;
      IF fxOn == 0 THEN
        // say why it is not here
        fxS := "Too many terms to send to the CAS here.";
        IF dmFxS == 2 THEN fxS := "The CAS did not answer: no formula here."; END;
        IF dmFxS == 1 THEN fxS := "With theta: " + STRING(DIM(dmFxT), 2, 0) + " characters, too long to show."; END;
        TEXTOUT_P(fxS, G1, 10, fxY, 1, dmGRAY, 304);
        fxY := fxY + 11;
      END;
      // the formula at theta = 0: the product rule.  It may use every
      // line down to y 162; the note on signs gets a line only if one
      // is left
      fxMx := 162;
      IF dmF0S == 1 THEN
        fxL := dmWrap("theta = 0: LR = " + dmFxShow(dmF0T), 48);
        IF fxY + 11 * (SIZE(fxL) - 1) <= fxMx THEN
          FOR fxJ FROM 1 TO SIZE(fxL) DO
            TEXTOUT_P(fxL(fxJ), G1, 10, fxY, 1, dmBLUE, 304);
            fxY := fxY + 11;
          END;
        ELSE
          TEXTOUT_P("At theta = 0: " + STRING(DIM(dmF0T), 2, 0) + " characters, too long to show.", G1, 10, fxY, 1, dmGRAY, 304);
          fxY := fxY + 11;
        END;
      END;
      // how to read the CAS's factors: it writes th + (1 - th) p
      // as minus (p th - p - th), and the minus signs pair off
      // (beta 3b: INSTRING only inside the IF, on a formula that is
      // there -- not left to AND skipping its right side)
      IF fxOn == 1 AND fxY <= 162 AND DIM(dmFxT) > 0 THEN
        IF INSTRING(dmFxT, "*dmt-") > 0 THEN
          TEXTOUT_P("(p" + CHAR(215) + dmTHG + "-p-" + dmTHG + ") = -(" + dmTHG + "+(1-" + dmTHG + ")p): signs pair off", G1, 10, fxY, 1, dmGRAY, 304);
        END;
      END;
      // the value with your numbers is the program's, not the CAS's
      TEXTOUT_P("your p, " + dmTHG + " = " + dmThS(dmTh) + ": LR = " + dmBig(fxLR) + " (the program's value)", G1, 10, dmPcY + 66, 1, #000000h, 304);
  END;
END;

// Compose the locus page for locus dpI in G1.
dmDrawPanel(dpI)
BEGIN
  LOCAL dpRec, dpLR, dpS, dpH, dpP, dpR;
  LOCAL dpU, dpJ, dpX, dpA, dpN, dpNa;
  LOCAL dpTy, dpQ, dpTs;
  dpRec := dmLoc(dpI);
  dmLab := dpRec(1); dmFq := dpRec(2); dmGen := dpRec(3); dmM := SIZE(dmLab);
  dpLR := dmLR(dpI);
  // beta 3: in the formula view the CAS is asked here -- once per
  // locus (dmFxMake keeps its answers), before the page is composed,
  // so "asking the CAS" shows on the page already on the screen
  IF dmFrm == 1 THEN dmFxMake(dpI); END;
  DIMGROB_P(G1, 320, 240, #FFFFFFh);
  RECT_P(G1, 2, 1, 317, 216, dmORNG, dmPANL);
  TEXTOUT_P("Locus " + STRING(dpI, 2, 0) + " of " + STRING(dmNL, 2, 0), G1, 10, 4, 2, dmBLUE);
  IF dmInc(dpI) == 0 THEN TEXTOUT_P("dropped", G1, 130, 8, 1, dmGRAY); END;
  TEXTOUT_P("theta = " + dmThS(dmTh), G1, 210, 8, 1, dmGRAY);
  TEXTOUT_P("Hp: " + dmHypStr(dmHp), G1, 10, 22, 1, #000000h);
  TEXTOUT_P("P(E|Hp) = " + dmBig(dmPp(dpI)), G1, 180, 22, 1, dmBLUE);
  TEXTOUT_P("Hd: " + dmHypStr(dmHd), G1, 10, 33, 1, #000000h);
  TEXTOUT_P("P(E|Hd) = " + dmBig(dmPd(dpI)), G1, 180, 33, 1, dmBLUE);
  CASE
    IF dpLR == 0 THEN
      // beta 3c (B2): dmProb gives P(E|Hp) = 0 for two reasons (and,
      // in theory, underflow), and the page now says which, tested
      // the way dmProb tests it.  dpU,
      // dpJ and dpX are used again further down and set afresh there.
      // dpX = 1: a known contributor under Hp carries an allele the
      //          mixture does not show (dmKnowns writes it as 0);
      // dpX = 2: the knowns plus the dmHp(4) unknowns cannot supply
      //          every allele of M (each unknown brings two alleles);
      // dpX = 0: neither -- the probability underflowed: below the
      //          smallest number the calculator holds, about 1E-499
      //          (beta 3c's dmProb adds only positive terms, so only
      //          absurdly small frequencies can do this).
      dpU := dmKnowns(dmHp); dpX := 0;
      FOR dpJ FROM 1 TO SIZE(dpU) DO
        IF dpU(dpJ) == 0 THEN dpX := 1; END;
      END;
      IF dpX == 0 THEN
        IF SIZE(dmUSet(dpU)) > 2 * dmHp(4) THEN dpX := 2; END;
      END;
      IF dpX == 1 THEN
        TEXTOUT_P("LR = 0: a known contributor under Hp has an", G1, 10, 47, 1, dmRED);
        TEXTOUT_P("allele the mixture does not show.  Excluded.", G1, 10, 58, 1, dmRED);
      END;
      IF dpX == 2 THEN
        TEXTOUT_P("LR = 0: under Hp the contributors cannot", G1, 10, 47, 1, dmRED);
        TEXTOUT_P("account for every allele of M.  Excluded.", G1, 10, 58, 1, dmRED);
      END;
      IF dpX == 0 THEN
        TEXTOUT_P("LR = 0: P(E|Hp) underflows: it is below the", G1, 10, 47, 1, dmRED);
        TEXTOUT_P("calculator's smallest number.  Counted as 0.", G1, 10, 58, 1, dmRED);
      END;
    END;
    IF dpLR < 0 THEN
      TEXTOUT_P("Hd cannot produce this mixture (P = 0),", G1, 10, 47, 1, dmRED);
      TEXTOUT_P("so no LR is defined.  Check the genotypes.", G1, 10, 58, 1, dmRED);
    END;
    DEFAULT
      TEXTOUT_P("LR = " + dmBig(dpLR), G1, 10, 45, 2, dmMAG);
      TEXTOUT_P("log10 LR = " + dmF(LOG(dpLR), 3), G1, 150, 49, 1, dmMAG);
      TEXTOUT_P(dmVerbal(dpLR), G1, 10, 62, 1, dmGRN);
      // beta 3c (Roger, 19 Oct 2026): the caution in one line; the
      // teaching-aid notice is on the next (y 84), for every LR
      TEXTOUT_P("The LR is NOT P(the suspect contributed).", G1, 10, 73, 1, dmRED);
  END;
  // beta 3c (Roger, 19 Oct 2026): every locus page states an LR (and,
  // in the picture view, the combined one), so every one says it is a
  // teaching aid -- also after an exclusion or "no LR", where y 84 is free
  TEXTOUT_P("Teaching aid; not for casework or legal use.", G1, 10, 84, 1, dmRED);

  IF dmFrm == 1 THEN
    // ---- beta 3: the LR as a formula (CAS) and the LR with your numbers ----
    dmDrawFx(dpI);
  ELSE
    // ---- the allele-set picture, under Hp or Hd ----
    dpH := dmHp; dpS := "Hp"; dpP := dmPp(dpI);
    IF dmPicH == 2 THEN dpH := dmHd; dpS := "Hd"; dpP := dmPd(dpI); END;
    TEXTOUT_P(dpS + ": " + dmHypStr(dpH), G1, 10, dmPcY - 11, 1, #000000h);
    // a key to the colours, at the right of the caption
    RECT_P(G1, 196, dmPcY - 10, 203, dmPcY - 3, dmGRN, dmGRN);
    TEXTOUT_P("V", G1, 206, dmPcY - 11, 1, dmGRN);
    RECT_P(G1, 220, dmPcY - 10, 227, dmPcY - 3, dmMAG, dmMAG);
    TEXTOUT_P("S", G1, 230, dmPcY - 11, 1, dmMAG);
    RECT_P(G1, 244, dmPcY - 10, 251, dmPcY - 3, dmRED, #FFFFFFh);
    TEXTOUT_P("unknowns", G1, 254, dmPcY - 11, 1, dmRED);
    dpR := dmPicture(dpH, dmPcY);
    // what the unknowns must do under this hypothesis
    dpU := dmUSet(dmKnowns(dpH));
    dpTs := "";
    FOR dpJ FROM 1 TO SIZE(dpU) DO
      IF dpJ > 1 THEN dpTs := dpTs + ", "; END;
      dpTs := dpTs + dmAllStr({dmLab(dpU(dpJ))});
    END;
    dpX := dpH(4);                              // unknowns under this hypothesis
    CASE
      IF dpR(2) == 1 THEN
        TEXTOUT_P("a known has an allele outside M: P(E|" + dpS + ") = 0", G1, 10, dmPcY + 27, 1, dmRED, 300);
      END;
      IF dpR(1) > 2 * dpX THEN
        // beta 3c: "1 allele", not "1 alleles"
        TEXTOUT_P(STRING(dpX, 2, 0) + " unknown(s) cannot supply " + STRING(dpR(1), 2, 0) + " allele" + IFTE(dpR(1) == 1, "", "s") + ": P = 0", G1, 10, dmPcY + 27, 1, dmRED, 300);
      END;
      IF dpX == 0 THEN
        TEXTOUT_P("the knowns explain M exactly: P(E|" + dpS + ") = 1", G1, 10, dmPcY + 27, 1, #000000h, 300);
      END;
      DEFAULT
        IF dpR(1) == 0 THEN dpTs := "nothing new (any of M)"; END;
        TEXTOUT_P(STRING(dpX, 2, 0) + IFTE(dpX == 1, " unknown", " unknowns") + " must supply " + dpTs + ": P = " + dmBig(dpP), G1, 10, dmPcY + 27, 1, #000000h, 300);
    END;

    // ---- NRC II theta, worked through for the next allele drawn ----
    // the allele: the first one the unknowns must supply under Hd
    // (where theta matters), else under Hp, else the first of M
    dpU := dmUSet(dmKnowns(dmHd));
    IF SIZE(dpU) == 0 THEN dpU := dmUSet(dmKnowns(dmHp)); END;
    dpA := 1;
    IF SIZE(dpU) > 0 THEN dpA := dpU(1); END;
    dpTy := dmTyped();
    dpN := SIZE(dpTy);                          // alleles seen: every typed allele
    dpNa := 0;
    FOR dpJ FROM 1 TO dpN DO
      IF dpTy(dpJ) == dpA THEN dpNa := dpNa + 1; END;
    END;
    dpQ := (dpNa * dmTh + (1 - dmTh) * dmFq(dpA)) / (1 + (dpN - 1) * dmTh);
    dpS := dmAllStr({dmLab(dpA)});
    IF dmTh == 0 THEN
      TEXTOUT_P("theta = 0: plain p, the product rule.  Next allele", G1, 10, dmPcY + 39, 1, dmGRAY, 300);
      TEXTOUT_P(dpS + ": p = " + dmF(dmFq(dpA), 3) + " whatever has been seen.", G1, 10, dmPcY + 50, 1, dmGRAY, 300);
    ELSE
      TEXTOUT_P("Next allele " + dpS + ": n = " + STRING(dpN, 2, 0) + " seen, " + STRING(dpNa, 2, 0) + " of them " + dpS + " (NRC II):", G1, 10, dmPcY + 39, 1, dmBLUE, 300);
      TEXTOUT_P("(" + STRING(dpNa, 2, 0) + CHAR(215) + dmThS(dmTh) + " + " + dmThS(1 - dmTh) + CHAR(215) + dmF(dmFq(dpA), 3) + ") / (1 + " + STRING(dpN - 1, 2, 0) + CHAR(215) + dmThS(dmTh) + ") = " + dmF(dpQ, 4), G1, 10, dmPcY + 50, 1, dmBLUE, 304);
      TEXTOUT_P("plain p = " + dmF(dmFq(dpA), 3) + " becomes " + dmF(dpQ, 3) + " with theta", G1, 10, dmPcY + 61, 1, dmMAG, 300);
    END;

    // ---- the combined result ----
    dmCombLines(dmPcY + 72, 0);
  END;

  // ---- single source; footer ----
  IF dmPres(1) == 0 AND dmPres(2) == 1 AND dmPres(3) == 0 AND dmHp(2) == 1 AND dmHp(4) == 0 AND dmHd(2) == 0 AND dmHd(4) == 1 THEN
    // preset 3, suspect alone vs 1 unknown: the LR is 1 over the
    // random match probability -- 1/(2pq) or 1/p^2 at theta = 0,
    // the theta-corrected match probability otherwise
    IF dmTh == 0 THEN
      TEXTOUT_P("single source: LR = 1/(2pq) or 1/p^2 = 1/RMP", G1, 12, dmPcY + 83, 1, dmGRN, 300);
    ELSE
      TEXTOUT_P("single source: LR = 1/RMP, theta-corrected", G1, 12, dmPcY + 83, 1, dmGRN, 300);
    END;
  END;
  // the footer row is also a button (dmLocusPanel): tap it, or press -,
  // to switch between the allele picture and the formula
  IF dmFrm == 1 THEN
    TEXTOUT_P("tap here/- = picture, arrows = locus, Esc = menu", G1, 10, dmPcY + 96, 1, dmFOOT, 304);
  ELSE
    TEXTOUT_P("tap here/- = formula, + = Hp/Hd, arrows = locus", G1, 10, dmPcY + 96, 1, dmFOOT, 304);
  END;
END;

// The locus page as a page: a tap on the boxes (or +) switches the
// picture between Hp and Hd; Left/Right go to the other loci;
// Enter or Esc go back to the menu.  Beta 3: - (or a tap on the
// footer row) switches the lower half between the allele picture
// and the LR as a formula.  Returns the next page.
dmLocusPanel()
BEGIN
  LOCAL lpK, lpGo, lpRet;
  IF dmNL == 0 THEN RETURN 0; END;
  IF dmSel < 1 OR dmSel > dmNL THEN dmSel := dmNL; END;
  lpGo := 1; lpRet := 0;
  REPEAT lpK := GETKEY; UNTIL lpK == -1;
  dmDrain();
  WHILE lpGo == 1 DO
    dmDrawPanel(dmSel);
    dmMenu();
    lpK := dmPoll();
    IF lpK == -1 THEN
      dmDrain();
      IF dmTY >= 218 THEN
        lpRet := dmSoft(dmTX); lpGo := 0;
      ELSE
        // the picture's band: caption, boxes and the line under them
        // (picture view only)
        IF dmFrm == 0 AND dmTY >= dmPcY - 12 AND dmTY <= dmPcY + 37 THEN dmPicH := 3 - dmPicH; END;
        // beta 3: the footer row switches picture <-> formula
        IF dmTY >= dmPcY + 91 THEN dmFrm := 1 - dmFrm; END;
      END;
    ELSE
      IF lpK == 7 THEN dmSel := MAX(1, dmSel - 1); END;          // Left
      IF lpK == 8 THEN dmSel := MIN(dmNL, dmSel + 1); END;       // Right
      IF lpK == 50 AND dmFrm == 0 THEN dmPicH := 3 - dmPicH; END; // +
      IF lpK == 45 THEN dmFrm := 1 - dmFrm; END;                 // - : formula
      IF lpK == 30 OR lpK == 4 THEN lpRet := 0; lpGo := 0; END;  // Enter, Esc
      REPEAT lpK := GETKEY; UNTIL lpK == -1;
    END;
  END;
  RETURN lpRet;
END;


// ------------------------------------------------------------
// PAGE 4: THE LADDER -- the combined LR built up one locus at a
// time: the red marker climbs (or falls) the ENFSI ladder with a
// short pause per locus.  Any key or tap skips to the end.
// ------------------------------------------------------------

// One frame of the ladder after lfStep loci (0 = before any).
dmLadFrame(lfStep, lfAnim)
BEGIN
  LOCAL lfI, lfY, lfS, lfC, lfV, lfSt;
  LOCAL lfEx;
  DIMGROB_P(G1, 320, 240, #FFFFFFh);
  // beta 3c: a shorter title ("ENFSI ladder, locus by locus" before) so
  // the teaching-aid notice fits at the right of the title row (Roger,
  // 19 Oct 2026)
  TEXTOUT_P("ENFSI ladder by locus", G1, 20, 2, 2, dmBLUE);
  TEXTOUT_P("Teaching aid only", G1, 202, 6, 1, dmRED);
  dmLadDraw(G1, 92, 112, 22, 180, 2);
  // log10 LR from -6 to 6 at the left of the ladder
  FOR lfI FROM -6 TO 6 DO
    lfY := dmLadY(lfI, 22, 180);
    LINE_P(G1, 88, lfY, 91, lfY, dmGRAY);
    lfS := STRING(lfI, 2, 0);
    TEXTOUT_P(lfS, G1, 86 - 6 * SIZE(lfS), lfY - 5, 1, dmGRAY);
  END;
  TEXTOUT_P("about equal", G1, 4, dmLadY(0, 22, 180) - 5, 1, dmGRAY);
  TEXTOUT_P("for Hp", G1, 4, 22, 1, dmBLUE);
  TEXTOUT_P("for Hd", G1, 4, 170, 1, dmRED);
  TEXTOUT_P("log10", G1, 40, 34, 1, dmGRAY);
  // the list at the right: each locus's log10 LR and the total
  TEXTOUT_P("#", G1, 220, 22, 1, dmGRAY);
  TEXTOUT_P("log10", G1, 244, 22, 1, dmGRAY);
  TEXTOUT_P("total", G1, 284, 22, 1, dmGRAY);
  lfEx := 0; lfV := 0;
  FOR lfI FROM 1 TO dmNL DO
    lfY := 34 + (lfI - 1) * 11;
    lfSt := dmCuS(lfI);
    lfC := dmGRAY;
    IF lfI <= lfStep THEN lfC := #000000h; END;
    IF lfI == lfStep THEN lfC := dmRED; END;
    TEXTOUT_P(STRING(lfI, 2, 0), G1, 220, lfY, 1, lfC);
    CASE
      IF lfSt == 0 THEN lfS := "drop"; END;
      IF lfSt == 2 THEN lfS := "no LR"; END;
      IF lfSt == 3 THEN lfS := "excl."; END;
      IF lfSt == 4 THEN lfS := "-"; END;
      DEFAULT
        lfS := dmF(LOG(dmLR(lfI)), 2);
        IF LOG(dmLR(lfI)) > 0 THEN lfS := "+" + lfS; END;
    END;
    TEXTOUT_P(lfS, G1, 244, lfY, 1, lfC);
    IF lfSt <> 3 AND lfSt <> 4 THEN TEXTOUT_P(dmF(dmCuV(lfI), 2), G1, 284, lfY, 1, lfC); END;
    IF lfI <= lfStep THEN
      // a magenta tick across the ladder at each total passed
      IF lfSt == 1 THEN
        lfY := dmLadY(dmCuV(lfI), 22, 180);
        LINE_P(G1, 93, lfY, 111, lfY, dmMAG);
      END;
      IF lfSt == 3 THEN lfEx := lfI; END;
      IF lfSt <> 3 AND lfSt <> 4 THEN lfV := dmCuV(lfI); END;
    END;
  END;
  // the marker, and what it says
  IF lfEx > 0 THEN
    TEXTOUT_P("EXCLUDED at locus " + STRING(lfEx, 2, 0) + ": LR = 0, the climb stops", G1, 6, 184, 1, dmRED, 308);
    TEXTOUT_P("exclusion - not rescued without a dropout model", G1, 6, 195, 1, dmRED, 308);
  ELSE
    dmMark(92, 112, 22, 180, lfV);
    IF lfStep == 0 THEN
      lfS := "before any locus: LR = 1 (log10 0)";
    ELSE
      lfS := "after locus " + STRING(lfStep, 2, 0) + ": LR = " + dmBig(10^lfV) + " (log10 " + dmF(lfV, 3) + ")";
    END;
    TEXTOUT_P(lfS, G1, 6, 184, 1, dmMAG, 308);
    TEXTOUT_P(dmVerbal(10^lfV), G1, 6, 195, 1, dmGRN, 308);
  END;
  IF lfAnim == 1 THEN
    TEXTOUT_P("any key = skip to the end", G1, 6, 206, 1, dmFOOT);
  ELSE
    TEXTOUT_P("tap or Ent = replay, Esc = menu", G1, 6, 206, 1, dmFOOT);
  END;
  dmMenu();
END;

// The ladder as a page.  Returns the next page.
dmLadView()
BEGIN
  LOCAL lwK, lwGo, lwRet, lwStep, lwSkip;
  IF dmNL == 0 THEN
    MSGBOX("No loci yet.  Enter a locus first.");
    RETURN 0;
  END;
  dmCum();
  lwGo := 1; lwRet := 0;
  REPEAT lwK := GETKEY; UNTIL lwK == -1;
  dmDrain();
  WHILE lwGo == 1 DO
    // the animation: one locus per step, 0.4 s apart (a TICKS
    // pause); a key or a tap ends it at once
    lwStep := 0; lwSkip := 0;
    WHILE lwStep < dmNL AND lwSkip == 0 DO
      dmLadFrame(lwStep, 1);
      lwSkip := dmPause(400);
      IF lwSkip == 0 THEN lwStep := lwStep + 1; END;
    END;
    IF lwSkip == 1 THEN
      dmDrain();                             // the skip's own key or tap
      REPEAT lwK := GETKEY; UNTIL lwK == -1;
    END;
    dmLadFrame(dmNL, 0);
    lwK := dmPoll();
    IF lwK == -1 THEN
      dmDrain();
      IF dmTY >= 218 THEN
        lwRet := dmSoft(dmTX);
        IF lwRet <> 4 THEN lwGo := 0; END;   // Ladder: replay
      END;
      // a tap anywhere else replays
    ELSE
      IF lwK == 4 THEN lwRet := 0; lwGo := 0; END;   // Esc; Enter or any other key replays
      REPEAT lwK := GETKEY; UNTIL lwK == -1;
    END;
  END;
  RETURN lwRet;
END;


// ------------------------------------------------------------
// PAGE 8: THE PROSECUTOR'S FALLACY -- prior odds x LR = posterior
// odds.  The LR alone is NOT the probability that the suspect
// contributed: that needs a prior.  Tap a prior: the suspect and N
// other people who could equally well have left the stain (prior
// odds 1 : N).
// ------------------------------------------------------------

dmDrawFall()
BEGIN
  LOCAL dfN, dfLR, dfLp, dfLl, dfLo, dfHi;
  LOCAL dfPo, dfP, dfQ, dfI, dfY, dfS;
  LOCAL dfX0, dfX1, dfX2, dfW, dfBc, dfStp;
  DIMGROB_P(G1, 320, 240, #FFFFFFh);
  TEXTOUT_P("The prosecutor's fallacy", G1, 50, 2, 2, dmBLUE);
  TEXTOUT_P("How many OTHER people could have left it?", G1, 4, 20, 1, #000000h, 312);
  // the prior ladder: 1, 10, ... 10,000,000 others
  FOR dfI FROM 1 TO 8 DO
    dfY := dmFaT + (dfI - 1) * 16;
    dfBc := dmGRAY; dfS := #FFFFFFh;
    IF dfI == dmPri THEN dfBc := dmRED; dfS := dmLRED; END;
    RECT_P(G1, 4, dfY, 72, dfY + 14, dfBc, dfS);
    TEXTOUT_P(dmCom(10^(dfI - 1)), G1, 9, dfY + 2, 1, IFTE(dfI == dmPri, dmRED, #000000h));
  END;
  dfN := 10^(dmPri - 1);
  IF dmExcl > 0 THEN
    TEXTOUT_P("EXCLUDED at locus " + STRING(dmExcl, 2, 0) + ": LR = 0,", G1, 84, 40, 1, dmRED, 230);
    TEXTOUT_P("so the posterior is 0", G1, 84, 51, 1, dmRED, 230);
    TEXTOUT_P("whatever the prior.", G1, 84, 62, 1, dmRED, 230);
  ELSE
    dfLR := dmComb;
    dfLp := -(dmPri - 1);                       // log10 prior odds, 1 : N
    dfLl := LOG(dfLR);                          // log10 LR
    dfPo := dfLR / dfN;                         // posterior odds
    dfP := dfLR / (dfLR + dfN);                 // posterior probability of Hp
    dfQ := dfN / (dfLR + dfN);                  // and of Hd
    // one log10-odds axis for all three bars; 0 = even odds
    dfLo := FLOOR(MIN(0, MIN(dfLp, dfLp + dfLl)));
    dfHi := CEILING(MAX(0, MAX(dfLp, dfLp + dfLl)));
    IF dfHi - dfLo < 2 THEN dfHi := dfHi + 1; dfLo := dfLo - 1; END;
    dfW := 226;
    dfX0 := 86 + IP((0 - dfLo) / (dfHi - dfLo) * dfW);
    // 1. prior odds 1 : N, from 0
    TEXTOUT_P("prior odds 1 : " + dmCom(dfN), G1, 86, 34, 1, #000000h, 230);
    dfX1 := 86 + IP((dfLp - dfLo) / (dfHi - dfLo) * dfW);
    RECT_P(G1, MIN(dfX0, dfX1), 45, MAX(dfX0, dfX1), 53, dmGRAY, dmGRID);
    // 2. times the LR: the bar moves on by log10 LR
    dfS := CHAR(215) + " LR " + dmLRS(dfLR);
    IF dmNDrop > 0 THEN dfS := dfS + "  (" + STRING(dmNL - dmNDrop, 2, 0) + " of " + STRING(dmNL, 2, 0) + " loci)"; END;
    TEXTOUT_P(dfS, G1, 86, 58, 1, dmFOOT, 230);
    dfX2 := 86 + IP((dfLp + dfLl - dfLo) / (dfHi - dfLo) * dfW);
    RECT_P(G1, MIN(dfX1, dfX2), 69, MAX(dfX1, dfX2), 77, dmFOOT, dmLBLU);
    // 3. = posterior odds, from 0
    IF dfPo >= 1 THEN dfS := dmLRS(dfPo) + " : 1"; ELSE dfS := "1 : " + dmLRS(1 / dfPo); END;
    TEXTOUT_P("= posterior odds " + dfS, G1, 86, 82, 1, dmMAG, 230);
    RECT_P(G1, MIN(dfX0, dfX2), 93, MAX(dfX0, dfX2), 101, dmMAG, dmMAG);
    // the even-odds line and the axis labels (log10 odds)
    LINE_P(G1, dfX0, 43, dfX0, 103, #000000h);
    dfStp := 1;
    IF dfHi - dfLo > 8 THEN dfStp := 2; END;
    IF dfHi - dfLo > 16 THEN dfStp := 5; END;
    FOR dfI FROM dfLo TO dfHi DO
      IF (dfI MOD dfStp) == 0 THEN
        dfY := 86 + IP((dfI - dfLo) / (dfHi - dfLo) * dfW);
        LINE_P(G1, dfY, 103, dfY, 106, dmGRAY);
        TEXTOUT_P(STRING(dfI, 2, 0), G1, MIN(dfY - 3, 306), 107, 1, dmGRAY);
      END;
    END;
    // the posterior probability, as a number and a 0-1 strip
    TEXTOUT_P("P(Hp | E) = " + dmPStr(dfP, dfQ), G1, 86, 120, 2, dmMAG, 230);
    RECT_P(G1, 86, 140, 312, 150, dmGRAY, #FFFFFFh);
    IF dfP > 0 THEN RECT_P(G1, 86, 140, 86 + IP(dfP * 226), 150, dmMAG, dmMAG); END;
    // the sentence, the fallacy, and the warning
    TEXTOUT_P("LR " + dmLRS(dfLR) + " " + CHAR(215) + " prior 1:" + dmCom(dfN) + " " + CHAR(8594) + " posterior " + dmPStr(dfP, dfQ), G1, 4, 164, 1, #000000h, 312);
    TEXTOUT_P("Fallacy: P(Hd|E) = 1/LR = " + dmBig(1 / dfLR) + "; truly " + dmPStr(dfQ, dfP), G1, 4, 175, 1, dmGRAY, 312);
  END;
  // beta 3c (Roger, 19 Oct 2026): the caution in one line, and the
  // teaching-aid notice on the line it freed
  TEXTOUT_P("The LR is NOT P(the suspect contributed).", G1, 4, 186, 1, dmRED);
  TEXTOUT_P("Teaching aid; not for casework or legal use.", G1, 4, 196, 1, dmRED);
  TEXTOUT_P("tap a number or Up/Down = prior, Esc = menu", G1, 4, 207, 1, dmFOOT, 312);
END;

// The prosecutor's-fallacy page.  Returns the next page.
dmFallacy()
BEGIN
  LOCAL faK, faGo, faRet, faR;
  IF dmNL == 0 THEN
    MSGBOX("No loci yet.  Enter a locus first.");
    RETURN 0;
  END;
  IF dmPri < 1 OR dmPri > 8 THEN dmPri := 6; END;
  faGo := 1; faRet := 0;
  REPEAT faK := GETKEY; UNTIL faK == -1;
  dmDrain();
  WHILE faGo == 1 DO
    dmDrawFall();
    dmMenu();
    faK := dmPoll();
    IF faK == -1 THEN
      dmDrain();
      IF dmTY >= 218 THEN
        faRet := dmSoft(dmTX); faGo := 0;
      ELSE
        // a rung of the prior ladder: the same top and pitch as drawn
        IF dmTX <= 76 AND dmTY >= dmFaT THEN
          faR := IP((dmTY - dmFaT) / 16) + 1;
          IF faR >= 1 AND faR <= 8 THEN dmPri := faR; END;
        END;
      END;
    ELSE
      IF faK == 2 THEN dmPri := MAX(1, dmPri - 1); END;          // Up
      IF faK == 12 THEN dmPri := MIN(8, dmPri + 1); END;         // Down
      IF faK == 4 OR faK == 30 THEN faRet := 0; faGo := 0; END;  // Esc, Enter
      REPEAT faK := GETKEY; UNTIL faK == -1;
    END;
  END;
  RETURN faRet;
END;


// ------------------------------------------------------------
// WORKED EXAMPLE, HELP, RESET
// ------------------------------------------------------------

// Three invented loci under the classic hypotheses.  With theta 0
// the LRs are 66.67, 20 and 4 (combined 5333.3); with theta 0.01
// they are 56.79, 19.08 and 3.674 (combined 3981.5).  Checked in
// Python (verify_DNAMixLR.py).
dmExample()
BEGIN
  dmPres := {1, 1, 0};
  dmHp := {1, 1, 0, 0}; dmHd := {1, 0, 0, 1};
  dmClearLoci();
  dmLoc := {{{12, 13, 14, 15}, {0.10, 0.20, 0.15, 0.05}, {1, 2, 3, 4, 0, 0}},
            {{8, 9, 11}, {0.30, 0.25, 0.10}, {1, 1, 2, 3, 0, 0}},
            {{16, 17}, {0.20, 0.30}, {1, 2, 1, 2, 0, 0}}};
  dmInc := {1, 1, 1};
  dmNL := 3;
  dmRecalc();
  MSGBOX("Loaded: victim + suspect vs victim + 1 unknown, 3 loci, theta = " + dmThS(dmTh) + ".  Locus 1: victim 12/13, suspect 14/15, mixture 12,13,14,15.  Now see Results and the plots.");
END;

// One help page, composed in G1.
dmHelpPage(hgP)
BEGIN
  DIMGROB_P(G1, 320, 240, #FFFFFFh);
  RECT_P(G1, 4, 2, 315, 216, dmORNG, dmPANL);
  TEXTOUT_P("DNAMixLR help  (" + STRING(hgP, 2, 0) + " of 4)", G1, 12, 4, 2, dmBLUE);
  IF hgP == 1 THEN
    TEXTOUT_P("Each locus shows a SET of alleles, called M.", G1, 12, 24, 1, #000000h);
    TEXTOUT_P("Under a hypothesis, known contributors must", G1, 12, 37, 1, #000000h);
    TEXTOUT_P("have all their alleles in M; the x unknown", G1, 12, 50, 1, #000000h);
    TEXTOUT_P("people supply the rest of M and nothing else.", G1, 12, 63, 1, #000000h);
    TEXTOUT_P("P(E|H): the chance 2x random alleles do that.", G1, 12, 76, 1, dmMAG);
    TEXTOUT_P("LR = P(E|Hp) / P(E|Hd); loci multiply.", G1, 12, 89, 1, dmMAG);
    // beta 3c: the example and the genotype note move up 3 and 6 px
    // (105-186 before) to make room for the notice at y 193
    TEXTOUT_P("Example: mixture 12,13,14,15; victim 12/13.", G1, 12, 102, 1, dmGRN);
    TEXTOUT_P("Hd (victim + 1 unknown): the unknown must be", G1, 12, 115, 1, dmGRN);
    TEXTOUT_P("14/15, P = 2 p14 p15.  Hp (victim + suspect", G1, 12, 128, 1, dmGRN);
    TEXTOUT_P("14/15): P = 1.  LR = 1 / (2 p14 p15).", G1, 12, 141, 1, dmGRN);
    TEXTOUT_P("Genotype entries are POSITIONS in your allele", G1, 12, 154, 1, #000000h);
    TEXTOUT_P("list (1 = the first allele); 0 means an", G1, 12, 167, 1, #000000h);
    TEXTOUT_P("allele the mixture does not show.", G1, 12, 180, 1, #000000h);
    // beta 3c (Roger, 19 Oct 2026): the first help page is the nearest
    // thing to an About page (the program opens on its menu)
    TEXTOUT_P("Teaching aid; not for casework or legal use.", G1, 12, 193, 1, dmRED);
  END;
  IF hgP == 2 THEN
    TEXTOUT_P("THETA (coancestry, Fst): people in the same", G1, 12, 24, 1, #000000h);
    TEXTOUT_P("subpopulation share ancestry: an allele seen", G1, 12, 37, 1, #000000h);
    TEXTOUT_P("in a typed person is likelier in the unknown.", G1, 12, 50, 1, #000000h);
    TEXTOUT_P("NRC II (1996) 4.2: P(next = a | n seen, n_a", G1, 12, 63, 1, dmMAG);
    TEXTOUT_P("are a) = (n_a th + (1-th) p_a)/(1 + (n-1) th)", G1, 12, 76, 1, dmMAG);
    TEXTOUT_P("ALL typed people condition it, contributors", G1, 12, 89, 1, #000000h);
    TEXTOUT_P("or not (Curran et al. 1999).  0.01 is usual,", G1, 12, 102, 1, #000000h);
    TEXTOUT_P("0.03 conservative.  The theta plot shows how", G1, 12, 115, 1, #000000h);
    TEXTOUT_P("much the LR falls as theta rises.", G1, 12, 128, 1, #000000h);
    // beta 3c (B4): "weak" starts at 2, as in dmVerbal and dmBand (an LR
    // from 1 to 2 is "about equal support"), the ENFSI 2015 scale
    TEXTOUT_P("ENFSI scale: LR 2-10 weak, 10-100 moderate,", G1, 12, 142, 1, dmGRN);
    TEXTOUT_P("100-1000 moderately strong, 1e3-1e4 strong,", G1, 12, 155, 1, dmGRN);
    TEXTOUT_P("1e4-1e6 very strong, above 1e6 extremely so.", G1, 12, 168, 1, dmGRN);
    TEXTOUT_P("Teaching tool only: casework needs validated", G1, 12, 181, 1, dmRED);
    TEXTOUT_P("software and a qualified analyst.", G1, 12, 192, 1, dmRED);
  END;
  IF hgP == 3 THEN
    TEXTOUT_P("Soft keys: Locus, Theta, Table, Ladder, Help,", G1, 12, 24, 1, #000000h);
    TEXTOUT_P("Menu.  Esc always goes back to the menu.", G1, 12, 35, 1, #000000h);
    TEXTOUT_P("LOCUS PLOT: tap a bar (or Left/Right) for its", G1, 12, 49, 1, dmBLUE);
    TEXTOUT_P("numbers; again (or Ent) for the locus page.", G1, 12, 60, 1, dmBLUE);
    TEXTOUT_P("+ or a tap on the title: the waterfall.", G1, 12, 71, 1, dmBLUE);
    TEXTOUT_P("THETA PLOT: drag across it (or Left/Right);", G1, 12, 85, 1, dmGRN);
    TEXTOUT_P("LR and the ladder follow.  Ent adopts theta.", G1, 12, 96, 1, dmGRN);
    TEXTOUT_P("TABLE: tap a row (or Up/Down, Ent) to drop", G1, 12, 110, 1, dmMAG);
    TEXTOUT_P("that locus -- as if not typed; tap to restore.", G1, 12, 121, 1, dmMAG);
    TEXTOUT_P("LOCUS PAGE: tap the boxes (or +) for Hp / Hd:", G1, 12, 135, 1, #000000h);
    TEXTOUT_P("green victim, magenta suspect, red = what the", G1, 12, 146, 1, #000000h);
    TEXTOUT_P("unknowns must supply.  arrows: loci, -: formula.", G1, 12, 157, 1, #000000h);
    TEXTOUT_P("LADDER: the LR builds locus by locus.", G1, 12, 171, 1, #000000h);
    TEXTOUT_P("The LR is NOT the probability that the suspect", G1, 12, 182, 1, dmRED);
    TEXTOUT_P("contributed: see Prosecutor's fallacy (8).", G1, 12, 193, 1, dmRED);
  END;
  IF hgP == 4 THEN
    // beta 3: the two new features, in teaching terms
    TEXTOUT_P("THE LR AS A FORMULA: on a locus page press -", G1, 12, 24, 1, dmMAG);
    TEXTOUT_P("(or tap the footer).  The CAS writes the LR", G1, 12, 37, 1, dmMAG);
    TEXTOUT_P("in the allele frequencies p and theta (th),", G1, 12, 50, 1, dmMAG);
    // beta 3c: dmProb now sums the same probability another way
    TEXTOUT_P("from the same model the program uses, and", G1, 12, 63, 1, dmMAG);
    TEXTOUT_P("simplifies it.  At theta = 0 it is the product", G1, 12, 76, 1, dmBLUE);
    TEXTOUT_P("rule, e.g. LR = 1/(2 p14 p15).  The number", G1, 12, 89, 1, dmBLUE);
    TEXTOUT_P("under it is the program's own LR.  Badge:", G1, 12, 102, 1, dmBLUE);
    TEXTOUT_P("exact (CAS), or decimal if the CAS failed.", G1, 12, 115, 1, dmBLUE);
    TEXTOUT_P("BAND EDGE (theta plot, orange): the theta at", G1, 12, 131, 1, dmORNG);
    TEXTOUT_P("which the combined LR crosses the next ENFSI", G1, 12, 144, 1, dmORNG);
    TEXTOUT_P("band edge as theta rises from yours: how far", G1, 12, 157, 1, dmORNG);
    TEXTOUT_P("theta must go before the words change.", G1, 12, 170, 1, dmORNG);
    TEXTOUT_P("Found by bisection in the program, not by CAS.", G1, 12, 183, 1, dmGRAY);
  END;
  TEXTOUT_P("tap or Ent = next page, Esc = menu", G1, 12, 204, 1, dmFOOT);
END;

// The help pages as a page.  Returns the next page.
dmHelp()
BEGIN
  LOCAL hpK, hpGo, hpRet, hpPg;
  hpPg := 1; hpGo := 1; hpRet := 0;
  REPEAT hpK := GETKEY; UNTIL hpK == -1;
  dmDrain();
  WHILE hpGo == 1 DO
    dmHelpPage(hpPg);
    dmMenu();
    hpK := dmPoll();
    IF hpK == -1 THEN
      dmDrain();
      IF dmTY >= 218 THEN
        hpRet := dmSoft(dmTX);
        IF hpRet == 5 THEN hpPg := 1; ELSE hpGo := 0; END;   // Help: page 1
      ELSE
        hpPg := hpPg + 1;                                    // a tap: next page
      END;
    ELSE
      IF hpK == 7 THEN hpPg := MAX(1, hpPg - 1); END;        // Left
      IF hpK == 8 OR hpK == 30 THEN hpPg := hpPg + 1; END;   // Right, Enter
      IF hpK == 4 THEN hpRet := 0; hpGo := 0; END;           // Esc
      REPEAT hpK := GETKEY; UNTIL hpK == -1;
    END;
    IF hpPg > 4 THEN hpRet := 0; hpGo := 0; END;            // past the last page
  END;
  RETURN hpRet;
END;

dmInit()
BEGIN
  // house palette: blue distribution/values, magenta derived (LR),
  // green verbal scale, red "excluded"/warnings/"you are here",
  // orange frames with the light-orange panel fill, dodger-blue
  // footers; light blue, shade, light red and light green fills
  dmBLUE := #003CC8h; dmMAG := #C800C8h; dmGRN := #008C3Ch;
  dmRED := #FF0000h; dmGRAY := #5A5A5Ah; dmFOOT := #1E90FFh;
  dmORNG := #FF4500h; dmPANL := #FFF0DCh; dmGRID := #E1E4EBh;
  dmLBLU := #EBF2FFh; dmSHAD := #AACDFFh; dmLRED := #FFEBEBh;
  dmLGRN := #E8F6EBh;
  // geometry, shared by the drawing and the touch handlers; every
  // page keeps y 218-239 free for the soft keys
  dmP1L := 44; dmP1R := 306; dmP1T := 30; dmP1B := 166;    // locus plot
  dmP2L := 40; dmP2R := 228; dmP2T := 34; dmP2B := 166;    // theta plot
  dmLdX1 := 240; dmLdX2 := 252; dmLdT := 22; dmLdB := 182;  // its ladder
  dmPcY := 107;                                            // locus page boxes
  dmFaT := 34;                                             // prior ladder
  dmTbY := 43; dmTbH := 11;                                // Results rows
  dmTh := 0.01;
  dmPres := {1, 1, 0};
  dmHp := {1, 1, 0, 0}; dmHd := {1, 0, 0, 1};
  dmLab := {}; dmFq := {}; dmGen := {0, 0, 0, 0, 0, 0}; dmM := 0;
  dmWF := 0; dmPicH := 1; dmPri := 6;
  dmPtV := {}; dmPtH := {}; dmYLo := 0; dmYHi := 1;
  dmTX := -1; dmTY := -1;
  // beta 3: the formula view and the band edge
  dmFrm := 0; dmFxK := ""; dmFxT := ""; dmFxS := 0;
  dmF0K := ""; dmF0T := ""; dmF0S := 0; dmCasOK := 0;
  dmTHG := "th";                                           // CHAR(952) after GfxProbe T14
  dmCasMx := 3000;                                         // longest CAS text sent
  dmEdT := -2; dmEdV := 0; dmEdOK := 0;
  dmClearLoci();
END;


// ------------------------------------------------------------
// THE PAGES: each returns the page to go to next (from its soft
// keys), or 0 for the menu.  1 locus plot, 2 theta plot, 3 Results
// table, 4 ladder, 5 help, 7 locus page, 8 prosecutor's fallacy.
// ------------------------------------------------------------
dmViews(vwN)
BEGIN
  LOCAL vwV;
  vwV := vwN;
  WHILE vwV > 0 DO
    CASE
      IF vwV == 1 THEN vwV := dmPlotLoci(); END;
      IF vwV == 2 THEN vwV := dmPlotTheta(); END;
      IF vwV == 3 THEN vwV := dmResults(); END;
      IF vwV == 4 THEN vwV := dmLadView(); END;
      IF vwV == 5 THEN vwV := dmHelp(); END;
      IF vwV == 7 THEN vwV := dmLocusPanel(); END;
      IF vwV == 8 THEN vwV := dmFallacy(); END;
      DEFAULT vwV := 0;
    END;
  END;
END;

// The whole locus-entry conversation; the locus page follows.
dmEnterLocus()
BEGIN
  LOCAL elM, elI, elSum, elL;
  IF dmNL >= 12 THEN
    MSGBOX("Twelve loci is the limit for this teaching tool.");
    RETURN;
  END;
  elM := 4;
  IF INPUT({elM}, "Locus " + STRING(dmNL + 1, 2, 0),
    {"Alleles in the mixture:"},
    {"How many DIFFERENT alleles the mixed profile shows: 2 to 8"}) == 0 THEN RETURN; END;
  elM := IP(elM);
  IF elM < 2 OR elM > 8 THEN
    MSGBOX("Enter a whole number from 2 to 8.");
    RETURN;
  END;
  dmM := elM;

  // the allele names, as numbers (STR alleles are repeat counts: 12, 13, 14.3 ...)
  elL := dmAskList(elM, "Allele names (repeat numbers)", "Allele", "The allele's name, e.g. 12 or 14.3", 10);
  IF SIZE(elL) == 0 THEN RETURN; END;
  dmLab := elL;

  // population frequencies, which must leave room for the alleles not seen
  elL := dmAskList(elM, "Population frequencies", "p of allele", "Frequency in the reference population, between 0 and 1", 0.1);
  IF SIZE(elL) == 0 THEN RETURN; END;
  elSum := 0;
  FOR elI FROM 1 TO elM DO
    IF elL(elI) <= 0 OR elL(elI) >= 1 THEN
      MSGBOX("Every frequency must be between 0 and 1.");
      RETURN;
    END;
    elSum := elSum + elL(elI);
  END;
  IF elSum > 1.000001 THEN
    MSGBOX("These frequencies add to " + dmF(elSum, 3) + ".  Alleles in one population cannot total more than 1.");
    RETURN;
  END;
  dmFq := elL;

  IF dmAskGen() == 0 THEN RETURN; END;

  // store (included in the product), recompute, show the locus page
  dmLoc := CONCAT(dmLoc, {{dmLab, dmFq, dmGen}});
  dmInc := CONCAT(dmInc, {1});
  dmNL := dmNL + 1;
  dmRecalc();
  dmSel := dmNL; dmPicH := 1;
  dmViews(7);
END;


// ------------------------------------------------------------
// MAIN MENU
// ------------------------------------------------------------
EXPORT DNAMixLR()
BEGIN
  LOCAL mnI, mnRun, mnT, mnS;
  dmInit();
  mnRun := 1;
  WHILE mnRun == 1 DO
    // the title carries the state: loci so far and the combined LR,
    // or the exclusion when a locus has one
    mnT := "DNAMixLR  loci " + STRING(dmNL, 2, 0);
    IF dmExcl > 0 THEN
      mnT := mnT + "  EXCLUDED at locus " + STRING(dmExcl, 2, 0);
    ELSE
      IF dmComb > 0 THEN mnT := mnT + "  LR " + dmBig(dmComb); END;
    END;
    IF dmNDrop > 0 THEN mnT := mnT + "  (" + STRING(dmNDrop, 2, 0) + " dropped)"; END;
    // The Prime numbers the items itself (1-9, then A, B, C), so the
    // strings carry no numbers.  Hypotheses first, then the locus
    // entry, as the header describes the work.
    // beta 3b: "Results table (tap a row to drop it)" was cut at the
    // box's edge on the emulator ("...to dro"): now "Results (tap a row
    // to drop)".  Comments stay HERE, outside the list: a comment
    // inside an open bracket is a Syntax Error on the Prime.
    mnI := 0;
    CHOOSE(mnI, mnT, {
      "Hypotheses:  " + dmHypStr(dmHp) + "  vs  " + dmHypStr(dmHd),
      "Enter a locus",
      "Coancestry theta = " + dmThS(dmTh),
      "Results (tap a row to drop)",
      "Plot: LR by locus (tap a bar)",
      "Plot: LR against theta (drag)",
      "Ladder: the LR locus by locus",
      "Prosecutor's fallacy",
      "Load the worked example",
      "Clear all loci",
      "Help",
      "Quit"});
    CASE
      IF mnI == 0 OR mnI == 12 THEN mnRun := 0; END;
      IF mnI == 1 THEN dmSetHyp(); END;
      IF mnI == 2 THEN dmEnterLocus(); END;
      IF mnI == 3 THEN dmSetTheta(); END;
      IF mnI == 4 THEN dmViews(3); END;
      IF mnI == 5 THEN dmViews(1); END;
      IF mnI == 6 THEN dmViews(2); END;
      IF mnI == 7 THEN dmViews(4); END;
      IF mnI == 8 THEN dmViews(8); END;
      IF mnI == 9 THEN dmExample(); END;
      IF mnI == 10 THEN dmClearLoci(); END;
      IF mnI == 11 THEN dmViews(5); END;
    END;
  END;
  // Home shows this line; nothing is left open on the screen
  mnS := ", " + STRING(dmNL, 2, 0) + " loci";
  IF dmNDrop > 0 THEN mnS := mnS + " (" + STRING(dmNDrop, 2, 0) + " dropped)"; END;
  mnS := mnS + ", theta = " + dmThS(dmTh);
  IF dmExcl > 0 THEN
    RETURN "DNAMixLR: EXCLUDED at locus " + STRING(dmExcl, 2, 0) + " (LR = 0)" + mnS;
  END;
  IF dmComb > 0 THEN
    RETURN "DNAMixLR: combined LR = " + dmBig(dmComb) + ", log10 = " + dmF(LOG(dmComb), 3) + mnS;
  END;
  RETURN "DNAMixLR: no loci";
END;
