tasks a-s

Task/Roman-numerals-Encode/SNOBOL4/roman-numerals-encode-1.sno

@@ -0,0 +1,31 @@
+* ROMAN(N) - Convert integer N to Roman numeral form.
+*
+*  N must be positive and less than 4000.
+*
+*  An asterisk appears in the result if N >= 4000.
+*
+*  The function fails if N is not an integer.
+
+	DEFINE('ROMAN(N)UNITS')              :(ROMAN_END)
+
+*  Get rightmost digit to UNITS and remove it from N.
+*  Return null result if argument is null.
+ROMAN	N RPOS(1) LEN(1) . UNITS =           :F(RETURN)
+
+*  Search for digit, replace with its Roman form.
+*  Return failing if not a digit.
+	'0,1I,2II,3III,4IV,5V,6VI,7VII,8VIII,9IX,'  UNITS
++	BREAK(',') . UNITS                 :F(FRETURN)
+
+*  Convert rest of N and multiply by 10.  Propagate a
+*  failure return from recursive call back to caller.
+	ROMAN = REPLACE(ROMAN(N), 'IVXLCDM', 'XLCDM**')
++	UNITS            :S(RETURN) F(FRETURN)
+ROMAN_END
+
+*	Testing
+	OUTPUT = "1999 = " ROMAN(1999)
+	OUTPUT = "  24 = " ROMAN(24)
+	OUTPUT = " 944 = " ROMAN(944)
+
+END

Task/Roman-numerals-Encode/SNOBOL4/roman-numerals-encode-2.sno

@@ -0,0 +1,29 @@
+*       # Arabic to Roman
+        define('roman(n)s,ch,val,str') :(roman_end)
+roman   roman = ge(n,4000) n :s(return)
+        s = 'M1000 CM900 D500 CD400 C100 XC90 L50 XL40 X10 IX9 V5 IV4 I1 '
+rom1    s span(&ucase) . ch break(' ') . val span(' ') = :f(rom2)
+        str = str dupl(ch,(n / val))
+        n = remdr(n,val) :(rom1)
+rom2    roman = str :(return)
+roman_end
+
+*       # Roman to Arabic
+        define('arabic(n)s,ch,val,sum,x') :(arabic_end)
+arabic  s = 'M1000 D500 C100 L50 X10 V5 I1 '
+        n = reverse(n)
+arab1   n len(1) . ch = :f(arab2)
+        s ch break(' ') . val
+        val = lt(val,x) (-1 * val)
+        sum = sum + val; x = val :(arab1)
+arab2   arabic = sum :(return)
+arabic_end
+
+*       # Test and display
+        tstr = '2010 1999 1492 1066 476 '
+tloop   tstr break(' ') . year span(' ') = :f(out)
+        r = roman(year)
+        rstr = rstr year '=' r ' '
+        astr = astr r '=' arabic(r) ' ' :(tloop)
+out     output = rstr; output = astr
+end