aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

September 2017 Update

Browse source
This commit is contained in:
Ingy döt Net 2017-09-23 10:01:46 +02:00
parent bba7bfd280
commit ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
Download patch file Download diff file Expand all files Collapse all files

297
Task/24-game-Solve/Simula/24-game-solve.simula Normal file
View file

@ -0,0 +1,297 @@
BEGIN
CLASS EXPR;
BEGIN
REAL PROCEDURE POP;
BEGIN
IF STACKPOS > 0 THEN
BEGIN STACKPOS := STACKPOS - 1; POP := STACK(STACKPOS); END;
END POP;
PROCEDURE PUSH(NEWTOP); REAL NEWTOP;
BEGIN
STACK(STACKPOS) := NEWTOP;
STACKPOS := STACKPOS + 1;
END PUSH;
REAL PROCEDURE CALC(OPERATOR, ERR); CHARACTER OPERATOR; LABEL ERR;
BEGIN
REAL X, Y; X := POP; Y := POP;
IF OPERATOR = '+' THEN PUSH(Y + X)
ELSE IF OPERATOR = '-' THEN PUSH(Y - X)
ELSE IF OPERATOR = '*' THEN PUSH(Y * X)
ELSE IF OPERATOR = '/' THEN BEGIN
IF X = 0 THEN
BEGIN
EVALUATEDERR :- "DIV BY ZERO";
GOTO ERR;
END;
PUSH(Y / X);
END
ELSE
BEGIN
EVALUATEDERR :- "UNKNOWN OPERATOR";
GOTO ERR;
END
END CALC;
PROCEDURE READCHAR(CH); NAME CH; CHARACTER CH;
BEGIN
IF T.MORE THEN CH := T.GETCHAR ELSE CH := EOT;
END READCHAR;
PROCEDURE SKIPWHITESPACE(CH); NAME CH; CHARACTER CH;
BEGIN
WHILE (CH = SPACE) OR (CH = TAB) OR (CH = CR) OR (CH = LF) DO
READCHAR(CH);
END SKIPWHITESPACE;
PROCEDURE BUSYBOX(OP, ERR); INTEGER OP; LABEL ERR;
BEGIN
CHARACTER OPERATOR;
REAL NUMBR;
BOOLEAN NEGATIVE;
SKIPWHITESPACE(CH);
IF OP = EXPRESSION THEN
BEGIN
NEGATIVE := FALSE;
WHILE (CH = '+') OR (CH = '-') DO
BEGIN
IF CH = '-' THEN NEGATIVE := NOT NEGATIVE;
READCHAR(CH);
END;
BUSYBOX(TERM, ERR);
IF NEGATIVE THEN
BEGIN
NUMBR := POP; PUSH(0 - NUMBR);
END;
WHILE (CH = '+') OR (CH = '-') DO
BEGIN
OPERATOR := CH; READCHAR(CH);
BUSYBOX(TERM, ERR); CALC(OPERATOR, ERR);
END;
END
ELSE IF OP = TERM THEN
BEGIN
BUSYBOX(FACTOR, ERR);
WHILE (CH = '*') OR (CH = '/') DO
BEGIN
OPERATOR := CH; READCHAR(CH);
BUSYBOX(FACTOR, ERR); CALC(OPERATOR, ERR)
END
END
ELSE IF OP = FACTOR THEN
BEGIN
IF (CH = '+') OR (CH = '-') THEN
BUSYBOX(EXPRESSION, ERR)
ELSE IF (CH >= '0') AND (CH <= '9') THEN
BUSYBOX(NUMBER, ERR)
ELSE IF CH = '(' THEN
BEGIN
READCHAR(CH);
BUSYBOX(EXPRESSION, ERR);
IF CH = ')' THEN READCHAR(CH) ELSE GOTO ERR;
END
ELSE GOTO ERR;
END
ELSE IF OP = NUMBER THEN
BEGIN
NUMBR := 0;
WHILE (CH >= '0') AND (CH <= '9') DO
BEGIN
NUMBR := 10 * NUMBR + RANK(CH) - RANK('0'); READCHAR(CH);
END;
IF CH = '.' THEN
BEGIN
REAL FAKTOR;
READCHAR(CH);
FAKTOR := 10;
WHILE (CH >= '0') AND (CH <= '9') DO
BEGIN
NUMBR := NUMBR + (RANK(CH) - RANK('0')) / FAKTOR;
FAKTOR := 10 * FAKTOR;
READCHAR(CH);
END;
END;
PUSH(NUMBR);
END;
SKIPWHITESPACE(CH);
END BUSYBOX;
BOOLEAN PROCEDURE EVAL(INP); TEXT INP;
BEGIN
EVALUATEDERR :- NOTEXT;
STACKPOS := 0;
T :- COPY(INP.STRIP);
READCHAR(CH);
BUSYBOX(EXPRESSION, ERRORLABEL);
IF NOT T.MORE AND STACKPOS = 1 AND CH = EOT THEN
BEGIN
EVALUATED := POP;
EVAL := TRUE;
GOTO NOERRORLABEL;
END;
ERRORLABEL:
EVAL := FALSE;
IF EVALUATEDERR = NOTEXT THEN
EVALUATEDERR :- "INVALID EXPRESSION: " & INP;
NOERRORLABEL:
END EVAL;
REAL PROCEDURE RESULT;
RESULT := EVALUATED;
TEXT PROCEDURE ERR;
ERR :- EVALUATEDERR;
TEXT T;
INTEGER EXPRESSION;
INTEGER TERM;
INTEGER FACTOR;
INTEGER NUMBER;
CHARACTER TAB;
CHARACTER LF;
CHARACTER CR;
CHARACTER SPACE;
CHARACTER EOT;
CHARACTER CH;
REAL ARRAY STACK(0:31);
INTEGER STACKPOS;
REAL EVALUATED;
TEXT EVALUATEDERR;
EXPRESSION := 1;
TERM := 2;
FACTOR := 3;
NUMBER := 4;
TAB := CHAR(9);
LF := CHAR(10);
CR := CHAR(13);
SPACE := CHAR(32);
EOT := CHAR(0);
END EXPR;
INTEGER ARRAY DIGITS(1:4);
INTEGER SEED, I;
REF(EXPR) E;
INTEGER SOLUTION;
INTEGER D1,D2,D3,D4;
INTEGER O1,O2,O3;
TEXT OPS;
OPS :- "+-*/";
E :- NEW EXPR;
OUTTEXT("ENTER FOUR INTEGERS: ");
OUTIMAGE;
FOR I := 1 STEP 1 UNTIL 4 DO DIGITS(I) := ININT; !RANDINT(0, 9, SEED);
! DIGITS ;
FOR D1 := 1 STEP 1 UNTIL 4 DO
FOR D2 := 1 STEP 1 UNTIL 4 DO IF D2 <> D1 THEN
FOR D3 := 1 STEP 1 UNTIL 4 DO IF D3 <> D2 AND
D3 <> D1 THEN
FOR D4 := 1 STEP 1 UNTIL 4 DO IF D4 <> D3 AND
D4 <> D2 AND
D4 <> D1 THEN
! OPERATORS ;
FOR O1 := 1 STEP 1 UNTIL 4 DO
FOR O2 := 1 STEP 1 UNTIL 4 DO
FOR O3 := 1 STEP 1 UNTIL 4 DO
BEGIN
PROCEDURE P(FMT); TEXT FMT;
BEGIN
INTEGER PLUS;
TRY.SETPOS(1);
WHILE FMT.MORE DO
BEGIN
CHARACTER C;
C := FMT.GETCHAR;
IF (C >= '1') AND (C <= '4') THEN
BEGIN
INTEGER DIG; CHARACTER NCH;
DIG := IF C = '1' THEN DIGITS(D1)
ELSE IF C = '2' THEN DIGITS(D2)
ELSE IF C = '3' THEN DIGITS(D3)
ELSE DIGITS(D4);
NCH := CHAR( DIG + RANK('0') );
TRY.PUTCHAR(NCH);
END
ELSE IF C = '+' THEN
BEGIN
PLUS := PLUS + 1;
OPS.SETPOS(IF PLUS = 1 THEN O1 ELSE
IF PLUS = 2 THEN O2
ELSE O3);
TRY.PUTCHAR(OPS.GETCHAR);
END
ELSE IF (C = '(') OR (C = ')') OR (C = ' ') THEN
TRY.PUTCHAR(C)
ELSE
ERROR("ILLEGAL EXPRESSION");
END;
IF E.EVAL(TRY) THEN
BEGIN
IF ABS(E.RESULT - 24) < 0.001 THEN
BEGIN
SOLUTION := SOLUTION + 1;
OUTTEXT(TRY); OUTTEXT(" = ");
OUTFIX(E.RESULT, 4, 10);
OUTIMAGE;
END;
END
ELSE
BEGIN
IF E.ERR <> "DIV BY ZERO" THEN
BEGIN
OUTTEXT(TRY); OUTIMAGE;
OUTTEXT(E.ERR); OUTIMAGE;
END;
END;
END P;
TEXT TRY;
TRY :- BLANKS(17);
P("(1 + 2) + (3 + 4)");
P("(1 + (2 + 3)) + 4");
P("((1 + 2) + 3) + 4");
P("1 + ((2 + 3) + 4)");
P("1 + (2 + (3 + 4))");
END;
OUTINT(SOLUTION, 0);
OUTTEXT(" SOLUTIONS FOUND");
OUTIMAGE;
END.