roman-decimal.a68
1 COMMENT
2
3 @section Synopsis
4
5 Translation between decimal and Roman notation.
6
7 This Algol 68 version originates from the legacy "REVISED MC ALGOL 68 TEST SET":
8
9 Dick Grune, The Revised MC ALGOL 68 Test Set, IW XX/79,
10 Mathematical Centre, Amsterdam.
11
12 The Mathematical Centre ("Stichting Mathematisch Centrum" or SMC) was a Dutch
13 non-profit institution aiming at the promotion of pure mathematics and its
14 applications.
15
16 SMC is now "Stichting Centrum Wiskunde & Informatica" (CWI). The test set
17 is available as an open access publication from the CWI repository:
18
19 https://ir.cwi.nl/pub/
20
21 Selected (modified) "Revised MC ALGOL 68 Test Set" programs are distributed
22 with Algol 68 Genie with kind permission of Dick Grune.
23
24 COMMENT
25
26
27 BEGIN # Translation decimal number to Roman notation and vice versa #
28 PROC roman = (INT number) STRING:
29 BEGIN INT n:= number, STRING result,
30 [] STRUCT (INT value, STRING r) table =
31 ((1000, "M"), (900, "CM"), (500,"D"), (400,"CD"),
32 (100,"C"), (90,"XC"), (50,"L"), (40,"XL"),
33 (10,"X"), (9,"IX"), (5,"V"), (4,"IV"), (1,"I"));
34 FOR i TO UPB table
35 DO INT v = value OF table[i], STRING r = r OF table[i];
36 WHILE v LE n
37 DO (result +:= r, n -:= v)
38 OD
39 OD;
40 result
41 END,
42
43 PROC value of roman = (STRING text) INT:
44 IF text = ""
45 THEN 0
46 ELSE OP ABS = (CHAR s) INT:
47 CASE INT p; char in string (s,p, "IVXLCDM"); p
48 IN 1, 5, 10, 50, 100, 500, 1000
49 ESAC,
50 INT v, maxv := 0, maxp;
51 FOR p TO UPB text
52 DO IF (v := ABS text[p]) > maxv
53 THEN maxp := p; maxv := v
54 FI
55 OD;
56 maxv - value of roman (text[: maxp - 1]) + value of roman (text[maxp + 1:])
57 FI;
58 print ((roman (1968), new line)); # "MCMLXVIII" #
59 print ((whole (value of roman ("MCMLXXVI"), 0), new line)) # 1976 #
60 END
