Yahztee for the HP 41 - improve this program!

[Gene]

This is the commented code with the changes to LBL 10 from HHC a couple of years ago. Glad to have any optimizations. The original program was first written back in 1984 and published in a 1985 PPC Journal.

Code:

Register usage:
00 – random number seed
01-13 – the values in each row of the scorecard
14-18 – the individual dice stored 1 value per register
19 – the number of rolls made so far. On the 3rd row, you must score the set of dice.
20 – the score for the current scorecard row
21 – used to store the scorecard row being evaluated
22 – holds the value 1-6 when scoring top of scorecard
23 – holds the 14.018 loop index

This is the initialization section. It clears registers, stores the random numbers seed in memory 00 and clears flags 0-20.

LBL "YZ"
CLRG
"SEED?"
PROMPT
STO 00
LBL 16
.02
LBL 14
CF IND X
ISG X
GTO 14


14.018
STO 23
FIX 00
CF 29
LBL 15
12345
GTO 71

By putting 12345 into X and going to LBL 71, the program will roll all five dice. Since this is the first time, that will initialize registers 14-18 with a die in each register.

LBL 17
1
ST+ 19
RCL 19
3
X<=Y?
GTO 22

This section of code increments the roll counter and checks that it is roll 1 or 2. If so, then the player can roll some or none of the dice again. If the roll counter is 3, then it is time to score. Instead of this code, should I store 2 into register 19 when the first roll is made instead of zero and then replace this code DSE 19 GTO 22?


>" ROLL?"
LBL 27
CLX
PROMPT
INT
X<0?
GTO 27

Less than zero is an invalid entry.

X=0?
SF 00
X=0?
GTO 61

The GTO 61 simply skips ahead redisplays the digits but skips ahead to the SCORE? prompt by setting flag 0 here.

Label 71 takes the user input of which dice to roll and slices a digit at a time from the input, adds 13 to the digit and then rolls a new die for that register. Loops until the digit is a 0 (means it has rolled all digits)

LBL 71
10
/
ENTER
INT
X<>Y
FRC
10
*
X=0?
GTO 20
5
X<>Y
X>Y?
GTO 72

If someone entered 194 at the roll prompt, this will skip over the invalid 9.

X<>Y
RDN
13
+

Below is the tried and true 997 random number generator.

RCL 00
997
*
FRC
STO 00
6
*
1
+
INT
STO IND Y
LBL 72
RCL Z
GTO 71

LBL 20
XEQ 40

Label 40 at the end of the program sorts registers 14.018

LBL 61
CLA
ARCL 14
ARCL 15
ARCL 16
ARCL 17
ARCL 18
FS?C 00
GTO 22
GTO 17

Label 65 checks for a bonus (second, third, etc.) yahtzee during a game. When scoring, if you have a second yahtzee, enter the row to be scored as a negative value. For example, if you have already scored a yahtzee and then get another one, if you wanted to score it as a 3 of a kind, key -7 and R/S at the SCORE? prompt. The program will score it regularly as a 3 of a kind, but will also here give you an extra 100 points 

LBL 65
ABS
RCL 12
X=0?
GTO 61
RDN
RCL 14
RCL 18
X=Y?
SF 20
RCL Z
GTO 64


LBL 22
>" SCORE?"
LBL 66
CLX
CF 20
PROMPT
INT
13
X<>Y
X>Y?
GTO 66

Trying to score in a row > 13 is invalid. Go back to prompt.

X=0?
GTO 25

Entering a zero at the SCORE? prompt displays the available rows in which to score and returns to the SCORE? prompt.

X<0?
GTO 65

A negative value (-7 for example) says to score in row 7 but that a second yahtzee is implied. The program checks if a previous yahtzee has already been scored and if so, scores the roll into the absolute value row indicated and adds a 100 point bonus to row 12. This is checked down in label 65.

FS? IND X
GTO 66

Trying to score in a row that is already used is not allowed. Goes back to SCORE? prompt.

LBL 64
STO 21
RCL 23
STO 22
CLX
STO 19
STO 20
XEQ IND 21

This XEQ IND command goes to the label reflecting the row score to be evaluated. A value of 1 will skip to count the number of 1’s in the five dice, a value of 7 checks for 3-of-a-kind, etc.

CF 00
"ROW "
ARCL 21
>"="
ARCL 20
AVIEW
RCL 20
STO IND 21
SF IND 21

Above, the score determined is saved in the proper row of the scorecard and the corresponding row’s flag is set.

X!=0?
FC?C 20
GTO 63

At this point, two things are indicated. Flag 20 is set indicating a second yahtzee has been achieved but the bonus cannot be paid unless the roll also has a valid score on the row indicated. For example, a second yahztee of 11111 cannot be scored in row 10 small straight. True, you might have a second yahtzee but it has to go into a row where it scores a value.

So, the above code only goes to label 63 if X is equal to zero or if X is not equal to zero and flag 20 is set. That would indicate no second yahtzee so go to label 63.

The code below adds 100 to row 12 of the score card.

2
10^X
ST+ 12
>" "
ARCL X
PSE
AVIEW
PSE

Label 63 checks to see if the scorecard is full – which has happened if all flags 1-13 are set. Any clear flag means to keep playing. 

LBL 63
CLX
STO 20
1.013
LBL 75
FC? IND X
GTO 15
ISG X
GTO 75

The game is over at this point. Time to total up the scores and display the results

"DONE"
AVIEW
RCL 01
RCL 02
RCL 03
RCL 04
+
+
+
RCL 05
+
RCL 06
+
"TOP="
ARCL X
>"+"
63
X<=Y?
35
X>Y?
0
ARCL X

The above steps display a bonus of 35 points if the top six rows of the scorecard total 63 or greater.

X<>Y
RDN
+
AVIEW
PSE
RCL 07
RCL 08
RCL 09
+
+
RCL 11
+
RCL 12
+
RCL 13
+
"LOWER="
ARCL X
AVIEW
PSE
+
"END="
ARCL X
PROMPT
GTO 16

Pressing R/S after the END= score is shown will start a new game.

Label 25 displays the open score rows which will be the unset flags between 01 and 13. Yes, I know a final "," is shown in the display. Did not spend the bytes trying to avoid that.

LBL 25
CLA
1.013
LBL 00
FC? IND X
ARCL X
FC? IND X
>","
ISG X
GTO 00
AVIEW
PSE
GTO 61

Labels 01-06 do the scoring by checking for values of 1,2,3,4,5, or 6 in the 14.018 registers. Register 21 contains the value to look for and register 22 is the loop counter 14.018.

LBL 01
LBL 02
LBL 03
LBL 04
LBL 05
LBL 06
RCL IND 22
RCL 21
X=Y?
ST+ 20
ISG 22
GTO 06
RTN

Label 13 is the chance scoring row. It adds up the total of all dice.

LBL 13
FS?C 14
RTN

This flag is checked to indicate the program got here as a result of scoring a full house (LBL 09). A return is performed because even though 3 of a kind is present for a full house, the scoring is not done as 3 of a kind but a flat 25 points. The return goes back to LBL 09.

RCL 14
RCL 15
RCL 16
RCL 17
+
+
+
RCL 18
+
STO 20
RTN

Label 12 checks for a yahtzee, all five dice the same. If sorted, registers 14 and 18 should be equal.

LBL 12
RCL 18
RCL 14
X!=Y?
RTN
BEEP
50
STO 20
RTN

Label 07 checks for 3 of a kind. The first and third second and fourth, or third and fifth dice must be equal. Label 13 scores the total of all dice.

LBL 07
RCL 14
RCL 16
X=Y?
GTO 13
RCL 18
X=Y?
GTO 13
RCL 17
RCL 15
X=Y?
GTO 13
RTN

Label 08 checks for 4 of a kind. The first and fourth, or second and fifth dice must be equal. Label 13 scores the total of all dice.

LBL 08
RCL 14
RCL 17
X=Y?
GTO 13
RCL 15
RCL 18
X=Y?
GTO 13
RTN

Label 9 checks for a full house. By definition, there must be a 3 of a kind, so the routine executes label 07 to check for that first. If that is present, then registers 14/15 or 17/18 must be now be equal to be a full house.

LBL 09
SF 14
XEQ 07
FS?C 14
RTN

If Flag 14 is still set, it means 3 of a kind was not found hence the RTN in the previous step. Flag 14 is cleared in the LBL 13 scoring routine which is only executed from this XEQ 07 call when 3 of a kind is present.

RCL 14
RCL 15
X!=Y?
RTN
RCL 17
RCL 18
X!=Y?
RTN
25
STO 20
RTN

Labels 10 and 11 check for a small straight and a large straight. Thanks to Guenter for this code!

LBL 10
XEQ 35
30
ENTER
7
GTO 36
LBL 11
XEQ 35
40
ENTER
6
LBL 36
RCL Z
X>Y?
RTN
RCL Z
STO 20
RTN
LBL 35
RCL 15
RCL 17
*
10
X=Y?
RTN
RCL 23
ISG X
RCL 14
ENTER
LBL 50
SIGN
+
RCL IND Y
X=Y?
DSE T
X<>Y
ISG Z
GTO 50
R^
RTN

Label 40 is the sorting routine. It sets degree mode (flag 43) upon entering. It compares adjacent registers and swaps them if out of order. When a swap is made, RAD mode and the RAD annunciator are set, which changes flag 43 status. At the end of a sweep through the registers, if RAD is set, a swap was made and the sort is not over.

I am ok shortening this LBL 40 routine with another sort, but I do find it kind of fun to see the RAD go on and off.

LBL 40
DEG
RCL 17
RCL 16
RCL 15
RCL 14
X>Y?
RAD
X>Y?
X<>Y
STO 14
RDN
X>Y?
RAD
X>Y?
X<>Y
STO 15
RDN
X>Y?
RAD
X>Y?
X<>Y
STO 16
RDN
RCL 18
X<Y?
RAD
X<Y?
X<>Y
STO 18
X<>Y
STO 17

If flag 43 is set, then RAD mode is on and the list needs to be examined again.

FS? 43
GTO 40
END

[Dieter]

I think you can either have compact code or one that is executing fast. I have not examined the whole program – maybe a complete rewrite is the only way to get substantial improvements – but here are two examples for the sort routine.

Short version (kind of bubble sort):

Code:

LBL 40
14.017   xxx.yyy sorts registers xxx to yyy+1
LBL 41
RCL X
1.001
+
RCL IND Y
LBL 42
RCL IND Y
X<Y?
X<> IND T
STO IND Z
RDN
ISG X
GTO 42
RDN
RDN
ISG X
GTO 41
RTN

This takes about 4 – 5 seconds for sorting the five numbers in R14...R18.

Edit: if you like watching the RAD annunciator, here is another version that on average also runs faster since it detects whether a register swap occured or not:

Code:

LBL 40
14.017   xxx.yyy sorts registers xxx to yyy+1
LBL 41
ENTER
DEG
1.001
+
RCL IND Y
LBL 42
RCL IND Y
X<Y?
RAD
X<Y?
X<> IND T
STO IND Z
RDN
ISG X
GTO 42
RDN
RDN
FC? 43
CLX
ISG X
GTO 41
DEG
RTN

But this version still is a bit slower than yours, and I do not think it saves any bytes.

Finally here is my favourite: it is longer but very fast – essentially it's the same approach as above, but without loops:

Code:

LBL 40
RCL 15
RCL 14
X>Y?
X<> 15
STO 14
RCL 16
X<>Y
X>Y?
X<> 16
STO 14
RCL 17
X<>Y
X>Y?
X<> 17
STO 14
RCL 18
X<>Y
X>Y?
X<> 18
STO 14
RCL 16
RCL 15
X>Y?
X<> 16
STO 15
RCL 17
X<>Y
X>Y?
X<> 17
STO 15
RCL 18
X<>Y
X>Y?
X<> 18
STO 15
RCL 17
RCL 16
X>Y?
X<> 17
STO 16
RCL 18
X<>Y
X>Y?
X<> 18
STO 16
RCL 18
RCL 17
X>Y?
X<> 18
STO 17
RTN

This one executes in not much more than a second (!) – in any case.

The part that rolls the dice can be improved as follows.
Input: up to 5-digit number representing the dice to roll, e.g. 12345.

Code:

LBL 71
5
RCL Y
10
ST/ T
MOD
X#0?
X>Y?
GTO 72
+
8
+
RCL 00
997
*
FRC
STO 00
6
*
1
+
INT
STO IND Y
LBL 72
R^
INT
X#0?
GTO 71
XEQ 40
...

This even saves a label (20). And it also checks whether a die number is zero (invalid).

So far a few first thoughts.

Dieter