[VA] SRC #012a - Then and Now: Probability

[Werner]

(10-05-2022 08:38 PM)Valentin Albillo Wrote:  using EXCLUSIVELY VINTAGE HP CALCULATORS (physical or virtual,) coding in either RPN, RPL or HP-71B language AND NOTHING ELSE

Well, to make Valentin's wishes come true, here's an entry that will solve the 30/60 problem on a real 42S, the only vintage RPN calculator able to do it.
To make it fit the 42S' memory, I have taken Albert Chan's flattened code to the extreme: you don't need a full P *and* Q, they can largely overlap, all you need is an extra buffer row at the end.
The memory requirements are then (R+4)/2 x (R+3), and I define REGS as such.
When P is calculated it is shifted down a full row with regard to Q, in rows 2..(R+4)/2, and we move it one row up by deleting the first row and adding a new empty row at the end (which, incidentally, you can't do with INSR).

here's the code. Not much time has been spent in trying to improve it, just to make it work ;-)
Estimate of real 42S running time: 3h05m

I use VARMENU "TRW" to set R and S, EXIT the menu and do XEQ "TRW"

00 { 325-Byte Prgm }
01▸LBL "TRW"
02 MVAR "R"
03 MVAR "S"
04 4
05 RCL+ "R"
06 2
07 STO "M"
08 ÷
09 3
10 RCL+ "R"
11 CLV "REGS"
12 DIM "REGS"
13 1
14 STO 02
15 RCL "S"
16 STO "K"
17 EDITN "REGS"
18 GROW

19▸LBL 20
@ ---------------------------------
@ P-> Q, adjust corners and edges
@ ---------------------------------
20 3
21 STO× 02 @ top
22 RCL "M"
23 RCL "R"
24 X=Y?
25 DSE ST Y
26 SIGN
27 -
28 1ᴇ3
29 STO+ ST Y
30 ÷ @ I=1..M-1-(M=R)
31 2
32▸LBL 02 @ left and right edges
33 2
34 +
35 RCL+ ST Y
36 1.5
37 STO× IND ST Y
38 STO× IND ST L
39 R↓
40 IP
41 ISG ST Y
42 GTO 02
43 RCL "M"
44 RCL "R"
45 X>Y?
46 GTO 00
47 RCL ST Z
48 ENTER
49 ENTER
50 RCL+ "R"
51 1ᴇ3
52 ÷
53 +
54 3
55 +
56 1.5
57▸LBL 03 @ bottom edge
58 STO× IND ST Y
59 ISG ST Y
60 GTO 03
61 R^
62 2
63 +
64 3
65 STO× IND ST Y
66 STO× IND ST T
67▸LBL 00
@ ---------------------------------------------------------
@ Q->P
@ P(X) := Q(X-1)+Q(X+1)+Q(X-I-1)+Q(X-I)+Q(X+I+1)+Q(X+I+2)
@ and P(X) is just Q(X+R+3)
@ ---------------------------------------------------------
@ find I,J of P(M,M) in the (R+4)/2 x (R+3) matrix
@ qmm = Reg(M*(M+1)/2 + M)
@ pmm = Reg(qmm + R+3)
@ J = pmm MOD (R+3) + 1
@ I = (pmm + 1 - J)/(R+3) + 1
68 RCL "M"
69 STO "I"
70 ENTER
71 XEQ 99 @ qmm
72 RCL ST X
73 3
74 RCL+ "R"
75 +
76 RCL ST X
77 LASTX @ R+3 pmm+1 pmm+1 qmm
78 MOD
79 STO- ST Y
80 X<>Y
81 LASTX
82 STO+ ST Y
83 ÷
84 X<>Y
85 1
86 +
87 STOIJ
88 R^
89 RCL- "M"
90 LASTX
91 2
92 +
93 RCL+ "M"
94 LASTX

95▸LBL 04
96 RCL "I"
97 STO "J"
98 DSE ST Y
99▸LBL 05
100 CLX
101 RCL IND ST T
102 RCL+ IND ST Z
103 RCL+ IND ST Y
104 DSE ST T
105 DSE ST Z
106 DSE ST Y
107 DSE ST Y
108 RCL+ IND ST T
109 RCL+ IND ST Z
110 RCL+ IND ST Y
111 ISG ST Y
112▸LBL 00
113 ←
114 DSE "J"
115 GTO 05
116 DSE ST Z
117 DSE ST Z
118 CLX
119 ←
120 R↓
121 DSE "I"
122 GTO 04

123 I-
124 DELR @ we are at 1,1 now
125 CLX
126 ←
127 → @ GROW mode causes an extra row now
128 RCL "M"
129 RCL "R"
130 X>Y?
131 ISG "M"
132▸LBL 00
133 DSE "K"
134 GTO 20
135 RCLEL
136 EXITALL
137 RCL "R"
138 ENTER
139 ENTER
140 XEQ 99
141 0
142▸LBL 06
143 RCL+ IND ST Y
144 DSE ST Y
145 DSE ST Z
146 GTO 06
147 6
148 RCL "S"
149 Y^X
150 ÷
151 RTN
152▸LBL 99
153 ENTER
154 X^2
155 +
156 2
157 ÷
158 +
159 END


Cheers, Werner