Roman Numbers (1 to 3999)

To interpret  Roman numbers we have first to find where are the double characters which represents numbers 900, 400, 90, 40, 9 and 4.
If we found one then we have to check from an exclude list if in the right side there are one or more, and if we found one then this is an invalid input.
Also when we found one we can replace it with an internal code.



This is the output of this program:
MMMCMXCIX=3999
LXXIIX=invalid
MMXVII=2017
LXXIX=79
CXCIX=199
MCMXCIX=1999
MMMDCCCLXXXVIII=3888
CMXI=911
M=1000
MCDXLIV=1444
CCCC=invalid
IXV=invalid
XLIXL=invalid
LXXIIX=invalid
IVM=invalid
XXXIX=39
XXXX=invalid
XIXX=invalid
IVI=invalid
XLIX=49
XCIX=99
XCIV=94
XLVIII=48
XLCD=invalid

Module RomanNumbers {
      flush ' empty current stack
      gosub Initialize
      document Doc$
      while not empty
            read rom$
            print rom$;"=";RomanEval$(rom$)
            Doc$=rom$+"="+RomanEval$(rom$)+{
            }
      end while
      Clipboard Doc$
      end
Initialize:
      function RomanEval$(rom$) {
            Flush
            ="invalid"
            if filter$(rom$,"MDCLXVI")<>"" Then Exit
            \\ "Y" is in top of stack
            Push "CM", "MD", "Q"
            Push "CD", "MD","W"
            Push "XC", "DL", "E"
            Push "XL", "X","R"
            Push "IX","V","T"
            Push "IV","I","Y"
            \\ stack flush to doublerom
            doublerom=[]
            \\  "M" is in top of stack
            Data "M", 1000, "Q",900
            Data "D", 500,"W", 400
            Data "C",100,"E",90
            Data "L",50,"R", 40
            Data "X", 10, "T", 9
            Data "V", 5, "Y", 4, "I",1
            \\ stack flush to singlerom
            singlerom=[]
            acc=0
            value=0
            count=0
            stack doublerom {
                  if empty then exit
                  read rep$,exclude$,cc$
                    i=instr(rom$,cc$)
                  if i >0 then {
                        tmp$=mid$(rom$,i+2)
                        L=Len(tmp$)
                        if L>0 then if Len(filter$(tmp$, exclude$))<>L then Break
                        if Instr(rom$,mid$(rom$,i,1))<i then break
                        insert i,2 rom$=rep$
                  }
                  loop
            }
            rom$=filter$(rom$," ")

            stack singlerom {
                  if empty then exit
                  read cc$, value
                  count=0
                  while left$(rom$,1)=cc$ {
                         insert 1, 1 rom$=""
                         count++
                         acc+=value
                  }
                  if count>3 then Exit
                  loop
            }
            if len(rom$)>0 or count>3 Else {
                  =Str$(acc,1033)
            }
      }
      data "MMMCMXCIX", "LXXIIX", "MMXVII", "LXXIX", "CXCIX","MCMXCIX","MMMDCCCLXXXVIII"
      data "CMXI","M","MCDXLIV","CCCC","IXV", "XLIXL","LXXIIX","IVM"
      data "XXXIX", "XXXX", "XIXX","IVI", "XLIX","XCIX","XCIV","XLVIII","XLCD"
      return
}
RomanNumbers


Με ελληνικές εντολές:

Τμήμα Λατινικοί_Αριθμοί {
      Άδειασε
      Διαμέσου Αρχικοποίηση
      Έγγραφο Εγγ$
      Ενώ όχι κενό
            Διάβασε λατ$
            Τύπωσε λατ$;"=";ΤιμήΛατινικού$(λατ$)
            Εγγ$=λατ$+"="+ΤιμήΛατινικού$(λατ$)+{
            }
      Τέλος Ενώ
      Πρόχειρο Εγγ$
      Τέλος
Αρχικοποίηση:
      Συνάρτηση ΤιμήΛατινικού$(λατ$) {
            Άδειασε
             ="άκυρο"           
            Αν Φίλτρο$(λατ$,"MDCLXVI")<>"" Τότε Έξοδος
            \\ θα μπουν ανάποδα, το τελευταίο πρώτο.
            Βάλε "CM", "MD", "Q","CD", "MD","W", "XC", "DL", "E","XL", "X","R", "IX","V","T", "IV","I","Y"
            διπλό_λατινικό=[]
            \\ θα μπουν με το τελευταίο να είναι τελευταίο.
            Σειρά "M", 1000, "Q",900,"D", 500,"W", 400,"C",100,"E",90, "L",50,"R", 40,"X", 10, "T", 9, "V", 5, "Y", 4, "I",1
            απλό_λατινικό=[]
            σύνολο=0
            μια_τιμή=0
            μετρητής=0
            Σωρός διπλό_λατινικό {
                  Αν κενό Τότε Έξοδος
                  Διάβασε απ$, μη_έγγυροι_χαρακτήρες$,χαρακτ$
                  ι=Θέση(λατ$,χαρακτ$)
                  Αν ι >0 Τότε
                        προσωρινή_τιμή$=Μεσ$(λατ$,ι+2)
                        λ=Μήκος(προσωρινή_τιμή$)
                        Αν λ>0 Τότε Αν Μήκος(Φίλτρο$(προσωρινή_τιμή$, μη_έγγυροι_χαρακτήρες$))<>λ Τότε λατ$="A": Έξοδος
                        Αν Θέση(λατ$,Μεσ$(λατ$,ι,1))<ι Τότε λατ$="A": Έξοδος
                        insert ι, 2 λατ$=απ$ '  2 λέμε αλλα δίνουμε 1 χαρακτήρα και ο μεταφραστής θα βάλει ένα διάστημα
                  Τέλος Αν
                  Κυκλικά
            }
            λατ$=Φίλτρο$(λατ$," ")
            Σωρός απλό_λατινικό {
                  Αν κενό Τότε Έξοδος
                  Διάβασε χαρακτ$, μια_τιμή
                  μετρητής=0
                  Ενώ Αρισ$(λατ$,1)=χαρακτ$
                         Παρεμβολή 1, 1 λατ$=""
                         μετρητής++
                         σύνολο+=μια_τιμή
                  Τέλος Ενώ
                  Αν μετρητής>3 Τότε έξοδος
                  Κυκλικά
            }
            Αν Μήκος(λατ$)>0 ή μετρητής>3 Αλλιώς
            =Γραφή$(σύνολο,1033)
            Τέλος Αν
      }
      Σειρά "MMMCMXCIX", "LXXIIX", "MMXVII", "LXXIX", "CXCIX","MCMXCIX","MMMDCCCLXXXVIII"
      Σειρά "CMXI","M","MCDXLIV","CCCC","IXV", "XLIXL","LXXIIX","IVM"
      Σειρά "XXXIX", "XXXX", "XIXX","IVI", "XLIX","XCIX","XCIV","XLVIII"
      Επιστροφή
}
Λατινικοί_Αριθμοί