Algol 68 Genie

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
Deze website is gearchiveerd door de KB, nationale bibliotheek.

This website is archived by the National Library of the Netherlands.