'===========================================================================
' Subject: Paper-Scissors-Rock                Date: 06-16-02 (  :  )       
'  Author: David Williams                     Code: Qbasic,QB,PDS          
'  Origin: david.williams@ablelink.org      Packet: GAMES.ABC
'===========================================================================
' PSRGAME.BAS 
' David Williams. 2002 Jun 05 
  
' david.williams@ablelink.org 
  
' Program plays Paper Scissors Rock game 
  
DECLARE FUNCTION Rot% (X%) 
DECLARE FUNCTION Key$ (U$) 
DECLARE FUNCTION Pct$ (P&, T&) 
DECLARE SUB CompIns () 
DECLARE SUB OppIns () 
DECLARE SUB EndIns () 
  
DEFLNG A-Z 
  
CLS 
  
WIDTH 80, 25 
  
PRINT "Paper-Scissors-Rock game." 
PRINT 
PRINT "Please choose:" 
PRINT 
PRINT "1. You play with the computer as your opponent." 
PRINT "2. Computer helps you play against another person." 
PRINT 
PRINT "Your choice (1 or 2)?" 
  
CP% = (Key$("12") = "1") 
  
CLS 
  
IF CP% THEN 
  CALL CompIns 
  U1$ = "Computer's " 
  U2$ = "Your " 
ELSE 
  CALL OppIns 
  U1$ = "Your " 
  U2$ = "Opponent's " 
END IF 
  
PRINT "How many moves backward (1 - 2) (Try 1 first!) ?"; 
M% = VAL(Key$("12")) 
PRINT M% 
PRINT 
IF CP% THEN 
  PRINT "For fairness, you will see this same number of moves." 
  PRINT 
  LO% = 1 + 4 * M% 
  SS$ = STRING$(24 - LO%, 10) 
END IF 
  
P% = 9 ^ (M% - 1) 
N% = 9 * P% - 1 
  
DIM A!(0 TO N%, 0 TO 2), B$(0 TO 2) 
  
RANDOMIZE TIMER 
  
FOR X% = 0 TO N% 
 Z% = INT(3 * RND) 
 FOR Y% = 0 TO 1 
  A!(X%, Z%) = 1 + (RND - RND) / 10 
  Z% = Rot(Z%) 
 NEXT 
 A!(X%, Z%) = 3 - A!(X%, Rot(Z%)) - A!(X%, Rot(Rot(Z%))) 
NEXT 
  
B$(0) = "Paper" 
B$(1) = "Scissors" 
B$(2) = "Rock" 
  
Q% = INT((N% + 1) * RND)' previous 1 or 2 moves 
F! = .6  ' old-keys decline factor 
G! = 3 * (1 - F!) 
CC = 0   ' correct prediction counter 
CK = 0   ' event counter 
CD = 0   ' draws counter 
CU = 0   ' UPPERCASE confident predictions counter 
CV = 0   ' correct UPPERCASE predictions 
AJ% = 0  ' array adjustment flag 
  
PRINT "Start now..." 
  
IF CP% AND M% > 1 THEN PRINT STRING$(LO% - 7, 10) 
PRINT 
  
DO 
  
  A! = 1 
  FOR X% = 0 TO 2 
    IF A!(Q%, X%) >= A! THEN 
      D% = X% 
      A! = A!(Q%, X%) 
      IF A! > 1.5 THEN EXIT FOR 
    END IF 
  NEXT 
  
  CO% = (A! > 2.5) 
  
  C% = Rot(D%) 
  
  W$ = U1$ + "choice: " + B$(C%) ' computer-determined output 
  
  IF CO% THEN W$ = UCASE$(W$) 
  
  IF NOT CP% THEN PRINT W$ 
  
  PRINT U2$; "choice (P, S, R, (or Q to quit))? "; 
  K$ = Key$("PSRQ") 
  
  IF K$ = "Q" THEN EXIT DO 
  
  CK = CK + 1 
  IF CO% THEN CU = CU + 1 
  
  Y% = INSTR("PSR", K$) - 1 
  
  PRINT B$(Y%) 
  
  IF CP% THEN PRINT W$ 
  
  SELECT CASE Y% 
    CASE C% 
      CD = CD + 1 
      PRINT "Draw." 
    CASE D% 
      CC = CC + 1 
      IF CO% THEN CV = CV + 1 
      PRINT U1$; "win!" 
    CASE ELSE 
      PRINT U2$; "win!" 
  END SELECT 
  
  IF CP% THEN 
    PRINT SS$ 
    LOCATE LO%, 1 
  ELSE 
    PRINT 
  END IF 
  
  IF CK > M% THEN 
  
    U% = Rot(Y%) 
    V% = Rot(U%) 
  
    R! = A!(Q%, Y%) 
  
    IF A!(Q%, U%) * A!(Q%, V%) > .01 THEN 
      A!(Q%, Y%) = F! * R! + G! 
    ELSEIF Y% <> D% THEN 
      A!(Q%, Y%) = 1 + RND 
    ELSE 
      AJ% = -1 
    END IF 
  
    IF NOT AJ% THEN 
      A!(Q%, U%) = A!(Q%, U%) * (3 - A!(Q%, Y%)) / (3 - R!) 
      A!(Q%, V%) = 3 - A!(Q%, U%) - A!(Q%, Y%) 
    ELSE 
      AJ% = 0 
    END IF 
  
  END IF 
  
  Q% = Q% \ 9 + P% * (Y% + 3 * D%) 
  
LOOP 
  
PRINT "QUIT" 
PRINT 
PRINT "Trials:"; CK 
PRINT U1$; "wins:"; CC 
PRINT U2$; "wins:"; CK - CC - CD 
PRINT "Draws:"; CD 
IF CK THEN 
 PRINT 
 PRINT U1$; "wins were"; Pct$(CC, CK); "of trials." 
 IF 3 * CV > CU THEN 
  PRINT 
  PRINT "There were"; CU; "UPPERCASE choices."; 
  PRINT Pct$(CV, CU); "were winners." 
 END IF 
 PRINT 
 PRINT "About 33% would be expected by chance." 
END IF 
  
END 
  
SUB CompIns 
 PRINT "This program will allow you to play against the computer." 
 PRINT "Beware! The computer is very good at the game!" 
 PRINT 
 PRINT "At each move of the game, the computer will ask you for your" 
 PRINT "choice, Paper, Scissors or Rock. Type the initial letter." 
 PRINT "The computer will then print your choice and its own. Note" 
 PRINT "that, although the computer's choice is not printed until" 
 PRINT "after you have made your own choice, it is generated before" 
 PRINT "your choice is made." 
  
 CALL EndIns 
  
END SUB 
  
SUB EndIns 
 PRINT 
 PRINT "If a line is printed in UPPERCASE, it means the computer" 
 PRINT "is fairly sure of this choice." 
 PRINT 
 PRINT "When you wish to Quit the game, press 'Q'. A summary of the" 
 PRINT "results will then be printed." 
 PRINT 
 PRINT "First, you must decide whether the program should look just" 
 PRINT "at one previous move, or two. Unless you intend to play a" 
 PRINT "very long game, the better choice is one." 
 PRINT 
END SUB 
  
FUNCTION Key$ (U$) 
  DO WHILE INKEY$ <> "" 
  LOOP 
  DO 
    K$ = UCASE$(INPUT$(1)) 
  LOOP UNTIL INSTR(U$, K$) 
  Key$ = K$ 
END FUNCTION 
  
SUB OppIns 
 PRINT "This program will help you win the Paper-Scissors-Rock" 
 PRINT "game against a human opponent." 
 PRINT 
 PRINT "For each move of the game, the computer will tell you" 
 PRINT "'Your choice'. You should make this choice in this move." 
 PRINT "The computer will also ask for your opponent's choice," 
 PRINT "which you should type in (just the initial) right after" 
 PRINT "the move is made. Then you will be told the next choice" 
 PRINT "you should make, and so on." 
 PRINT 
 PRINT "Do not let your opponent see the computer screen!" 
  
 CALL EndIns 
  
END SUB 
  
FUNCTION Pct$ (P, T) 
  Pct$ = STR$(CINT(P / T * 100)) + "% " 
END FUNCTION 
  
FUNCTION Rot% (X%) 
  Rot = (1 + X%) MOD 3 
END FUNCTION 
