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

Initial data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Task/Roman-numerals-Decode/00-META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Roman_numerals/Decode

14
Task/Roman-numerals-Decode/00-TASK.txt Normal file
View file

@ -0,0 +1,14 @@
;Task:
Create a function that takes a Roman numeral as its argument and returns its value as a numeric decimal integer.
You don't need to validate the form of the Roman numeral.
Modern Roman numerals are written by expressing each decimal digit of the number to be encoded separately,
<br>starting with the leftmost decimal digit and skipping any '''0'''s &nbsp; (zeroes).
'''1990''' is rendered as &nbsp; '''MCMXC''' &nbsp; &nbsp; (1000 = M, &nbsp; 900 = CM, &nbsp; 90 = XC) &nbsp; &nbsp; and
<br>'''2008''' is rendered as &nbsp; '''MMVIII''' &nbsp; &nbsp; &nbsp; (2000 = MM, &nbsp; 8 = VIII).
The Roman numeral for '''1666''', &nbsp; '''MDCLXVI''', &nbsp; uses each letter in descending order.
<br><br>

14
Task/Roman-numerals-Decode/11l/roman-numerals-decode.11l Normal file
View file

@ -0,0 +1,14 @@
V roman_values = [(‘I’, 1), (‘IV’, 4), (‘V’, 5), (‘IX’, 9), (‘X’, 10),
(‘XL’, 40), (‘L’, 50), (‘XC’, 90), (‘C’, 100),
(‘CD’, 400), (‘D’, 500), (‘CM’, 900), (‘M’, 1000)]
F roman_value(=roman)
V total = 0
L(symbol, value) reversed(:roman_values)
L roman.starts_with(symbol)
total += value
roman = roman[symbol.len..]
R total
L(value) [‘MCMXC’, ‘MMVIII’, ‘MDCLXVI’]
print(value‘ = ’roman_value(value))

68
Task/Roman-numerals-Decode/360-Assembly/roman-numerals-decode.360 Normal file
View file

@ -0,0 +1,68 @@
* Roman numerals Decode - 17/04/2019
ROMADEC CSECT
USING ROMADEC,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
SAVE (14,12) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
LA R6,1 i=1
DO WHILE=(C,R6,LE,=A(NV)) do i=1 to hbound(vals)
LR R1,R6 i
SLA R1,3 ~
LA R4,VALS-L'VALS(R1) @vals(i)
MVC X,0(R4) x=vals(i)
SR R9,R9 prev=0
ST R9,Y y=0
LA R7,L'X j=1
DO WHILE=(C,R7,GE,=A(1)) do j=length(x) to 1 by -1
LA R4,X-1 @x
AR R4,R7 +j
MVC C,0(R4) c=substr(x,j,1)
IF CLI,C,NE,C' ' THEN if c^=' ' then
SR R1,R1 r1=0
LA R2,1 k=1
DO WHILE=(C,R2,LE,=A(L'ROMAN)) do k=1 to length(roman)
LA R3,ROMAN-1 @roman
AR R3,R2 +k
IF CLC,0(L'C,R3),EQ,C THEN if substr(roman,k,1)=c
LR R1,R2 index=k
B REINDEX leave k
ENDIF , endif
LA R2,1(R2) k=k+1
ENDDO , enddo k
REINDEX EQU * r1=index(roman,c)
SLA R1,2 ~
L R8,DECIM-4(R1) n=decim(index(roman,c))
IF CR,R8,LT,R9 THEN if n<prev then
LCR R8,R8 n=-n
ENDIF , endif
L R2,Y y
AR R2,R8 +n
ST R2,Y y=y+n
LR R9,R8 prev=n
ENDIF , endif
BCTR R7,0 j--
ENDDO , enddo j
MVC PG(8),X x
L R1,Y y
XDECO R1,XDEC edit y
MVC PG+12(4),XDEC+8 output y
XPRNT PG,L'PG print buffer
LA R6,1(R6) i++
ENDDO , enddo i
L R13,4(0,R13) restore previous savearea pointer
RETURN (14,12),RC=0 restore registers from calling sav
NV EQU (X-VALS)/L'VALS
ROMAN DC CL7'MDCLXVI'
DECIM DC F'1000',F'500',F'100',F'50',F'10',F'5',F'1'
VALS DC CL8'XIV',CL8'CMI',CL8'MIC',CL8'MCMXC',CL8'MDCLXVI'
DC CL8'MMVIII',CL8'MMXIX',CL8'MMMCMXCV'
X DS CL(L'VALS)
Y DS F
C DS CL1
PG DC CL80'........ -> ....'
XDEC DS CL12
REGEQU
END ROMADEC

110
Task/Roman-numerals-Decode/8080-Assembly/roman-numerals-decode.8080 Normal file
View file

@ -0,0 +1,110 @@
org 100h
jmp test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Takes a zero-terminated Roman numeral string in BC
;; and returns 16-bit integer in HL.
;; All registers destroyed.
roman: dcx b
romanfindend: inx b ; load next character
ldax b
inr e
ana a ; are we there yet
jnz romanfindend
lxi h,0 ; zero HL to hold the total
push h ; stack holds the previous roman numeral
romanloop: dcx b ; get next roman numeral
ldax b ; (work backwards)
call romandgt
jc romandone ; carry set = not Roman anymore
xthl ; load previous roman numeral
call cmpdehl ; DE < HL?
mov h,d ; in any case, DE is now the previous
mov l,e ; Roman numeral
xthl ; bring back the total
jnc romanadd
mov a,d ; DE (current) < HL (previous)
cma ; so this Roman digit must be subtracted
mov d,a ; from the total.
mov a,e ; so we negate it before adding it
cma ; two's complement: -de = (~de)+1
mov e,a
inx d
romanadd: dad d ; add to running total
jmp romanloop
romandone: pop d ; remove temporary variable from stack
ret
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 16-bit compare DE with HL, set flags
;; accordingly. A destroyed.
cmpdehl: mov a,d
cmp h
rnz
mov a,e
cmp l
ret
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Takes a single Roman 'digit' in A,
;; and returns its value in DE (0 if invalid)
;; All other registers preserved.
romandgt: push h ; preserve hl for the caller
lxi h,romantab
mvi e,7 ; e=counter
romandgtl: cmp m ; check table entry
jz romanfound
inx h ; move to next table entry
inx h
inx h
dcr e ; decrease counter
jnz romandgtl
pop h ; we didn't find it
stc ; set carry
ret ; return with DE=0
romanfound: inx h ; we did find it
mov e,m ; load it into DE
inx h
mov d,m
pop h
ana a ; clear carry
ret
romantab: db 'I',1,0 ; 16-bit little endian values
db 'V',5,0
db 'X',10,0
db 'L',50,0
db 'C',100,0
db 'D',0f4h,1
db 'M',0e8h,3
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The following is testing and I/O code.
test: mvi c,10 ; read string from console
lxi d,bufdef
call 5
mvi c,9 ; print newline
lxi d,nl
call 5
lxi b,buf ; run `roman' on the input string
call roman ; the result is now in hl
lxi d,-10000
call numout ; print 10000s digit
lxi d,-1000
call numout ; print 1000s digit
lxi d,-100
call numout ; print 100s digit
lxi d,-10
call numout ; print 10s digit
lxi d,-1 ; ...print 1s digit
numout: mvi a,-1
push h
numloop: inr a
pop b
push h
dad d
jc numloop
adi '0'
mvi c,2
mov e,a
call 5
pop h
ret
nl: db 13,10,'$'
bufdef: db 16,0
buf: ds 17

48
Task/Roman-numerals-Decode/ALGOL-68/roman-numerals-decode.alg Normal file
View file

@ -0,0 +1,48 @@
PROC roman to int = (STRING roman) INT:
BEGIN
PROC roman digit value = (CHAR roman digit) INT:
(roman digit = "M" | 1000 |:
roman digit = "D" | 500 |:
roman digit = "C" | 100 |:
roman digit = "L" | 50 |:
roman digit = "X" | 10 |:
roman digit = "V" | 5 |:
roman digit = "I" | 1);
INT result := 0, previous value := 0, run := 0;
FOR i FROM LWB roman TO UPB roman
DO
INT value = roman digit value(roman[i]);
IF previous value = value THEN
run +:= value
ELSE
IF previous value < value THEN
result -:= run
ELSE
result +:= run
FI;
run := previous value := value
FI
OD;
result +:= run
END;
MODE TEST = STRUCT (STRING input, INT expected output);
[] TEST roman test = (
("MMXI", 2011), ("MIM", 1999),
("MCMLVI", 1956), ("MDCLXVI", 1666),
("XXCIII", 83), ("LXXIIX", 78),
("IIIIX", 6)
);
print(("Test input Value Got", newline, "--------------------------", newline));
FOR i FROM LWB roman test TO UPB roman test
DO
INT output = roman to int(input OF roman test[i]);
printf(($g, n (12 - UPB input OF roman test[i]) x$, input OF roman test[i]));
printf(($g(5), 1x, g(5), 1x$, expected output OF roman test[i], output));
printf(($b("ok", "not ok"), 1l$, output = expected output OF roman test[i]))
OD

95
Task/Roman-numerals-Decode/ALGOL-W/roman-numerals-decode.alg Normal file
View file

@ -0,0 +1,95 @@
begin
% decodes a roman numeral into an integer %
% there must be at least one blank after the numeral %
% This takes a lenient view on roman numbers so e.g. IIXX is 18 - see %
% the Discussion %
integer procedure romanToDecimal ( string(32) value roman ) ;
begin
integer decimal, rPos, currDigit, nextDigit, seqValue;
string(1) rDigit;
% the roman number is a sequence of sequences of roman digits %
% if the previous sequence is of higher value digits than the next, %
% the higher value is added to the overall value %
% if the previous seequence is of lower value, it is subtracted %
% e.g. MCMLXII %
% the sequences are M, C, M, X, II %
% M is added, C subtracted, M added, X added and II added %
% get the value of a sequence of roman digits %
integer procedure getSequence ;
if rDigit = " " then begin
% end of the number %
0
end
else begin
% have another sequence %
integer sValue;
sValue := 0;
while roman( rPos // 1 ) = rDigit do begin
sValue := sValue + currDigit;
rPos := rPos + 1;
end while_have_same_digit ;
% remember the next digit %
rDigit := roman( rPos // 1 );
% result is the sequence value %
sValue
end getSequence ;
% convert a roman digit into its decimal equivalent %
% an invalid digit will terminate the program, " " is 0 %
integer procedure getValue( string(1) value romanDigit ) ;
if romanDigit = "m" or romanDigit = "M" then 1000
else if romanDigit = "d" or romanDigit = "D" then 500
else if romanDigit = "c" or romanDigit = "C" then 100
else if romanDigit = "l" or romanDigit = "L" then 50
else if romanDigit = "x" or romanDigit = "X" then 10
else if romanDigit = "v" or romanDigit = "V" then 5
else if romanDigit = "i" or romanDigit = "I" then 1
else if romanDigit = " " then 0
else begin
write( s_w := 0, "Invalid roman digit: """, romanDigit, """" );
assert false;
0
end getValue ;
% get the first sequence %
decimal := 0;
rPos := 0;
rDigit := roman( rPos // 1 );
currDigit := getValue( rDigit );
seqValue := getSequence;
% handle the sequences %
while rDigit not = " " do begin
% have another sequence %
nextDigit := getValue( rDigit );
if currDigit < nextDigit
then % prev digit is lower % decimal := decimal - seqValue
else % prev digit is higher % decimal := decimal + seqValue
;
currDigit := nextDigit;
seqValue := getSequence;
end while_have_a_roman_digit ;
% add the final sequence %
decimal + seqValue
end roman ;
% test the romanToDecimal routine %
procedure testRoman ( string(32) value romanNumber ) ;
write( i_w := 5, romanNumber, romanToDecimal( romanNumber ) );
testRoman( "I" ); testRoman( "II" );
testRoman( "III" ); testRoman( "IV" );
testRoman( "V" ); testRoman( "VI" );
testRoman( "VII" ); testRoman( "VIII" );
testRoman( "IX" ); testRoman( "IIXX" );
testRoman( "XIX" ); testRoman( "XX" );
write( "..." );
testRoman( "MCMXC" );
testRoman( "MMVIII" );
testRoman( "MDCLXVI" );
end.

39
Task/Roman-numerals-Decode/ANTLR/roman-numerals-decode.antlr Normal file
View file

@ -0,0 +1,39 @@
/* Parse Roman Numerals
Nigel Galloway March 16th., 2012
*/
grammar ParseRN ;
options {
language = Java;
}
@members {
int rnValue;
int ONE;
}
parseRN: ({rnValue = 0;} rn NEWLINE {System.out.println($rn.text + " = " + rnValue);})*
;
rn : (Thousand {rnValue += 1000;})* hundreds? tens? units?;
hundreds: {ONE = 0;} (h9 | h5) {if (ONE > 3) System.out.println ("Too many hundreds");};
h9 : Hundred {ONE += 1;} (FiveHund {rnValue += 400;}| Thousand {rnValue += 900;}|{rnValue += 100;} (Hundred {rnValue += 100; ONE += 1;})*);
h5 : FiveHund {rnValue += 500;} (Hundred {rnValue += 100; ONE += 1;})*;
tens : {ONE = 0;} (t9 | t5) {if (ONE > 3) System.out.println ("Too many tens");};
t9 : Ten {ONE += 1;} (Fifty {rnValue += 40;}| Hundred {rnValue += 90;}|{rnValue += 10;} (Ten {rnValue += 10; ONE += 1;})*);
t5 : Fifty {rnValue += 50;} (Ten {rnValue += 10; ONE += 1;})*;
units : {ONE = 0;} (u9 | u5) {if (ONE > 3) System.out.println ("Too many ones");};
u9 : One {ONE += 1;} (Five {rnValue += 4;}| Ten {rnValue += 9;}|{rnValue += 1;} (One {rnValue += 1; ONE += 1;})*);
u5 : Five {rnValue += 5;} (One {rnValue += 1; ONE += 1;})*;
One : 'I';
Five : 'V';
Ten : 'X';
Fifty : 'L';
Hundred: 'C';
FiveHund: 'D';
Thousand: 'M' ;
NEWLINE: '\r'? '\n' ;

7
Task/Roman-numerals-Decode/APL/roman-numerals-decode.apl Normal file
View file

@ -0,0 +1,7 @@
fromRoman←{
rmn←(⎕A,⎕A,'*')[(⎕A,⎕UCS 96+⍳26)⍳⍵] ⍝ make input uppercase
dgt←↑'IVXLCDM' (1 5 10 50 100 500 1000) ⍝ values of roman digits
~rmn∧.∊⊂dgt[1;]:⎕SIGNAL 11 ⍝ domain error if non-roman input
map←dgt[2;dgt[1;]⍳rmn] ⍝ map digits to values
+/map×1-2×(2</map),0 ⍝ subtractive principle
}

23
Task/Roman-numerals-Decode/AWK/roman-numerals-decode.awk Normal file
View file

@ -0,0 +1,23 @@
# syntax: GAWK -f ROMAN_NUMERALS_DECODE.AWK
BEGIN {
leng = split("MCMXC MMVIII MDCLXVI",arr," ")
for (i=1; i<=leng; i++) {
n = arr[i]
printf("%s = %s\n",n,roman2arabic(n))
}
exit(0)
}
function roman2arabic(r, a,i,p,q,u,ua,una,unr) {
r = toupper(r)
unr = "MDCLXVI" # each Roman numeral in descending order
una = "1000 500 100 50 10 5 1" # and its Arabic equivalent
split(una,ua," ")
i = split(r,u,"")
a = ua[index(unr,u[i])]
while (--i) {
p = index(unr,u[i])
q = index(unr,u[i+1])
a += ua[p] * ((p>q) ? -1 : 1)
}
return( (a>0) ? a : "" )
}

43
Task/Roman-numerals-Decode/Action-/roman-numerals-decode.action Normal file
View file

@ -0,0 +1,43 @@
CARD FUNC DecodeRomanDigit(CHAR c)
IF c='I THEN RETURN (1)
ELSEIF c='V THEN RETURN (5)
ELSEIF c='X THEN RETURN (10)
ELSEIF c='L THEN RETURN (50)
ELSEIF c='C THEN RETURN (100)
ELSEIF c='D THEN RETURN (500)
ELSEIF c='M THEN RETURN (1000)
FI
RETURN (0)
CARD FUNC DecodeRomanNumber(CHAR ARRAY s)
CARD res,curr,prev
BYTE i
res=0 prev=0 i=s(0)
WHILE i>0
DO
curr=DecodeRomanDigit(s(i))
IF curr<prev THEN
res==-curr
ELSE
res==+curr
FI
prev=curr
i==-1
OD
RETURN (res)
PROC Test(CHAR ARRAY s)
CARD n
n=DecodeRomanNumber(s)
PrintF("%S=%U%E",s,n)
RETURN
PROC Main()
Test("MCMXC")
Test("MMVIII")
Test("MDCLXVI")
Test("MMMDCCCLXXXVIII")
Test("MMMCMXCIX")
RETURN

151
Task/Roman-numerals-Decode/Ada/roman-numerals-decode.ada Normal file
View file

@ -0,0 +1,151 @@
Pragma Ada_2012;
Pragma Assertion_Policy( Check );
With
Unchecked_Conversion,
Ada.Text_IO;
Procedure Test_Roman_Numerals is
-- We create an enumeration of valid characters, note that they are
-- character-literals, this is so that we can use literal-strings,
-- and that their size is that of Integer.
Type Roman_Digits is ('I', 'V', 'X', 'L', 'C', 'D', 'M' )
with Size => Integer'Size;
-- We use a representation-clause ensure the proper integral-value
-- of each individual character.
For Roman_Digits use
(
'I' => 1,
'V' => 5,
'X' => 10,
'L' => 50,
'C' => 100,
'D' => 500,
'M' => 1000
);
-- To convert a Roman_Digit to an integer, we now only need to
-- read its value as an integer.
Function Convert is new Unchecked_Conversion
( Source => Roman_Digits, Target => Integer );
-- Romena_Numeral is a string of Roman_Digit.
Type Roman_Numeral is array (Positive range <>) of Roman_Digits;
-- The Numeral_List type is used herein only for testing
-- and verification-data.
Type Numeral_List is array (Positive range <>) of
not null access Roman_Numeral;
-- The Test_Cases subtype ensures that Test_Data and Validation_Data
-- both contain the same number of elements, and that the indecies
-- are the same; essentially the same as:
--
-- pragma Assert( Test_Data'Length = Validation_Data'Length
-- AND Test_Data'First = Validation_Data'First);
subtype Test_Cases is Positive range 1..14;
Test_Data : constant Numeral_List(Test_Cases):=
(
New Roman_Numeral'("III"), -- 3
New Roman_Numeral'("XXX"), -- 30
New Roman_Numeral'("CCC"), -- 300
New Roman_Numeral'("MMM"), -- 3000
New Roman_Numeral'("VII"), -- 7
New Roman_Numeral'("LXVI"), -- 66
New Roman_Numeral'("CL"), -- 150
New Roman_Numeral'("MCC"), -- 1200
New Roman_Numeral'("IV"), -- 4
New Roman_Numeral'("IX"), -- 9
New Roman_Numeral'("XC"), -- 90
New Roman_Numeral'("ICM"), -- 901
New Roman_Numeral'("CIM"), -- 899
New Roman_Numeral'("MDCLXVI") -- 1666
);
Validation_Data : constant array(Test_Cases) of Natural:=
( 3, 30, 300, 3000,
7, 66, 150, 1200,
4, 9, 90,
901, 899,
1666
);
-- In Roman numerals, the subtractive form [IV = 4] was used
-- very infrequently, the most common form was the addidive
-- form [IV = 6]. (Consider military logistics and squads.)
-- SUM returns the Number, read in the additive form.
Function Sum( Number : Roman_Numeral ) return Natural is
begin
Return Result : Natural:= 0 do
For Item of Number loop
Result:= Result + Convert( Item );
end loop;
End Return;
end Sum;
-- EVAL returns Number read in the subtractive form.
Function Eval( Number : Roman_Numeral ) return Natural is
Current : Roman_Digits:= 'I';
begin
Return Result : Natural:= 0 do
For Item of Number loop
if Current < Item then
Result:= Convert(Item) - Result;
Current:= Item;
else
Result:= Result + Convert(Item);
end if;
end loop;
End Return;
end Eval;
-- Display the given Roman_Numeral via Text_IO.
Procedure Put( S: Roman_Numeral ) is
begin
For Ch of S loop
declare
-- The 'Image attribute returns the character inside
-- single-quotes; so we select the character itself.
C : Character renames Roman_Digits'Image(Ch)(2);
begin
Ada.Text_IO.Put( C );
end;
end loop;
end;
-- This displays pass/fail dependant on the parameter.
Function PF ( Value : Boolean ) Return String is
begin
Return Result : String(1..4):= ( if Value then"pass"else"fail" );
End PF;
Begin
Ada.Text_IO.Put_Line("Starting Test:");
for Index in Test_Data'Range loop
declare
Item : Roman_Numeral renames Test_Data(Index).all;
Value : constant Natural := Eval(Item);
begin
Put( Item );
Ada.Text_IO.Put( ASCII.HT & "= ");
Ada.Text_IO.Put( Value'Img );
Ada.Text_IO.Put_Line( ASCII.HT & '[' &
PF( Value = Validation_Data(Index) )& ']');
end;
end loop;
Ada.Text_IO.Put_Line("Testing complete.");
End Test_Roman_Numerals;

175
Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-1.applescript Normal file
View file

@ -0,0 +1,175 @@
------------- INTEGER VALUE OF A ROMAN STRING ------------
-- romanValue :: String -> Int
on romanValue(s)
script roman
property mapping : [["M", 1000], ["CM", 900], ["D", 500], ["CD", 400], ¬
["C", 100], ["XC", 90], ["L", 50], ["XL", 40], ["X", 10], ["IX", 9], ¬
["V", 5], ["IV", 4], ["I", 1]]
-- Value of first Roman glyph + value of remaining glyphs
-- toArabic :: [Char] -> Int
on toArabic(xs)
-- transcribe :: (String, Number) -> Maybe (Number, [String])
script transcribe
on |λ|(pair)
set {r, v} to pair
if isPrefixOf(characters of r, xs) then
-- Value of this matching glyph, with any remaining glyphs
{v, drop(length of r, xs)}
else
{}
end if
end |λ|
end script
if 0 < length of xs then
set parsed to concatMap(transcribe, mapping)
(item 1 of parsed) + toArabic(item 2 of parsed)
else
0
end if
end toArabic
end script
toArabic(characters of s) of roman
end romanValue
--------------------------- TEST -------------------------
on run
map(romanValue, {"MCMXC", "MDCLXVI", "MMVIII"})
--> {1990, 1666, 2008}
end run
-------------------- GENERIC FUNCTIONS -------------------
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lng to length of xs
set acc to {}
tell mReturn(f)
repeat with i from 1 to lng
set acc to acc & (|λ|(item i of xs, i, xs))
end repeat
end tell
if {text, string} contains class of xs then
acc as text
else
acc
end if
end concatMap
-- drop :: Int -> [a] -> [a]
-- drop :: Int -> String -> String
on drop(n, xs)
set c to class of xs
if script is not c then
if string is not c then
if n < length of xs then
items (1 + n) thru -1 of xs
else
{}
end if
else
if n < length of xs then
text (1 + n) thru -1 of xs
else
""
end if
end if
else
take(n, xs) -- consumed
return xs
end if
end drop
-- isPrefixOf :: [a] -> [a] -> Bool
-- isPrefixOf :: String -> String -> Bool
on isPrefixOf(xs, ys)
-- isPrefixOf takes two lists or strings and returns
-- true if and only if the first is a prefix of the second.
script go
on |λ|(xs, ys)
set intX to length of xs
if intX < 1 then
true
else if intX > length of ys then
false
else if class of xs is string then
(offset of xs in ys) = 1
else
set {xxt, yyt} to {uncons(xs), uncons(ys)}
((item 1 of xxt) = (item 1 of yyt)) and ¬
|λ|(item 2 of xxt, item 2 of yyt)
end if
end |λ|
end script
go's |λ|(xs, ys)
end isPrefixOf
-- length :: [a] -> Int
on |length|(xs)
set c to class of xs
if list is c or string is c then
length of xs
else
(2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
end if
end |length|
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- uncons :: [a] -> Maybe (a, [a])
on uncons(xs)
set lng to |length|(xs)
if 0 = lng then
missing value
else
if (2 ^ 29 - 1) as integer > lng then
if class of xs is string then
set cs to text items of xs
{item 1 of cs, rest of cs}
else
{item 1 of xs, rest of xs}
end if
else
set nxt to take(1, xs)
if {} is nxt then
missing value
else
{item 1 of nxt, xs}
end if
end if
end if
end uncons

1
Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-2.applescript Normal file
View file

@ -0,0 +1 @@
{1990, 1666, 2008}

110
Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-3.applescript Normal file
View file

@ -0,0 +1,110 @@
use framework "Foundation"
----------- INTEGER VALUE OF ROMAN NUMBER STRING ---------
-- fromRoman :: String -> Int
on fromRoman(s)
script subtractIfLower
on |λ|(l, rn)
set {r, n} to rn
if l ≥ r then -- Digit values that increase (L to R),
{l, n + l} -- (added)
else
{l, n - l} -- Digit values that go down: subtracted.
end if
end |λ|
end script
item 2 of foldr(subtractIfLower, {0, 0}, ¬
map(my charVal, characters of s))
end fromRoman
-- charVal :: Char -> Int
on charVal(C)
set v to lookup(toUpper(C), ¬
{I:1, |V|:5, X:10, |L|:50, C:100, D:500, M:1000})
if missing value is v then
0
else
v
end if
end charVal
--------------------------- TEST -------------------------
on run
map(fromRoman, ¬
{"MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXXI"})
--> {1666, 1990, 2008, 2016, 2021}
end run
-------------------- GENERIC FUNCTIONS -------------------
-- foldr :: (a -> b -> b) -> b -> [a] -> b
on foldr(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with I from lng to 1 by -1
set v to |λ|(item I of xs, v)
end repeat
return v
end tell
end foldr
-- lookup :: a -> Dict -> Maybe b
on lookup(k, dct)
-- Just the value of k in the dictionary,
-- or missing value if k is not found.
set ca to current application
set v to (ca's NSDictionary's dictionaryWithDictionary:dct)'s ¬
objectForKey:k
if missing value ≠ v then
item 1 of ((ca's NSArray's arrayWithObject:v) as list)
else
missing value
end if
end lookup
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
-- The list obtained by applying f
-- to each element of xs.
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with I from 1 to lng
set end of lst to |λ|(item I of xs, I, xs)
end repeat
return lst
end tell
end map
-- Lift 2nd class handler function into 1st class
-- script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- toUpper :: String -> String
on toUpper(str)
tell current application
((its (NSString's stringWithString:(str)))'s ¬
uppercaseStringWithLocale:¬
(its NSLocale's currentLocale())) as text
end tell
end toUpper

1
Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-4.applescript Normal file
View file

@ -0,0 +1 @@
{1666, 1990, 2008, 2016, 2021}

32
Task/Roman-numerals-Decode/Applesoft-BASIC/roman-numerals-decode.basic Normal file
View file

@ -0,0 +1,32 @@
10 LET R$ = "MCMXCIX"
20 GOSUB 100 PRINT "ROMAN NUMERALS DECODED"
30 LET R$ = "MMXII"
40 GOSUB 100
50 LET R$ = "MDCLXVI"
60 GOSUB 100
70 LET R$ = "MMMDCCCLXXXVIII"
80 GOSUB 100
90 END
100 PRINT M$R$,
110 LET M$ = CHR$ (13)
120 GOSUB 150"ROMAN NUMERALS DECODE given R$"
130 PRINT N;
140 RETURN
150 IF NOT C THEN GOSUB 250INITIALIZE
160 LET J = 0
170 LET N = 0
180 FOR I = LEN (R$) TO 1 STEP - 1
190 LET P = J
200 FOR J = 1 TO C
210 IF MID$ (C$,J,1) < > MID$ (R$,I,1) THEN NEXT J
220 IF J < = C THEN N = N + R(J) * ((J > = P) * 2 - 1)
230 NEXT I
240 RETURN
250 READ C$
260 LET C = LEN (C$)
270 DIM R(C)
280 FOR I = 0 TO C
290 READ R(I)
300 NEXT I
310 RETURN
320 DATA "IVXLCDM",0,1,5,10,50,100,500,1000

17
Task/Roman-numerals-Decode/Arturo/roman-numerals-decode.arturo Normal file
View file

@ -0,0 +1,17 @@
syms: #[ M: 1000, D: 500, C: 100, L: 50, X: 10, V: 5, I: 1 ]
fromRoman: function [roman][
ret: 0
loop 0..(size roman)-2 'ch [
fst: roman\[ch]
snd: roman\[ch+1]
valueA: syms\[fst]
valueB: syms\[snd]
if? valueA < valueB -> ret: ret - valueA
else -> ret: ret + valueA
]
return ret + syms\[last roman]
]
loop ["MCMXC" "MMVIII" "MDCLXVI"] 'r -> print [r "->" fromRoman r]

16
Task/Roman-numerals-Decode/AutoHotkey/roman-numerals-decode.ahk Normal file
View file

@ -0,0 +1,16 @@
Roman_Decode(str){
res := 0
Loop Parse, str
{
n := {M: 1000, D:500, C:100, L:50, X:10, V:5, I:1}[A_LoopField]
If ( n > OldN ) && OldN
res -= 2*OldN
res += n, oldN := n
}
return res
}
test = MCMXC|MMVIII|MDCLXVI
Loop Parse, test, |
res .= A_LoopField "`t= " Roman_Decode(A_LoopField) "`r`n"
clipboard := res

27
Task/Roman-numerals-Decode/BASIC256/roman-numerals-decode.basic Normal file
View file

@ -0,0 +1,27 @@
function romToDec (roman$)
num = 0
prenum = 0
for i = length(roman$) to 1 step -1
x$ = mid(roman$, i, 1)
n = 0
if x$ = "M" then n = 1000
if x$ = "D" then n = 500
if x$ = "C" then n = 100
if x$ = "L" then n = 50
if x$ = "X" then n = 10
if x$ = "V" then n = 5
if x$ = "I" then n = 1
if n < preNum then num -= n else num += n
preNum = n
next i
return num
end function
#Testing
print "MCMXCIX = "; romToDec("MCMXCIX") #1999
print "MDCLXVI = "; romToDec("MDCLXVI") #1666
print "XXV = "; romToDec("XXV") #25
print "CMLIV = "; romToDec("CMLIV") #954
print "MMXI = "; romToDec("MMXI") #2011

16
Task/Roman-numerals-Decode/BBC-BASIC/roman-numerals-decode.basic Normal file
View file

@ -0,0 +1,16 @@
PRINT "MCMXCIX", FNromandecode("MCMXCIX")
PRINT "MMXII", FNromandecode("MMXII")
PRINT "MDCLXVI", FNromandecode("MDCLXVI")
PRINT "MMMDCCCLXXXVIII", FNromandecode("MMMDCCCLXXXVIII")
END
DEF FNromandecode(roman$)
LOCAL i%, j%, p%, n%, r%()
DIM r%(7) : r%() = 0,1,5,10,50,100,500,1000
FOR i% = LEN(roman$) TO 1 STEP -1
j% = INSTR("IVXLCDM", MID$(roman$,i%,1))
IF j%=0 ERROR 100, "Invalid character"
IF j%>=p% n% += r%(j%) ELSE n% -= r%(j%)
p% = j%
NEXT
= n%

29
Task/Roman-numerals-Decode/BCPL/roman-numerals-decode.bcpl Normal file
View file

@ -0,0 +1,29 @@
get "libhdr"
let roman(s) = valof
$( let digit(ch) = valof
$( let ds = table 'm','d','c','l','x','v','i'
let vs = table 1000,500,100,50,10,5,1
for i=0 to 6
if ds!i=(ch|32) then resultis vs!i
resultis 0
$)
let acc = 0
for i=1 to s%0
$( let d = digit(s%i)
if d=0 then resultis 0
test i<s%0 & d<digit(s%(i+1))
do acc := acc-d
or acc := acc+d
$)
resultis acc
$)
let show(s) be writef("%S: %N*N", s, roman(s))
let start() be
$( show("MCMXC")
show("MDCLXVI")
show("MMVII")
show("MMXXI")
$)

5
Task/Roman-numerals-Decode/BQN/roman-numerals-decode-1.bqn Normal file
View file

@ -0,0 +1,5 @@
⟨ToArabic⇐A⟩ ← {
c ← "IVXLCDM" # Characters
v ← ⥊ (10⋆↕4) ×⌜ 1‿5 # Their values
A ⇐ +´∘(⊢ׯ1⋆<⟜«) v ⊏˜ c ⊐ ⊢
}

2
Task/Roman-numerals-Decode/BQN/roman-numerals-decode-2.bqn Normal file
View file

@ -0,0 +1,2 @@
ToArabic¨ "MCMXC"‿"MDCLXVI"‿"MMVII"‿"MMXXI"
⟨ 1990 1666 2007 2021 ⟩

45
Task/Roman-numerals-Decode/Batch-File/roman-numerals-decode.bat Normal file
View file

@ -0,0 +1,45 @@
@echo off
setlocal enabledelayedexpansion
::Testing...
call :toArabic MCMXC
echo MCMXC = !arabic!
call :toArabic MMVIII
echo MMVIII = !arabic!
call :toArabic MDCLXVI
echo MDCLXVI = !arabic!
call :toArabic CDXLIV
echo CDXLIV = !arabic!
call :toArabic XCIX
echo XCIX = !arabic!
pause>nul
exit/b 0
::The "function"...
:toArabic
set roman=%1
set arabic=
set lastval=
%== Alternative for counting the string length ==%
set leng=-1
for /l %%. in (0,1,1000) do set/a leng+=1&if "!roman:~%%.,1!"=="" goto break
:break
set /a last=!leng!-1
for /l %%i in (!last!,-1,0) do (
set n=0
if /i "!roman:~%%i,1!"=="M" set n=1000
if /i "!roman:~%%i,1!"=="D" set n=500
if /i "!roman:~%%i,1!"=="C" set n=100
if /i "!roman:~%%i,1!"=="L" set n=50
if /i "!roman:~%%i,1!"=="X" set n=10
if /i "!roman:~%%i,1!"=="V" set n=5
if /i "!roman:~%%i,1!"=="I" set n=1
if !n! lss !lastval! (
set /a arabic-=n
) else (
set /a arabic+=n
)
set lastval=!n!
)
goto :EOF

40
Task/Roman-numerals-Decode/Bracmat/roman-numerals-decode.bracmat Normal file
View file

@ -0,0 +1,40 @@
( unroman
= nbr,lastVal,val
. 0:?nbr:?lastVal
& @( low$!arg
: ?
%@?L
( ?
& (m.1000)
(d.500)
(c.100)
(l.50)
(x.10)
(v.5)
(i.1)
: ? (!L.?val) ?
& (!val:~>!lastVal|!val+-2*!lastVal)
+ !nbr
: ?nbr
& !val:?lastVal
& ~
)
)
| !nbr
)
& (M.1000)
(MCXI.1111)
(CMXI.911)
(MCM.1900)
(MCMXC.1990)
(MMVIII.2008)
(MMIX.2009)
(MCDXLIV.1444)
(MDCLXVI.1666)
(MMXII.2012)
: ?years
& (test=.out$(!arg unroman$!arg))
& ( !years
: ? (?L.?D) (?&test$!L&~)
| done
);

50
Task/Roman-numerals-Decode/C++/roman-numerals-decode.cpp Normal file
View file

@ -0,0 +1,50 @@
#include <exception>
#include <string>
#include <iostream>
using namespace std;
namespace Roman
{
int ToInt(char c)
{
switch (c)
{
case 'I': return 1;
case 'V': return 5;
case 'X': return 10;
case 'L': return 50;
case 'C': return 100;
case 'D': return 500;
case 'M': return 1000;
}
throw exception("Invalid character");
}
int ToInt(const string& s)
{
int retval = 0, pvs = 0;
for (auto pc = s.rbegin(); pc != s.rend(); ++pc)
{
const int inc = ToInt(*pc);
retval += inc < pvs ? -inc : inc;
pvs = inc;
}
return retval;
}
}
int main(int argc, char* argv[])
{
try
{
cout << "MCMXC = " << Roman::ToInt("MCMXC") << "\n";
cout << "MMVIII = " << Roman::ToInt("MMVIII") << "\n";
cout << "MDCLXVI = " << Roman::ToInt("MDCLXVI") << "\n";
}
catch (exception& e)
{
cerr << e.what();
return -1;
}
return 0;
}

62
Task/Roman-numerals-Decode/C-sharp/roman-numerals-decode.cs Normal file
View file

@ -0,0 +1,62 @@
using System;
using System.Collections.Generic;
namespace Roman
{
internal class Program
{
private static void Main(string[] args)
{
// Decode and print the numerals.
Console.WriteLine("{0}: {1}", "MCMXC", Decode("MCMXC"));
Console.WriteLine("{0}: {1}", "MMVIII", Decode("MMVIII"));
Console.WriteLine("{0}: {1}", "MDCLXVI", Decode("MDCLXVI"));
}
// Dictionary to hold our numerals and their values.
private static readonly Dictionary<char, int> RomanDictionary = new Dictionary<char, int>
{
{'I', 1},
{'V', 5},
{'X', 10},
{'L', 50},
{'C', 100},
{'D', 500},
{'M', 1000}
};
private static int Decode(string roman)
{
/* Make the input string upper-case,
* because the dictionary doesn't support lower-case characters. */
roman = roman.ToUpper();
/* total = the current total value that will be returned.
* minus = value to subtract from next numeral. */
int total = 0, minus = 0;
for (int i = 0; i < roman.Length; i++) // Iterate through characters.
{
// Get the value for the current numeral. Takes subtraction into account.
int thisNumeral = RomanDictionary[roman[i]] - minus;
/* Checks if this is the last character in the string, or if the current numeral
* is greater than or equal to the next numeral. If so, we will reset our minus
* variable and add the current numeral to the total value. Otherwise, we will
* subtract the current numeral from the next numeral, and continue. */
if (i >= roman.Length - 1 ||
thisNumeral + minus >= RomanDictionary[roman[i + 1]])
{
total += thisNumeral;
minus = 0;
}
else
{
minus = thisNumeral;
}
}
return total; // Return the total.
}
}
}

47
Task/Roman-numerals-Decode/C/roman-numerals-decode.c Normal file
View file

@ -0,0 +1,47 @@
#include <stdio.h>
int digits[26] = { 0, 0, 100, 500, 0, 0, 0, 0, 1, 1, 0, 50, 1000, 0, 0, 0, 0, 0, 0, 0, 5, 5, 0, 10, 0, 0 };
/* assuming ASCII, do upper case and get index in alphabet. could also be
inline int VALUE(char x) { return digits [ (~0x20 & x) - 'A' ]; }
if you think macros are evil */
#define VALUE(x) digits[(~0x20 & (x)) - 'A']
int decode(const char * roman)
{
const char *bigger;
int current;
int arabic = 0;
while (*roman != '\0') {
current = VALUE(*roman);
/* if (!current) return -1;
note: -1 can be used as error code; Romans didn't even have zero
*/
bigger = roman;
/* look for a larger digit, like IV or XM */
while (VALUE(*bigger) <= current && *++bigger != '\0');
if (*bigger == '\0')
arabic += current;
else {
arabic += VALUE(*bigger);
while (roman < bigger)
arabic -= VALUE(* (roman++) );
}
roman ++;
}
return arabic;
}
int main()
{
const char * romans[] = { "MCmxC", "MMVIII", "MDClXVI", "MCXLUJ" };
int i;
for (i = 0; i < 4; i++)
printf("%s\t%d\n", romans[i], decode(romans[i]));
return 0;
}

42
Task/Roman-numerals-Decode/CLU/roman-numerals-decode.clu Normal file
View file

@ -0,0 +1,42 @@
roman = cluster is decode
rep = null
digit_value = proc (c: char) returns (int) signals (invalid)
if c < 'a' then c := char$i2c(char$c2i(c) + 32) end
if c = 'm' then return(1000)
elseif c = 'd' then return(500)
elseif c = 'c' then return(100)
elseif c = 'l' then return(50)
elseif c = 'x' then return(10)
elseif c = 'v' then return(5)
elseif c = 'i' then return(1)
else signal invalid
end
end digit_value
decode = proc (s: string) returns (int) signals (invalid)
acc: int := 0
for i: int in int$from_to(1, string$size(s)) do
d: int := digit_value(s[i])
if i < string$size(s) cand d < digit_value(s[i+1]) then
acc := acc - d
else
acc := acc + d
end
end resignal invalid
return(acc)
end decode
end roman
start_up = proc ()
po: stream := stream$primary_output()
tests: array[string] := array[string]$
["MCMXC", "mdclxvi", "MmViI", "mmXXi", "INVALID"]
for test: string in array[string]$elements(tests) do
stream$puts(po, test || ": ")
stream$putl(po, int$unparse(roman$decode(test))) except when invalid:
stream$putl(po, "not a valid Roman numeral!")
end
end
end start_up

75
Task/Roman-numerals-Decode/COBOL/roman-numerals-decode.cobol Normal file
View file

@ -0,0 +1,75 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. UNROMAN.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 filler.
03 i pic 9(02) comp.
03 j pic 9(02) comp.
03 k pic 9(02) comp.
03 l pic 9(02) comp.
01 inp-roman.
03 inp-rom-ch pic x(01) occurs 20 times.
01 inp-roman-digits.
03 inp-rom-digit pic 9(01) occurs 20 times.
01 ws-search-idx pic 9(02) comp.
01 ws-tbl-table-def.
03 filler pic x(05) value '1000M'.
03 filler pic x(05) value '0500D'.
03 filler pic x(05) value '0100C'.
03 filler pic x(05) value '0050L'.
03 filler pic x(05) value '0010X'.
03 filler pic x(05) value '0005V'.
03 filler pic x(05) value '0001I'.
01 filler redefines ws-tbl-table-def.
03 ws-tbl-roman occurs 07 times indexed by rx.
05 ws-tbl-rom-val pic 9(04).
05 ws-tbl-rom-ch pic x(01).
01 ws-number pic s9(05) value 0.
01 ws-number-pic pic zzzz9-.
PROCEDURE DIVISION.
accept inp-roman
perform
until inp-roman = ' '
move zeroes to inp-roman-digits
perform
varying i from 1 by +1 until inp-rom-ch (i) = ' '
set rx to 1
search ws-tbl-roman
at end
move 0 to inp-rom-digit (i)
when ws-tbl-rom-ch (rx) = inp-rom-ch (i)
set inp-rom-digit (i) to rx
end-search
end-perform
compute l = i - 1
move 0 to ws-number
perform
varying i from 1 by +1
until i > l or inp-rom-digit (i) = 0
compute j = inp-rom-digit (i)
compute k = inp-rom-digit (i + 1)
if ws-tbl-rom-val (k)
> ws-tbl-rom-val (j)
compute ws-number
= ws-number
- ws-tbl-rom-val (j)
else
compute ws-number
= ws-number
+ ws-tbl-rom-val (j)
end-if
end-perform
move ws-number to ws-number-pic
display '----------'
display 'roman=' inp-roman
display 'arabic=' ws-number-pic
if i < l or ws-number = 0
display 'invalid/incomplete roman numeral at pos 'i
' found ' inp-rom-ch (i)
end-if
accept inp-roman
end-perform
stop run
.
END PROGRAM UNROMAN.

37
Task/Roman-numerals-Decode/Ceylon/roman-numerals-decode.ceylon Normal file
View file

@ -0,0 +1,37 @@
shared void run() {
value numerals = map {
'I' -> 1,
'V' -> 5,
'X' -> 10,
'L' -> 50,
'C' -> 100,
'D' -> 500,
'M' -> 1000
};
function toHindu(String roman) {
variable value total = 0;
for(i->c in roman.indexed) {
assert(exists currentValue = numerals[c]);
/* Look at the next letter to see if we're looking
at a IV or CM or whatever. If so subtract the
current number from the total. */
if(exists next = roman[i + 1],
exists nextValue = numerals[next],
currentValue < nextValue) {
total -= currentValue;
} else {
total += currentValue;
}
}
return total;
}
assert(toHindu("I") == 1);
assert(toHindu("II") == 2);
assert(toHindu("IV") == 4);
assert(toHindu("MDCLXVI") == 1666);
assert(toHindu("MCMXC") == 1990);
assert(toHindu("MMVIII") == 2008);
}

23
Task/Roman-numerals-Decode/Chipmunk-Basic/roman-numerals-decode-1.basic Normal file
View file

@ -0,0 +1,23 @@
100 cls : rem 100 home for Applesoft BASIC
110 roman$ = "MCMXCIX" : print roman$,"=> "; : gosub 170 : print decimal '1999
120 roman$ = "XXV" : print roman$,"=> "; : gosub 170 : print decimal '25
130 roman$ = "CMLIV" : print roman$,"=> "; : gosub 170 : print decimal '954
140 roman$ = "MMXI" : print roman$,"=> "; : gosub 170 : print decimal '2011
150 end
160 rem Decode from roman
170 decimal = 0
180 predecimal = 0
190 for i = len(roman$) to 1 step -1
200 x$ = mid$(roman$,i,1)
210 if x$ = "M" then n = 1000 : goto 280
220 if x$ = "D" then n = 500 : goto 280
230 if x$ = "C" then n = 100 : goto 280
240 if x$ = "L" then n = 50 : goto 280
250 if x$ = "X" then n = 10 : goto 280
260 if x$ = "V" then n = 5 : goto 280
270 if x$ = "I" then n = 1
280 if n < predecimal then decimal = decimal-n
285 if n >= predecimal then decimal = decimal+n
290 predecimal = n
300 next i
310 return

25
Task/Roman-numerals-Decode/Chipmunk-Basic/roman-numerals-decode-2.basic Normal file
View file

@ -0,0 +1,25 @@
100 cls
110 roman$ = "MCMXCIX" : print roman$,"=> "; : gosub 170 : print decimal '1999
120 roman$ = "XXV" : print roman$,"=> "; : gosub 170 : print decimal '25
130 roman$ = "CMLIV" : print roman$,"=> "; : gosub 170 : print decimal '954
140 roman$ = "MMXI" : print roman$,"=> "; : gosub 170 : print decimal '2011
150 end
160 rem Decode from roman
170 decimal = 0
180 predecimal = 0
190 for i = len(roman$) to 1 step -1
200 x$ = mid$(roman$,i,1)
210 select case x$
220 case "M" : n = 1000
230 case "D" : n = 500
240 case "C" : n = 100
250 case "L" : n = 50
260 case "X" : n = 10
270 case "V" : n = 5
280 case "I" : n = 1
290 case else : print "not a roman numeral" : end
300 end select
310 if n < predecimal then decimal = decimal-n else decimal = decimal+n
320 predecimal = n
330 next i
340 return

15
Task/Roman-numerals-Decode/Clojure/roman-numerals-decode.clj Normal file
View file

@ -0,0 +1,15 @@
;; Incorporated some improvements from the alternative implementation below
(defn ro2ar [r]
(->> (reverse (.toUpperCase r))
(map {\M 1000 \D 500 \C 100 \L 50 \X 10 \V 5 \I 1})
(partition-by identity)
(map (partial apply +))
(reduce #(if (< %1 %2) (+ %1 %2) (- %1 %2)))))
;; alternative
(def numerals { \I 1, \V 5, \X 10, \L 50, \C 100, \D 500, \M 1000})
(defn from-roman [s]
(->> s .toUpperCase
(map numerals)
(reduce (fn [[sum lastv] curr] [(+ sum curr (if (< lastv curr) (* -2 lastv) 0)) curr]) [0,0])
first))

36
Task/Roman-numerals-Decode/CoffeeScript/roman-numerals-decode.coffee Normal file
View file

@ -0,0 +1,36 @@
roman_to_demical = (s) ->
# s is well-formed Roman Numeral >= I
numbers =
M: 1000
D: 500
C: 100
L: 50
X: 10
V: 5
I: 1
result = 0
for c in s
num = numbers[c]
result += num
if old_num < num
# If old_num exists and is less than num, then
# we need to subtract it twice, once because we
# have already added it on the last pass, and twice
# to conform to the Roman convention that XC = 90,
# not 110.
result -= 2 * old_num
old_num = num
result
tests =
IV: 4
XLII: 42
MCMXC: 1990
MMVIII: 2008
MDCLXVI: 1666
for roman, expected of tests
dec = roman_to_demical(roman)
console.log "error" if dec != expected
console.log "#{roman} = #{dec}"

6
Task/Roman-numerals-Decode/Common-Lisp/roman-numerals-decode-1.lisp Normal file
View file

@ -0,0 +1,6 @@
(defun mapcn (chars nums string)
(loop as char across string as i = (position char chars) collect (and i (nth i nums))))
(defun parse-roman (R)
(loop with nums = (mapcn "IVXLCDM" '(1 5 10 50 100 500 1000) R)
as (A B) on nums if A sum (if (and B (< A B)) (- A) A)))

2
Task/Roman-numerals-Decode/Common-Lisp/roman-numerals-decode-2.lisp Normal file
View file

@ -0,0 +1,2 @@
(dolist (r '("MCMXC" "MDCLXVI" "MMVIII"))
(format t "~a:~10t~d~%" r (parse-roman r)))

59
Task/Roman-numerals-Decode/Cowgol/roman-numerals-decode.cowgol Normal file
View file

@ -0,0 +1,59 @@
include "cowgol.coh";
include "argv.coh";
# Decode the Roman numeral in the given string.
# Returns 0 if the string does not contain a valid Roman numeral.
sub romanToDecimal(str: [uint8]): (rslt: uint16) is
# Look up a Roman digit
sub digit(char: uint8): (val: uint16) is
# Definition of Roman numerals
record RomanDigit is
char: uint8;
value: uint16;
end record;
var digits: RomanDigit[] := {
{'I',1}, {'V',5}, {'X',10}, {'L',50},
{'C',100}, {'D',500}, {'M',1000}
};
char := char & ~32; # make uppercase
# Look up given digit
var i: @indexof digits := 0;
while i < @sizeof digits loop
val := digits[i].value;
if digits[i].char == char then
return;
end if;
i := i + 1;
end loop;
val := 0;
end sub;
rslt := 0;
while [str] != 0 loop
var cur := digit([str]); # get value of current digit
if cur == 0 then rslt := 0; return; end if; # stop when invalid
str := @next str;
if digit([str]) > cur then
# a digit followed by a larger digit should be subtracted from
# the total
rslt := rslt - cur;
else
rslt := rslt + cur;
end if;
end loop;
end sub;
# Read a Roman numeral from the command line and print its output
ArgvInit();
var argmt := ArgvNext();
if argmt == (0 as [uint8]) then
# No argument
print("No argument\n");
ExitWithError();
end if;
print_i16(romanToDecimal(argmt));
print_nl();

19
Task/Roman-numerals-Decode/D/roman-numerals-decode-1.d Normal file
View file

@ -0,0 +1,19 @@
import std.regex, std.algorithm;
int toArabic(in string s) /*pure nothrow*/ {
static immutable weights = [1000, 900, 500, 400, 100,
90, 50, 40, 10, 9, 5, 4, 1];
static immutable symbols = ["M","CM","D","CD","C","XC",
"L","XL","X","IX","V","IV","I"];
int arabic;
foreach (m; s.matchAll("CM|CD|XC|XL|IX|IV|[MDCLXVI]".regex))
arabic += weights[symbols.countUntil(m.hit)];
return arabic;
}
void main() {
assert("MCMXC".toArabic == 1990);
assert("MMVIII".toArabic == 2008);
assert("MDCLXVI".toArabic == 1666);
}

22
Task/Roman-numerals-Decode/D/roman-numerals-decode-2.d Normal file
View file

@ -0,0 +1,22 @@
import std.regex, std.algorithm;
immutable uint[string] w2s;
pure nothrow static this() {
w2s = ["IX": 9, "C": 100, "D": 500, "CM": 900, "I": 1,
"XC": 90, "M": 1000, "L": 50, "CD": 400, "XL": 40,
"V": 5, "X": 10, "IV": 4];
}
uint toArabic(in string s) /*pure nothrow*/ @safe /*@nogc*/ {
return s
.matchAll("CM|CD|XC|XL|IX|IV|[MDCLXVI]".regex)
.map!(m => w2s[m.hit])
.sum;
}
void main() {
assert("MCMXC".toArabic == 1990);
assert("MMVIII".toArabic == 2008);
assert("MDCLXVI".toArabic == 1666);
}

44
Task/Roman-numerals-Decode/Delphi/roman-numerals-decode.delphi Normal file
View file

@ -0,0 +1,44 @@
program RomanNumeralsDecode;
{$APPTYPE CONSOLE}
function RomanToInteger(const aRoman: string): Integer;
function DecodeRomanDigit(aChar: Char): Integer;
begin
case aChar of
'M', 'm': Result := 1000;
'D', 'd': Result := 500;
'C', 'c': Result := 100;
'L', 'l': Result := 50;
'X', 'x': Result := 10;
'V', 'v': Result := 5;
'I', 'i': Result := 1
else
Result := 0;
end;
end;
var
i: Integer;
lCurrVal: Integer;
lLastVal: Integer;
begin
Result := 0;
lLastVal := 0;
for i := Length(aRoman) downto 1 do
begin
lCurrVal := DecodeRomanDigit(aRoman[i]);
if lCurrVal < lLastVal then
Result := Result - lCurrVal
else
Result := Result + lCurrVal;
lLastVal := lCurrVal;
end;
end;
begin
Writeln(RomanToInteger('MCMXC')); // 1990
Writeln(RomanToInteger('MMVIII')); // 2008
Writeln(RomanToInteger('MDCLXVI')); // 1666
end.

18
Task/Roman-numerals-Decode/ECL/roman-numerals-decode-1.ecl Normal file
View file

@ -0,0 +1,18 @@
MapChar(STRING1 c) := CASE(c,'M'=>1000,'D'=>500,'C'=>100,'L'=>50,'X'=>10,'V'=>5,'I'=>1,0);
RomanDecode(STRING s) := FUNCTION
dsS := DATASET([{s}],{STRING Inp});
R := { INTEGER2 i; };
R Trans1(dsS le,INTEGER pos) := TRANSFORM
SELF.i := MapChar(le.Inp[pos]) * IF ( MapChar(le.Inp[pos]) < MapChar(le.Inp[pos+1]), -1, 1 );
END;
RETURN SUM(NORMALIZE(dsS,LENGTH(TRIM(s)),Trans1(LEFT,COUNTER)),i);
END;
RomanDecode('MCMLIV'); //1954
RomanDecode('MCMXC'); //1990
RomanDecode('MMVIII'); //2008
RomanDecode('MDCLXVI'); //1666
RomanDecode('MDLXVI'); //1566

41
Task/Roman-numerals-Decode/ECL/roman-numerals-decode-2.ecl Normal file
View file

@ -0,0 +1,41 @@
IMPORT STD;
RomanDecode(STRING s) := FUNCTION
SetWeights := [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1];
SetSymbols := ['M', 'CM', 'D', 'CD', 'C', 'XC', 'L', 'XL', 'X', 'IX', 'V', 'IV', 'I'];
ProcessRec := RECORD
UNSIGNED val;
STRING Roman;
END;
dsSymbols := DATASET(13,TRANSFORM(ProcessRec,SELF.Roman := s, SELF := []));
RECORDOF(dsSymbols) XF(dsSymbols L, dsSymbols R, INTEGER C) := TRANSFORM
ThisRoman := IF(C=1,R.Roman,L.Roman);
IsDone := ThisRoman = '';
Repeatable := C IN [1,5,9,13];
SymSize := IF(C % 2 = 0, 2, 1);
IsNext := STD.Str.StartsWith(ThisRoman,SetSymbols[C]);
SymLen := IF(IsNext,
IF(NOT Repeatable,
SymSize,
MAP(NOT IsDone AND ThisRoman[1] = ThisRoman[2] AND ThisRoman[1] = ThisRoman[3] => 3,
NOT IsDone AND ThisRoman[1] = ThisRoman[2] => 2,
NOT IsDone => 1,
0)),
0);
SymbolWeight(STRING s) := IF(NOT Repeatable,
SetWeights[C],
CHOOSE(LENGTH(s),SetWeights[C],SetWeights[C]*2,SetWeights[C]*3,0));
SELF.Roman := IF(IsDone,ThisRoman,ThisRoman[SymLen+1..]);
SELF.val := IF(IsDone,L.val,L.Val + IF(IsNext,SymbolWeight(ThisRoman[1..SymLen]),0));
END;
i := ITERATE(dsSymbols,XF(LEFT,RIGHT,COUNTER));
RETURN i[13].val;
END;
RomanDecode('MCMLIV'); //1954
RomanDecode('MCMXC'); //1990
RomanDecode('MMVIII'); //2008
RomanDecode('MDCLXVI'); //1666
RomanDecode('MDLXVI'); //1566

29
Task/Roman-numerals-Decode/ERRE/roman-numerals-decode.erre Normal file
View file

@ -0,0 +1,29 @@
PROGRAM ROMAN2ARAB
DIM R%[7]
PROCEDURE TOARAB(ROMAN$->ANS%)
LOCAL I%,J%,P%,N%
FOR I%=LEN(ROMAN$) TO 1 STEP -1 DO
J%=INSTR("IVXLCDM",MID$(ROMAN$,I%,1))
IF J%=0 THEN
ANS%=-9999 ! illegal character
EXIT PROCEDURE
END IF
IF J%>=P% THEN
N%+=R%[J%]
ELSE
N%-=R%[J%]
END IF
P%=J%
END FOR
ANS%=N%
END PROCEDURE
BEGIN
R%[]=(0,1,5,10,50,100,500,1000)
TOARAB("MCMXCIX"->ANS%) PRINT(ANS%)
TOARAB("MMXII"->ANS%) PRINT(ANS%)
TOARAB("MDCLXVI"->ANS%) PRINT(ANS%)
TOARAB("MMMDCCCLXXXVIII"->ANS%) PRINT(ANS%)
END PROGRAM

23
Task/Roman-numerals-Decode/EasyLang/roman-numerals-decode.easy Normal file
View file

@ -0,0 +1,23 @@
proc rom2dec rom$ . val .
symbols$[] = [ "M" "D" "C" "L" "X" "V" "I" ]
values[] = [ 1000 500 100 50 10 5 1 ]
val = 0
for dig$ in strchars rom$
for i = 1 to len symbols$[]
if symbols$[i] = dig$
v = values[i]
.
.
val += v
if oldv < v
val -= 2 * oldv
.
oldv = v
.
.
call rom2dec "MCMXC" v
print v
call rom2dec "MMVIII" v
print v
call rom2dec "MDCLXVI" v
print v

111
Task/Roman-numerals-Decode/Eiffel/roman-numerals-decode.e Normal file
View file

@ -0,0 +1,111 @@
class
APPLICATION
create
make
feature {NONE} -- Initialization
make
local
numbers: ARRAY [STRING]
do
numbers := <<"MCMXC", "MMVIII", "MDCLXVI",
-- 1990 2008 1666
"MMMCLIX", "MCMLXXVII", "MMX">>
-- 3159 1977 2010
across numbers as n loop
print (n.item +
" in Roman numerals is " +
roman_to_decimal (n.item).out +
" in decimal Arabic numerals.")
print ("%N")
end
end
feature -- Roman numerals
roman_to_decimal (a_str: STRING): INTEGER
-- Decimal representation of Roman numeral `a_str'
require
is_roman (a_str)
local
l_pos: INTEGER
cur: INTEGER -- Value of the digit read in the current iteration
prev: INTEGER -- Value of the digit read in the previous iteration
do
from
l_pos := 0
Result := 0
prev := 1 + max_digit_value
until
l_pos = a_str.count
loop
l_pos := l_pos + 1
cur := roman_digit_to_decimal (a_str.at (l_pos))
if cur <= prev then
-- Add nonincreasing digit
Result := Result + cur
else
-- Subtract previous digit from increasing digit
Result := Result - prev + (cur - prev)
end
prev := cur
end
ensure
Result >= 0
end
is_roman (a_string: STRING): BOOLEAN
-- Is `a_string' a valid sequence of Roman digits?
do
Result := across a_string as c all is_roman_digit (c.item) end
end
feature {NONE} -- Implementation
max_digit_value: INTEGER = 1000
is_roman_digit (a_char: CHARACTER): BOOLEAN
-- Is `a_char' a valid Roman digit?
local
l_char: CHARACTER
do
l_char := a_char.as_upper
inspect l_char
when 'I', 'V', 'X', 'L', 'C', 'D', 'M' then
Result := True
else
Result := False
end
end
roman_digit_to_decimal (a_char: CHARACTER): INTEGER
-- Decimal representation of Roman digit `a_char'
require
is_roman_digit (a_char)
local
l_char: CHARACTER
do
l_char := a_char.as_upper
inspect l_char
when 'I' then
Result := 1
when 'V' then
Result := 5
when 'X' then
Result := 10
when 'L' then
Result := 50
when 'C' then
Result := 100
when 'D' then
Result := 500
when 'M' then
Result := 1000
end
ensure
Result > 0
end
end

45
Task/Roman-numerals-Decode/Elena/roman-numerals-decode.elena Normal file
View file

@ -0,0 +1,45 @@
import extensions;
import system'collections;
import system'routines;
static RomanDictionary = Dictionary.new()
.setAt("I".toChar(), 1)
.setAt("V".toChar(), 5)
.setAt("X".toChar(), 10)
.setAt("L".toChar(), 50)
.setAt("C".toChar(), 100)
.setAt("D".toChar(), 500)
.setAt("M".toChar(), 1000);
extension op : String
{
toRomanInt()
{
var minus := 0;
var s := self.upperCase();
var total := 0;
for(int i := 0, i < s.Length, i += 1)
{
var thisNumeral := RomanDictionary[s[i]] - minus;
if (i >= s.Length - 1 || thisNumeral + minus >= RomanDictionary[s[i + 1]])
{
total += thisNumeral;
minus := 0
}
else
{
minus := thisNumeral
}
};
^ total
}
}
public program()
{
console.printLine("MCMXC: ", "MCMXC".toRomanInt());
console.printLine("MMVIII: ", "MMVIII".toRomanInt());
console.printLine("MDCLXVI:", "MDCLXVI".toRomanInt())
}

22
Task/Roman-numerals-Decode/Elixir/roman-numerals-decode.elixir Normal file
View file

@ -0,0 +1,22 @@
defmodule Roman_numeral do
def decode([]), do: 0
def decode([x]), do: to_value(x)
def decode([h1, h2 | rest]) do
case {to_value(h1), to_value(h2)} do
{v1, v2} when v1 < v2 -> v2 - v1 + decode(rest)
{v1, _} -> v1 + decode([h2 | rest])
end
end
defp to_value(?M), do: 1000
defp to_value(?D), do: 500
defp to_value(?C), do: 100
defp to_value(?L), do: 50
defp to_value(?X), do: 10
defp to_value(?V), do: 5
defp to_value(?I), do: 1
end
Enum.each(['MCMXC', 'MMVIII', 'MDCLXVI', 'IIIID'], fn clist ->
IO.puts "#{clist}\t: #{Roman_numeral.decode(clist)}"
end)

16
Task/Roman-numerals-Decode/Emacs-Lisp/roman-numerals-decode.l Normal file
View file

@ -0,0 +1,16 @@
(defun ro2ar (RN)
"Translate a roman number RN into arabic number.
Its argument RN is wether a symbol, wether a list.
Returns the arabic number. (ro2ar 'C) gives 100,
(ro2ar '(X X I V)) gives 24"
(cond
((eq RN 'M) 1000)
((eq RN 'D) 500)
((eq RN 'C) 100)
((eq RN 'L) 50)
((eq RN 'X) 10)
((eq RN 'V) 5)
((eq RN 'I) 1)
((null (cdr RN)) (ro2ar (car RN))) ;; stop recursion
((< (ro2ar (car RN)) (ro2ar (car (cdr RN)))) (- (ro2ar (cdr RN)) (ro2ar (car RN)))) ;; "IV" -> 5-1=4
(t (+ (ro2ar (car RN)) (ro2ar (cdr RN)))))) ;; "VI" -> 5+1=6

20
Task/Roman-numerals-Decode/Erlang/roman-numerals-decode.erl Normal file
View file

@ -0,0 +1,20 @@
-module( roman_numerals ).
-export( [decode_from_string/1]).
to_value($M) -> 1000;
to_value($D) -> 500;
to_value($C) -> 100;
to_value($L) -> 50;
to_value($X) -> 10;
to_value($V) -> 5;
to_value($I) -> 1.
decode_from_string([]) -> 0;
decode_from_string([H1]) -> to_value(H1);
decode_from_string([H1, H2 |Rest]) ->
case {to_value(H1), to_value(H2)} of
{V1, V2} when V1 < V2 -> V2 - V1 + decode_from_string(Rest);
{V1, V1} -> V1 + V1 + decode_from_string(Rest);
{V1, _} -> V1 + decode_from_string([H2|Rest])
end.

25
Task/Roman-numerals-Decode/Euphoria/roman-numerals-decode.euphoria Normal file
View file

@ -0,0 +1,25 @@
constant symbols = "MDCLXVI", weights = {1000,500,100,50,10,5,1}
function romanDec(sequence roman)
integer n, lastval, arabic
lastval = 0
arabic = 0
for i = length(roman) to 1 by -1 do
n = find(roman[i],symbols)
if n then
n = weights[n]
end if
if n < lastval then
arabic -= n
else
arabic += n
end if
lastval = n
end for
return arabic
end function
? romanDec("MCMXCIX")
? romanDec("MDCLXVI")
? romanDec("XXV")
? romanDec("CMLIV")
? romanDec("MMXI")

17
Task/Roman-numerals-Decode/F-Sharp/roman-numerals-decode-1.fs Normal file
View file

@ -0,0 +1,17 @@
let decimal_of_roman roman =
let rec convert arabic lastval = function
| head::tail ->
let n = match head with
| 'M' | 'm' -> 1000
| 'D' | 'd' -> 500
| 'C' | 'c' -> 100
| 'L' | 'l' -> 50
| 'X' | 'x' -> 10
| 'V' | 'v' -> 5
| 'I' | 'i' -> 1
| _ -> 0
let op = if n > lastval then (-) else (+)
convert (op arabic lastval) n tail
| _ -> arabic + lastval
convert 0 0 (Seq.toList roman)
;;

16
Task/Roman-numerals-Decode/F-Sharp/roman-numerals-decode-2.fs Normal file
View file

@ -0,0 +1,16 @@
let decimal_of_roman roman =
let convert (arabic,lastval) c =
let n = match c with
| 'M' | 'm' -> 1000
| 'D' | 'd' -> 500
| 'C' | 'c' -> 100
| 'L' | 'l' -> 50
| 'X' | 'x' -> 10
| 'V' | 'v' -> 5
| 'I' | 'i' -> 1
| _ -> 0
let op = if n > lastval then (-) else (+)
(op arabic lastval, n)
let (arabic, lastval) = Seq.fold convert (0,0) roman
arabic + lastval
;;

3
Task/Roman-numerals-Decode/F-Sharp/roman-numerals-decode-3.fs Normal file
View file

@ -0,0 +1,3 @@
let tests = ["MCMXC"; "MMVIII"; "MDCLXVII"; "MMMCLIX"; "MCMLXXVII"; "MMX"]
for test in tests do Printf.printf "%s: %d\n" test (decimal_of_roman test)
;;

21
Task/Roman-numerals-Decode/FALSE/roman-numerals-decode.false Normal file
View file

@ -0,0 +1,21 @@
[ 32| {get value of Roman digit on stack}
$'m= $[\% 1000\]? ~[
$'d= $[\% 500\]? ~[
$'c= $[\% 100\]? ~[
$'l= $[\% 50\]? ~[
$'x= $[\% 10\]? ~[
$'v= $[\% 5\]? ~[
$'i= $[\% 1\]? ~[
% 0
]?]?]?]?]?]?]?
]r:
0 {accumulator}
^r;! {read first Roman digit}
[^r;!$][ {read another, and as long as it is valid...}
\$@@\$@@ {copy previous and current}
\>[\_\]? {if previous smaller than current, negate previous}
@@+\ {add previous to accumulator}
]#
%+. {add final digit to accumulator and output}
10, {and a newline}

3
Task/Roman-numerals-Decode/Factor/roman-numerals-decode-1.factor Normal file
View file

@ -0,0 +1,3 @@
USE: roman
( scratchpad ) "MMMCCCXXXIII" roman> .
3333

20
Task/Roman-numerals-Decode/Factor/roman-numerals-decode-2.factor Normal file
View file

@ -0,0 +1,20 @@
CONSTANT: roman-digits
{ "m" "cm" "d" "cd" "c" "xc" "l" "xl" "x" "ix" "v" "iv" "i" }
CONSTANT: roman-values
{ 1000 900 500 400 100 90 50 40 10 9 5 4 1 }
: roman> ( str -- n )
>lower [ roman-digit>= ] monotonic-split
[ roman-value ] map-sum ;
: roman-digit>= ( ch1 ch2 -- ? ) [ roman-digit-index ] bi@ >= ;
: roman-digit-index ( ch -- n ) 1string roman-digits index ;
: roman-value (seq -- n )
[ [ roman-digit-value ] map ] [ all-eq? ] bi
[ sum ] [ first2 swap - ] if ;
: roman-digit-value ( ch -- n )
roman-digit-index roman-values nth ;

26
Task/Roman-numerals-Decode/Forth/roman-numerals-decode-1.fth Normal file
View file

@ -0,0 +1,26 @@
create (arabic)
1000 128 * char M + ,
500 128 * char D + ,
100 128 * char C + ,
50 128 * char L + ,
10 128 * char X + ,
5 128 * char V + ,
1 128 * char I + ,
does>
7 cells bounds do
i @ over over 127 and = if nip 7 rshift leave else drop then
1 cells +loop dup
;
: >arabic
0 dup >r >r
begin
over over
while
c@ dup (arabic) rot <>
while
r> over r> over over > if 2* negate + else drop then + swap >r >r 1 /string
repeat then drop 2drop r> r> drop
;
s" MCMLXXXIV" >arabic .

40
Task/Roman-numerals-Decode/Forth/roman-numerals-decode-2.fth Normal file
View file

@ -0,0 +1,40 @@
\ decode roman numerals using Forth methodology
\ create words to describe and solve the problem
\ ANS/ISO Forth
\ state holders
VARIABLE OLDNDX
VARIABLE CURNDX
VARIABLE NEGFLAG
DECIMAL
CREATE VALUES ( -- addr) 0 , 1 , 5 , 10 , 50 , 100 , 500 , 1000 ,
: NUMERALS ( -- addr len) S" IVXLCDM" ; \ 1st char is a blank
: [] ( n addr -- addr') SWAP CELLS + ; \ array address calc.
: INIT ( -- ) CURNDX OFF OLDNDX OFF NEGFLAG OFF ;
: REMEMBER ( ndx -- ndx ) CURNDX @ OLDNDX ! DUP CURNDX ! ;
: ]VALUE@ ( ndx -- n ) REMEMBER VALUES [] @ ;
HEX
: TOUPPER ( char -- char ) 05F AND ;
DECIMAL
: >INDEX ( char -- ndx) TOUPPER >R NUMERALS TUCK R> SCAN NIP -
DUP 7 > ABORT" Invalid Roman numeral" ;
: >VALUE ( char -- n ) >INDEX ]VALUE@ ;
: ?ILLEGAL ( ndx -- ) CURNDX @ OLDNDX @ = NEGFLAG @ AND ABORT" Illegal format" ;
: ?NEGATE ( n -- +n | -n) \ conditional NEGATE
CURNDX @ OLDNDX @ <
IF NEGFLAG ON NEGATE
ELSE ?ILLEGAL NEGFLAG OFF
THEN ;
: >ARABIC ( addr len -- n )
INIT
0 -ROT \ accumulator under the stack string args
1- BOUNDS \ convert addr len to two addresses
SWAP DO \ index the string from back to front
I C@ >VALUE ?NEGATE +
-1 +LOOP ;

41
Task/Roman-numerals-Decode/Fortran/roman-numerals-decode.f Normal file
View file

@ -0,0 +1,41 @@
program Roman_decode
implicit none
write(*,*) decode("MCMXC"), decode("MMVIII"), decode("MDCLXVI")
contains
function decode(roman) result(arabic)
character(*), intent(in) :: roman
integer :: i, n, lastval, arabic
arabic = 0
lastval = 0
do i = len(roman), 1, -1
select case(roman(i:i))
case ('M','m')
n = 1000
case ('D','d')
n = 500
case ('C','c')
n = 100
case ('L','l')
n = 50
case ('X','x')
n = 10
case ('V','v')
n = 5
case ('I','i')
n = 1
case default
n = 0
end select
if (n < lastval) then
arabic = arabic - n
else
arabic = arabic + n
end if
lastval = n
end do
end function decode
end program Roman_decode

62
Task/Roman-numerals-Decode/FreeBASIC/roman-numerals-decode.basic Normal file
View file

@ -0,0 +1,62 @@
' FB 1.05.0 Win64
Function romanDecode(roman As Const String) As Integer
If roman = "" Then Return 0 '' zero denotes invalid roman number
Dim roman1(0 To 2) As String = {"MMM", "MM", "M"}
Dim roman2(0 To 8) As String = {"CM", "DCCC", "DCC", "DC", "D", "CD", "CCC", "CC", "C"}
Dim roman3(0 To 8) As String = {"XC", "LXXX", "LXX", "LX", "L", "XL", "XXX", "XX", "X"}
Dim roman4(0 To 8) As String = {"IX", "VIII", "VII", "VI", "V", "IV", "III", "II", "I"}
Dim As Integer i, value = 0, length = 0
Dim r As String = UCase(roman)
For i = 0 To 2
If Left(r, Len(roman1(i))) = roman1(i) Then
value += 1000 * (3 - i)
length = Len(roman1(i))
r = Mid(r, length + 1)
length = 0
Exit For
End If
Next
For i = 0 To 8
If Left(r, Len(roman2(i))) = roman2(i) Then
value += 100 * (9 - i)
length = Len(roman2(i))
r = Mid(r, length + 1)
length = 0
Exit For
End If
Next
For i = 0 To 8
If Left(r, Len(roman3(i))) = roman3(i) Then
value += 10 * (9 - i)
length = Len(roman3(i))
r = Mid(r, length + 1)
length = 0
Exit For
End If
Next
For i = 0 To 8
If Left(r, Len(roman4(i))) = roman4(i) Then
value += 9 - i
length = Len(roman4(i))
Exit For
End If
Next
' Can't be a valid roman number if there are any characters left
If Len(r) > length Then Return 0
Return value
End Function
Dim a(2) As String = {"MCMXC", "MMVIII" , "MDCLXVI"}
For i As Integer = 0 To 2
Print a(i); Tab(8); " =>"; romanDecode(a(i))
Next
Print
Print "Press any key to quit"
Sleep

33
Task/Roman-numerals-Decode/FutureBasic/roman-numerals-decode.basic Normal file
View file

@ -0,0 +1,33 @@
window 1
local fn RomantoDecimal( roman as CFStringRef ) as long
long i, n, preNum = 0, num = 0
for i = len(roman) - 1 to 0 step -1
n = 0
select ( fn StringCharacterAtIndex( roman, i ) )
case _"M" : n = 1000
case _"D" : n = 500
case _"C" : n = 100
case _"L" : n = 50
case _"X" : n = 10
case _"V" : n = 5
case _"I" : n = 1
end select
if ( n < preNum ) then num = num - n else num = num + n
preNum = n
next
end fn = num
print @" MCMXC = "; fn RomantoDecimal( @"MCMXC" )
print @" MMVIII = "; fn RomantoDecimal( @"MMVIII" )
print @" MMXVI = "; fn RomantoDecimal( @"MMXVI" )
print @"MDCLXVI = "; fn RomantoDecimal( @"MDCLXVI" )
print @" MCMXIV = "; fn RomantoDecimal( @"MCMXIV" )
print @" DXIII = "; fn RomantoDecimal( @"DXIII" )
print @" M = "; fn RomantoDecimal( @"M" )
print @" DXIII = "; fn RomantoDecimal( @"DXIII" )
print @" XXXIII = "; fn RomantoDecimal( @"XXXIII" )
HandleEvents

72
Task/Roman-numerals-Decode/Gambas/roman-numerals-decode.gambas Normal file
View file

@ -0,0 +1,72 @@
'This code will create a GUI Form and Objects and carry out the Roman Numeral convertion as you type
'The input is case insensitive
'A basic check for invalid charaters is made
hTextBox As TextBox 'To allow the creation of a TextBox
hValueBox As ValueBox 'To allow the creation of a ValueBox
Public Sub Form_Open() 'Form opens..
SetUpForm 'Go to the SetUpForm Routine
hTextBox.text = "MCMXC" 'Put a Roman numeral in the TextBox
End
Public Sub TextBoxInput_Change() 'Each time the TextBox text changes..
Dim cRomanN As Collection = ["M": 1000, "D": 500, "C": 100, "L": 50, "X": 10, "V": 5, "I": 1] 'Collection of nemerals e.g 'M' = 1000
Dim cMinus As Collection = ["IV": -2, "IX": -2, "XL": -20, "XC": - 20, "CD": -200, "CM": -200] 'Collection of the 'one less than' numbers e.g. 'IV' = 4
Dim sClean, sTemp As String 'Various string variables
Dim siCount As Short 'Counter
Dim iTotal As Integer 'Stores the total of the calculation
hTextBox.Text = UCase(hTextBox.Text) 'Make any text in the TextBox upper case
For siCount = 1 To Len(hTextBox.Text) 'Loop through each character in the TextBox
If InStr("MDCLXVI", Mid(hTextBox.Text, siCount, 1)) Then 'If a Roman numeral exists then..
sClean &= Mid(hTextBox.Text, siCount, 1) 'Put it in 'sClean' (Stops input of non Roman numerals)
End If
Next
hTextBox.Text = sClean 'Put the now clean text in the TextBox
For siCount = 1 To Len(hTextBox.Text) 'Loop through each character in the TextBox
iTotal += cRomanN[Mid(hTextBox.Text, siCount, 1)] 'Total up all the characters, note 'IX' will = 11 not 9
Next
For Each sTemp In cMinus 'Loop through each item in the cMinus Collection
If InStr(sClean, cMinus.Key) > 0 Then iTotal += Val(sTemp) 'If a 'Minus' value is in the string e.g. 'IX' which has been calculated at 11 subtract 2 = 9
Next
hValueBox.text = iTotal 'Display the total
End
Public Sub SetUpForm() 'Create the Objects for the Form
Dim hLabel1, hLabel2 As Label 'For 2 Labels
Me.height = 150 'Form Height
Me.Width = 300 'Form Width
Me.Padding = 20 'Form padding (border)
Me.Text = "Roman Numeral converter" 'Text in Form header
Me.Arrangement = Arrange.Vertical 'Form arrangement
hLabel1 = New Label(Me) 'Create a Label
hLabel1.Height = 21 'Label Height
hLabel1.expand = True 'Expand the Label
hLabel1.Text = "Enter a Roman numeral" 'Put text in the Label
hTextBox = New TextBox(Me) As "TextBoxInput" 'Set up a TextBox with an Event Label
hTextBox.Height = 21 'TextBox height
hTextBox.expand = True 'Expand the TextBox
hLabel2 = New Label(Me) 'Create a Label
hLabel2.Height = 21 'Label Height
hLabel2.expand = True 'Expand the Label
hLabel2.Text = "The decimal equivelent is: -" 'Put text in the Label
hValueBox = New ValueBox(Me) 'Create a ValueBox
hValueBox.Height = 21 'ValuBox Height
hValueBox.expand = True 'Expand the ValueBox
hValueBox.ReadOnly = True 'Set ValueBox to Read Only
End

84
Task/Roman-numerals-Decode/Go/roman-numerals-decode-1.go Normal file
View file

@ -0,0 +1,84 @@
package main
import (
"errors"
"fmt"
)
var m = map[rune]int{
'I': 1,
'V': 5,
'X': 10,
'L': 50,
'C': 100,
'D': 500,
'M': 1000,
}
func parseRoman(s string) (r int, err error) {
if s == "" {
return 0, errors.New("Empty string")
}
is := []rune(s) // easier to convert string up front
var c0 rune // c0: roman character last read
var cv0 int // cv0: value of cv
// the key to the algorithm is to process digits from right to left
for i := len(is) - 1; i >= 0; i-- {
// read roman digit
c := is[i]
k := c == '\u0305' // unicode overbar combining character
if k {
if i == 0 {
return 0, errors.New(
"Overbar combining character invalid at position 0")
}
i--
c = is[i]
}
cv := m[c]
if cv == 0 {
if c == 0x0305 {
return 0, fmt.Errorf(
"Overbar combining character invalid at position %d", i)
} else {
return 0, fmt.Errorf(
"Character unrecognized as Roman digit: %c", c)
}
}
if k {
c = -c // convention indicating overbar
cv *= 1000
}
// handle cases of new, same, subtractive, changed, in that order.
switch {
default: // case 4: digit change
fallthrough
case c0 == 0: // case 1: no previous digit
c0 = c
cv0 = cv
case c == c0: // case 2: same digit
case cv*5 == cv0 || cv*10 == cv0: // case 3: subtractive
// handle next digit as new.
// a subtractive digit doesn't count as a previous digit.
c0 = 0
r -= cv // subtract...
continue // ...instead of adding
}
r += cv // add, in all cases except subtractive
}
return r, nil
}
func main() {
// parse three numbers mentioned in task description
for _, r := range []string{"MCMXC", "MMVIII", "MDCLXVI"} {
v, err := parseRoman(r)
if err != nil {
fmt.Println(err)
} else {
fmt.Println(r, "==", v)
}
}
}

37
Task/Roman-numerals-Decode/Go/roman-numerals-decode-2.go Normal file
View file

@ -0,0 +1,37 @@
package main
import (
"fmt"
)
var m = map[rune]int{
'I': 1,
'V': 5,
'X': 10,
'L': 50,
'C': 100,
'D': 500,
'M': 1000,
}
// function, per task description
func from_roman(roman string) (arabic int) {
last_digit := 1000
for _, r := range roman {
digit := m[r]
if last_digit < digit {
arabic -= 2 * last_digit
}
last_digit = digit
arabic += digit
}
return arabic
}
func main() {
// parse three numbers mentioned in task description
for _, roman_digit := range []string{"MCMXC", "MMVIII", "MDCLXVI"} {
fmt.Printf("%-10s == %d\n", roman_digit, from_roman(roman_digit))
}
}

46
Task/Roman-numerals-Decode/Golo/roman-numerals-decode.golo Normal file
View file

@ -0,0 +1,46 @@
#!/usr/bin/env golosh
----
This module converts a Roman numeral into a decimal number.
----
module Romannumeralsdecode
augment java.lang.Character {
function decode = |this| -> match {
when this == 'I' then 1
when this == 'V' then 5
when this == 'X' then 10
when this == 'L' then 50
when this == 'C' then 100
when this == 'D' then 500
when this == 'M' then 1000
otherwise 0
}
}
augment java.lang.String {
function decode = |this| {
var accumulator = 0
foreach i in [0..this: length()] {
let currentChar = this: charAt(i)
let nextChar = match {
when i + 1 < this: length() then this: charAt(i + 1)
otherwise null
}
if (currentChar: decode() < (nextChar?: decode() orIfNull 0)) {
# if this is something like IV or IX or whatever
accumulator = accumulator - currentChar: decode()
} else {
accumulator = accumulator + currentChar: decode()
}
}
return accumulator
}
}
function main = |args| {
println("MCMXC = " + "MCMXC": decode())
println("MMVIII = " + "MMVIII": decode())
println("MDCLXVI = " + "MDCLXVI": decode())
}

20
Task/Roman-numerals-Decode/Groovy/roman-numerals-decode-1.groovy Normal file
View file

@ -0,0 +1,20 @@
enum RomanDigits {
I(1), V(5), X(10), L(50), C(100), D(500), M(1000);
private magnitude;
private RomanDigits(magnitude) { this.magnitude = magnitude }
String toString() { super.toString() + "=${magnitude}" }
static BigInteger parse(String numeral) {
assert numeral != null && !numeral.empty
def digits = (numeral as List).collect {
RomanDigits.valueOf(it)
}
def L = digits.size()
(0..<L).inject(0g) { total, i ->
def sign = (i == L - 1 || digits[i] >= digits[i+1]) ? 1 : -1
total + sign * digits[i].magnitude
}
}
}

12
Task/Roman-numerals-Decode/Groovy/roman-numerals-decode-2.groovy Normal file
View file

@ -0,0 +1,12 @@
println """
Digit Values = ${RomanDigits.values()}
M => ${RomanDigits.parse('M')}
MCXI => ${RomanDigits.parse('MCXI')}
CMXI => ${RomanDigits.parse('CMXI')}
MCM => ${RomanDigits.parse('MCM')}
MCMXC => ${RomanDigits.parse('MCMXC')}
MMVIII => ${RomanDigits.parse('MMVIII')}
MMIX => ${RomanDigits.parse('MMIX')}
MCDXLIV => ${RomanDigits.parse('MCDXLIV')}
MDCLXVI => ${RomanDigits.parse('MDCLXVI')}
"""

45
Task/Roman-numerals-Decode/Haskell/roman-numerals-decode-1.hs Normal file
View file

@ -0,0 +1,45 @@
module Main where
------------------------
-- DECODER FUNCTION --
------------------------
decodeDigit :: Char -> Int
decodeDigit 'I' = 1
decodeDigit 'V' = 5
decodeDigit 'X' = 10
decodeDigit 'L' = 50
decodeDigit 'C' = 100
decodeDigit 'D' = 500
decodeDigit 'M' = 1000
decodeDigit _ = error "invalid digit"
-- We process a Roman numeral from right to left, digit by digit, adding the value.
-- If a digit is lower than the previous then its value is negative.
-- The first digit is always positive.
decode roman = decodeRoman startValue startValue rest
where
(first:rest) = reverse roman
startValue = decodeDigit first
decodeRoman :: Int -> Int -> [Char] -> Int
decodeRoman lastSum _ [] = lastSum
decodeRoman lastSum lastValue (digit:rest) = decodeRoman updatedSum digitValue rest
where
digitValue = decodeDigit digit
updatedSum = (if digitValue < lastValue then (-) else (+)) lastSum digitValue
------------------
-- TEST SUITE --
------------------
main = do
test "MCMXC" 1990
test "MMVIII" 2008
test "MDCLXVI" 1666
test roman expected = putStrLn (roman ++ " = " ++ (show (arabic)) ++ remark)
where
arabic = decode roman
remark = " (" ++ (if arabic == expected then "PASS" else ("FAIL, expected " ++ (show expected))) ++ ")"

40
Task/Roman-numerals-Decode/Haskell/roman-numerals-decode-2.hs Normal file
View file

@ -0,0 +1,40 @@
module Main where
------------------------
-- DECODER FUNCTION --
------------------------
decodeDigit :: Char -> Int
decodeDigit 'I' = 1
decodeDigit 'V' = 5
decodeDigit 'X' = 10
decodeDigit 'L' = 50
decodeDigit 'C' = 100
decodeDigit 'D' = 500
decodeDigit 'M' = 1000
decodeDigit _ = error "invalid digit"
-- We process a Roman numeral from right to left, digit by digit, adding the value.
-- If a digit is lower than the previous then its value is negative.
-- The first digit is always positive.
decode roman = fst (foldl addValue (0, 0) (reverse roman))
where
addValue (lastSum, lastValue) digit = (updatedSum, value)
where
value = decodeDigit digit;
updatedSum = (if value < lastValue then (-) else (+)) lastSum value
------------------
-- TEST SUITE --
------------------
main = do
test "MCMXC" 1990
test "MMVIII" 2008
test "MDCLXVI" 1666
test roman expected = putStrLn (roman ++ " = " ++ (show (arabic)) ++ remark)
where
arabic = decode roman
remark = " (" ++ (if arabic == expected then "PASS" else ("FAIL, expected " ++ (show expected))) ++ ")"

9
Task/Roman-numerals-Decode/Haskell/roman-numerals-decode-3.hs Normal file
View file

@ -0,0 +1,9 @@
import Data.List (isPrefixOf)
mapping = [("M",1000),("CM",900),("D",500),("CD",400),("C",100),("XC",90),
("L",50),("XL",40),("X",10),("IX",9),("V",5),("IV",4),("I",1)]
toArabic :: String -> Int
toArabic "" = 0
toArabic str = num + toArabic xs
where (num, xs):_ = [ (num, drop (length n) str) | (n,num) <- mapping, isPrefixOf n str ]

39
Task/Roman-numerals-Decode/Haskell/roman-numerals-decode-4.hs Normal file
View file

@ -0,0 +1,39 @@
import Data.Bifunctor (bimap)
import Data.List (isPrefixOf, mapAccumL)
romanValue :: String -> Int
romanValue =
let tr s (k, v) =
until
(not . isPrefixOf k . fst)
(bimap ((drop . length) k) (v +))
(s, 0)
in sum
. snd
. flip
(mapAccumL tr)
[ ("M", 1000),
("CM", 900),
("D", 500),
("CD", 400),
("C", 100),
("XC", 90),
("L", 50),
("XL", 40),
("X", 10),
("IX", 9),
("V", 5),
("IV", 4),
("I", 1)
]
main :: IO ()
main =
mapM_
(print . romanValue)
[ "MDCLXVI",
"MCMXC",
"MMVIII",
"MMXVI",
"MMXVII"
]

65
Task/Roman-numerals-Decode/Haskell/roman-numerals-decode-5.hs Normal file
View file

@ -0,0 +1,65 @@
import Data.List (mapAccumR)
import qualified Data.Map.Strict as M
import Data.Maybe (maybe)
fromRoman :: String -> Maybe Int
fromRoman cs =
let go l r
| l > r = (- r, l)
| otherwise = (r, l)
in traverse (`M.lookup` mapRoman) cs
>>= ( Just . sum . ((:) <$> fst <*> snd)
. mapAccumR go 0
)
mapRoman :: M.Map Char Int
mapRoman =
M.fromList $
zip
"MDCLXVI "
[ 1000,
500,
100,
50,
10,
5,
1,
0
]
--------------------------- TEST -------------------------
main :: IO ()
main =
putStrLn $
fTable
"Decoding Roman numbers:\n"
show
(maybe "Unrecognised character" show)
fromRoman
[ "MDCLXVI",
"MCMXC",
"MMVIII",
"MMXVI",
"MMXVIII",
"MMXBIII"
]
------------------------ FORMATTING ----------------------
fTable ::
String ->
(a -> String) ->
(b -> String) ->
(a -> b) ->
[a] ->
String
fTable s xShow fxShow f xs =
unlines $
s :
fmap
( ((<>) . rjust w ' ' . xShow)
<*> ((" -> " <>) . fxShow . f)
)
xs
where
rjust n c = drop . length <*> (replicate n c <>)
w = maximum (length . xShow <$> xs)

31
Task/Roman-numerals-Decode/Haskell/roman-numerals-decode-6.hs Normal file
View file

@ -0,0 +1,31 @@
import qualified Data.Map.Strict as M
fromRoman :: String -> Int
fromRoman xs = partialSum + lastDigit
where
(partialSum, lastDigit) = foldl accumulate (0, 0) (evalRomanDigit <$> xs)
accumulate (partial, lastDigit) newDigit
| newDigit <= lastDigit = (partial + lastDigit, newDigit)
| otherwise = (partial - lastDigit, newDigit)
mapRoman :: M.Map Char Int
mapRoman =
M.fromList
[ ('I', 1)
, ('V', 5)
, ('X', 10)
, ('L', 50)
, ('C', 100)
, ('D', 500)
, ('M', 1000)
]
evalRomanDigit :: Char -> Int
evalRomanDigit c =
let mInt = M.lookup c mapRoman
in case mInt of
Just x -> x
_ -> error $ c : " is not a roman digit"
main :: IO ()
main = print $ fromRoman <$> ["MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVII"]

59
Task/Roman-numerals-Decode/Haskell/roman-numerals-decode-7.hs Normal file
View file

@ -0,0 +1,59 @@
import qualified Data.Map.Strict as M
import Data.Maybe (maybe)
------------------ ROMAN NUMERALS DECODED ----------------
mapRoman :: M.Map Char Int
mapRoman =
M.fromList $
zip "IVXLCDM" $
scanl (*) 1 (cycle [5, 2])
fromRoman :: String -> Maybe Int
fromRoman cs =
let op l r
| l >= r = (+)
| otherwise = (-)
in snd
. foldr
(\l (r, n) -> (l, op l r n l))
(0, 0)
<$> traverse (`M.lookup` mapRoman) cs
--------------------------- TEST -------------------------
main :: IO ()
main =
putStrLn $
fTable
"Roman numeral decoding as a right fold:\n"
show
(maybe "(Unrecognised character seen)" show)
fromRoman
[ "MDCLXVI",
"MCMXC",
"MMVIII",
"MMXVI",
"MMXVII",
"QQXVII"
]
------------------------ FORMATTING ----------------------
fTable ::
String ->
(a -> String) ->
(b -> String) ->
(a -> b) ->
[a] ->
String
fTable s xShow fxShow f xs =
unlines $
s :
fmap
( ((<>) . rjust w ' ' . xShow)
<*> ((" -> " <>) . fxShow . f)
)
xs
where
rjust n c = drop . length <*> (replicate n c <>)
w = maximum (length . xShow <$> xs)

39
Task/Roman-numerals-Decode/Haskell/roman-numerals-decode-8.hs Normal file
View file

@ -0,0 +1,39 @@
import qualified Data.Map.Strict as M (Map, fromList, lookup)
import Data.Maybe (isNothing, isJust, fromJust, catMaybes)
import Data.List (mapAccumL)
mapRoman :: M.Map String Int
mapRoman =
M.fromList
[ ("M", 1000)
, ("CM", 900)
, ("D", 500)
, ("CD", 400)
, ("C", 100)
, ("XC", 90)
, ("L", 50)
, ("XL", 40)
, ("X", 10)
, ("IX", 9)
, ("V", 5)
, ("IV", 4)
, ("I", 1)
]
fromRoman :: String -> Int
fromRoman s =
let value k = M.lookup k mapRoman
in sum . catMaybes . snd $
mapAccumL
(\mi (l, r, i) ->
let mValue = value [l, r] -- mapRoman lookup of [left, right] Chars
(lastPair, pairValue)
| isJust mValue = (Just i, mValue) -- Pair match: index updated
| isNothing mi || i - fromJust mi > 1 = (mi, value [l])
| otherwise = (mi, Nothing) -- Left Char was counted in pair
in (lastPair, pairValue))
Nothing -- Accumulator – maybe Index to last matched Char pair
(zip3 s (tail s ++ " ") [0 ..]) -- Indexed character pairs
main :: IO ()
main = print $ fromRoman <$> ["MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVII"]

49
Task/Roman-numerals-Decode/Hoon/roman-numerals-decode-1.hoon Normal file
View file

@ -0,0 +1,49 @@
|%
++ parse
|= t=tape ^- @ud
=. t (cass t)
=| result=@ud
|-
?~ t result
?~ t.t (add result (from-numeral i.t))
=+ [a=(from-numeral i.t) b=(from-numeral i.t.t)]
?: (gte a b) $(result (add result a), t t.t)
$(result (sub (add result b) a), t t.t.t)
++ yield
|= n=@ud ^- tape
=| result=tape
=/ values to-numeral
|-
?~ values result
?: (gte n -.i.values)
$(result (weld result +.i.values), n (sub n -.i.values))
$(values t.values)
++ from-numeral
|= c=@t ^- @ud
?: =(c 'i') 1
?: =(c 'v') 5
?: =(c 'x') 10
?: =(c 'l') 50
?: =(c 'c') 100
?: =(c 'd') 500
?: =(c 'm') 1.000
!!
++ to-numeral
^- (list [@ud tape])
:*
[1.000 "m"]
[900 "cm"]
[500 "d"]
[400 "cd"]
[100 "c"]
[90 "xc"]
[50 "l"]
[40 "xl"]
[10 "x"]
[9 "ix"]
[5 "v"]
[4 "iv"]
[1 "i"]
~
==
--

9
Task/Roman-numerals-Decode/Hoon/roman-numerals-decode-2.hoon Normal file
View file

@ -0,0 +1,9 @@
/+ *roman
:- %say
|= [* [x=$%([%from-roman tape] [%to-roman @ud]) ~] ~]
:- %noun
^- tape
?- -.x
%from-roman "{<(parse +.x)>}"
%to-roman (yield +.x)
==

6
Task/Roman-numerals-Decode/Icon/roman-numerals-decode-1.icon Normal file
View file

@ -0,0 +1,6 @@
link numbers
procedure main()
every R := "MCMXC"|"MDCLXVI"|"MMVIII" do
write(R, " = ",unroman(R))
end

20
Task/Roman-numerals-Decode/Icon/roman-numerals-decode-2.icon Normal file
View file

@ -0,0 +1,20 @@
procedure unroman(s) #: convert Roman numeral to integer
local nbr,lastVal,val
nbr := lastVal := 0
s ? {
while val := case map(move(1)) of {
"m": 1000
"d": 500
"c": 100
"l": 50
"x": 10
"v": 5
"i": 1
} do {
nbr +:= if val <= lastVal then val else val - 2 * lastVal
lastVal := val
}
}
return nbr
end

1
Task/Roman-numerals-Decode/J/roman-numerals-decode-1.j Normal file
View file

@ -0,0 +1 @@
rom2d=: [: (+/ .* _1^ 0,~ 2</\ ]) 1 5 10 50 100 500 1000 {~ 'IVXLCDM'&i.

6
Task/Roman-numerals-Decode/J/roman-numerals-decode-2.j Normal file
View file

@ -0,0 +1,6 @@
rom2d 'MCMXC'
1990
rom2d 'MDCLXVI'
1666
rom2d 'MMVIII'
2008

37
Task/Roman-numerals-Decode/Java/roman-numerals-decode-1.java Normal file
View file

@ -0,0 +1,37 @@
public class Roman {
private static int decodeSingle(char letter) {
switch(letter) {
case 'M': return 1000;
case 'D': return 500;
case 'C': return 100;
case 'L': return 50;
case 'X': return 10;
case 'V': return 5;
case 'I': return 1;
default: return 0;
}
}
public static int decode(String roman) {
int result = 0;
String uRoman = roman.toUpperCase(); //case-insensitive
for(int i = 0;i < uRoman.length() - 1;i++) {//loop over all but the last character
//if this character has a lower value than the next character
if (decodeSingle(uRoman.charAt(i)) < decodeSingle(uRoman.charAt(i+1))) {
//subtract it
result -= decodeSingle(uRoman.charAt(i));
} else {
//add it
result += decodeSingle(uRoman.charAt(i));
}
}
//decode the last character, which is always added
result += decodeSingle(uRoman.charAt(uRoman.length()-1));
return result;
}
public static void main(String[] args) {
System.out.println(decode("MCMXC")); //1990
System.out.println(decode("MMVIII")); //2008
System.out.println(decode("MDCLXVI")); //1666
}
}

59
Task/Roman-numerals-Decode/Java/roman-numerals-decode-2.java Normal file
View file

@ -0,0 +1,59 @@
import java.util.Set;
import java.util.EnumSet;
import java.util.Collections;
import java.util.stream.Collectors;
import java.util.stream.LongStream;
public interface RomanNumerals {
public enum Numeral {
M(1000), CM(900), D(500), CD(400), C(100), XC(90), L(50), XL(40), X(10), IX(9), V(5), IV(4), I(1);
public final long weight;
private static final Set<Numeral> SET = Collections.unmodifiableSet(EnumSet.allOf(Numeral.class));
private Numeral(long weight) {
this.weight = weight;
}
public static Numeral getLargest(long weight) {
return SET.stream()
.filter(numeral -> weight >= numeral.weight)
.findFirst()
.orElse(I)
;
}
};
public static String encode(long n) {
return LongStream.iterate(n, l -> l - Numeral.getLargest(l).weight)
.limit(Numeral.values().length)
.filter(l -> l > 0)
.mapToObj(Numeral::getLargest)
.map(String::valueOf)
.collect(Collectors.joining())
;
}
public static long decode(String roman) {
long result = new StringBuilder(roman.toUpperCase()).reverse().chars()
.mapToObj(c -> Character.toString((char) c))
.map(numeral -> Enum.valueOf(Numeral.class, numeral))
.mapToLong(numeral -> numeral.weight)
.reduce(0, (a, b) -> a + (a <= b ? b : -b))
;
if (roman.charAt(0) == roman.charAt(1)) {
result += 2 * Enum.valueOf(Numeral.class, roman.substring(0, 1)).weight;
}
return result;
}
public static void test(long n) {
System.out.println(n + " = " + encode(n));
System.out.println(encode(n) + " = " + decode(encode(n)));
}
public static void main(String[] args) {
LongStream.of(1999, 25, 944).forEach(RomanNumerals::test);
}
}

26
Task/Roman-numerals-Decode/JavaScript/roman-numerals-decode-1.js Normal file
View file

@ -0,0 +1,26 @@
var Roman = {
Values: [['CM', 900], ['CD', 400], ['XC', 90], ['XL', 40], ['IV', 4],
['IX', 9], ['V', 5], ['X', 10], ['L', 50],
['C', 100], ['M', 1000], ['I', 1], ['D', 500]],
UnmappedStr : 'Q',
parse: function(str) {
var result = 0
for (var i=0; i<Roman.Values.length; ++i) {
var pair = Roman.Values[i]
var key = pair[0]
var value = pair[1]
var regex = RegExp(key)
while (str.match(regex)) {
result += value
str = str.replace(regex, Roman.UnmappedStr)
}
}
return result
}
}
var test_data = ['MCMXC', 'MDCLXVI', 'MMVIII']
for (var i=0; i<test_data.length; ++i) {
var test_datum = test_data[i]
print(test_datum + ": " + Roman.parse(test_datum))
}

48
Task/Roman-numerals-Decode/JavaScript/roman-numerals-decode-2.js Normal file
View file

@ -0,0 +1,48 @@
(function (lstTest) {
var mapping = [["M", 1000], ["CM", 900], ["D", 500], ["CD", 400], ["C", 100], [
"XC", 90], ["L", 50], ["XL", 40], ["X", 10], ["IX", 9], ["V", 5], ["IV",
4], ["I", 1]];
// s -> n
function romanValue(s) {
// recursion over list of characters
// [c] -> n
function toArabic(lst) {
return lst.length ? function (xs) {
var lstParse = chain(mapping, function (lstPair) {
return isPrefixOf(
lstPair[0], xs
) ? [lstPair[1], drop(lstPair[0].length, xs)] : []
});
return lstParse[0] + toArabic(lstParse[1]);
}(lst) : 0
}
return toArabic(s.split(''));
}
// Monadic bind (chain) for lists
function chain(xs, f) {
return [].concat.apply([], xs.map(f));
}
// [a] -> [a] -> Bool
function isPrefixOf(lstFirst, lstSecond) {
return lstFirst.length ? (
lstSecond.length ?
lstFirst[0] === lstSecond[0] && isPrefixOf(
lstFirst.slice(1), lstSecond.slice(1)
) : false
) : true;
}
// Int -> [a] -> [a]
function drop(n, lst) {
return n <= 0 ? lst : (
lst.length ? drop(n - 1, lst.slice(1)) : []
);
}
return lstTest.map(romanValue);
})(['MCMXC', 'MDCLXVI', 'MMVIII']);

1
Task/Roman-numerals-Decode/JavaScript/roman-numerals-decode-3.js Normal file
View file

@ -0,0 +1 @@
[1990, 1666, 2008]

31
Task/Roman-numerals-Decode/JavaScript/roman-numerals-decode-4.js Normal file
View file

@ -0,0 +1,31 @@
(function (lstTest) {
function romanValue(s) {
return s.length ? function () {
var parse = [].concat.apply([], glyphs.map(function (g) {
return 0 === s.indexOf(g) ? [trans[g], s.substr(g.length)] : [];
}));
return parse[0] + romanValue(parse[1]);
}() : 0;
}
var trans = {
M: 1E3,
CM: 900,
D: 500,
CD: 400,
C: 100,
XC: 90,
L: 50,
XL: 40,
X: 10,
IX: 9,
V: 5,
IV: 4,
I: 1
},
glyphs = Object.keys(trans);
return lstTest.map(romanValue);
})(["MCMXC", "MDCLXVI", "MMVIII", "MMMM"]);

1
Task/Roman-numerals-Decode/JavaScript/roman-numerals-decode-5.js Normal file
View file

@ -0,0 +1 @@
[1990, 1666, 2008]

35
Task/Roman-numerals-Decode/JavaScript/roman-numerals-decode-6.js Normal file
View file

@ -0,0 +1,35 @@
(() => {
// romanValue :: String -> Int
const romanValue = s =>
s.length ? (() => {
const parse = [].concat(
...glyphs.map(g => 0 === s.indexOf(g) ? (
[dctTrans[g], s.substr(g.length)]
) : [])
);
return parse[0] + romanValue(parse[1]);
})() : 0;
// dctTrans :: {romanKey: Integer}
const dctTrans = {
M: 1E3,
CM: 900,
D: 500,
CD: 400,
C: 100,
XC: 90,
L: 50,
XL: 40,
X: 10,
IX: 9,
V: 5,
IV: 4,
I: 1
};
// glyphs :: [romanKey]
const glyphs = Object.keys(dctTrans);
// TEST -------------------------------------------------------------------
return ["MCMXC", "MDCLXVI", "MMVIII", "MMMM"].map(romanValue);
})();

1
Task/Roman-numerals-Decode/JavaScript/roman-numerals-decode-7.js Normal file
View file

@ -0,0 +1 @@
[1990,1666,2008,4000]

56
Task/Roman-numerals-Decode/JavaScript/roman-numerals-decode-8.js Normal file
View file

@ -0,0 +1,56 @@
(() => {
// -------------- ROMAN NUMERALS DECODED ---------------
// Folding from right to left,
// lower leftward characters are subtracted,
// others are added.
// fromRoman :: String -> Int
const fromRoman = s =>
foldr(l => ([r, n]) => [
l,
l >= r ? (
n + l
) : n - l
])([0, 0])(
[...s].map(charVal)
)[1];
// charVal :: Char -> Maybe Int
const charVal = k => {
const v = {
I: 1,
V: 5,
X: 10,
L: 50,
C: 100,
D: 500,
M: 1000
} [k];
return v !== undefined ? v : 0;
};
// ----------------------- TEST ------------------------
const main = () => [
'MDCLXVI', 'MCMXC', 'MMVIII', 'MMXVI', 'MMXVII'
]
.map(fromRoman)
.join('\n');
// ----------------- GENERIC FUNCTIONS -----------------
// foldr :: (a -> b -> b) -> b -> [a] -> b
const foldr = f =>
// Note that that the Haskell signature of foldr
// differs from that of foldl - the positions of
// accumulator and current value are reversed.
a => xs => [...xs].reduceRight(
(a, x) => f(x)(a),
a
);
// MAIN ---
return main();
})();

20
Task/Roman-numerals-Decode/Jq/roman-numerals-decode-1.jq Normal file
View file

@ -0,0 +1,20 @@
def fromRoman:
def addRoman(n):
if length == 0 then n
elif startswith("M") then .[1:] | addRoman(1000 + n)
elif startswith("CM") then .[2:] | addRoman(900 + n)
elif startswith("D") then .[1:] | addRoman(500 + n)
elif startswith("CD") then .[2:] | addRoman(400 + n)
elif startswith("C") then .[1:] | addRoman(100 + n)
elif startswith("XC") then .[2:] | addRoman(90 + n)
elif startswith("L") then .[1:] | addRoman(50 + n)
elif startswith("XL") then .[2:] | addRoman(40 + n)
elif startswith("X") then .[1:] | addRoman(10 + n)
elif startswith("IX") then .[2:] | addRoman(9 + n)
elif startswith("V") then .[1:] | addRoman(5 + n)
elif startswith("IV") then .[2:] | addRoman(4 + n)
elif startswith("I") then .[1:] | addRoman(1 + n)
else
error("invalid Roman numeral: " + tostring)
end;
addRoman(0);

1
Task/Roman-numerals-Decode/Jq/roman-numerals-decode-2.jq Normal file
View file

@ -0,0 +1 @@
[ "MCMXC", "MMVIII", "MDCLXVI" ] | map("\(.) => \(fromRoman)") | .[]

4
Task/Roman-numerals-Decode/Jq/roman-numerals-decode-3.jq Normal file
View file

@ -0,0 +1,4 @@
$ jq -n -f -r fromRoman.jq
MCMXC => 1990
MMVIII => 2008
MDCLXVI => 1666

19
Task/Roman-numerals-Decode/Julia/roman-numerals-decode-1.julia Normal file
View file

@ -0,0 +1,19 @@
function parseroman(rnum::AbstractString)
romandigits = Dict('I' => 1, 'V' => 5, 'X' => 10, 'L' => 50,
'C' => 100, 'D' => 500, 'M' => 1000)
mval = accm = 0
for d in reverse(uppercase(rnum))
val = try
romandigits[d]
catch
throw(DomainError())
end
if val > mval maxval = val end
if val < mval
accm -= val
else
accm += val
end
end
return accm
end

8
Task/Roman-numerals-Decode/Julia/roman-numerals-decode-2.julia Normal file
View file

@ -0,0 +1,8 @@
using Printf
test = ["I", "III", "IX", "IVI", "IIM",
"CMMDXL", "icv", "cDxLiV", "MCMLD", "ccccccd",
"iiiiiv", "MMXV", "MCMLXXXIV", "ivxmm", "SPQR"]
for rnum in test
@printf("%15s → %s\n", rnum, try parseroman(rnum) catch "not valid" end)
end

1
Task/Roman-numerals-Decode/K/roman-numerals-decode-1.k Normal file
View file

@ -0,0 +1 @@
romd: {v:1 5 10 50 100 500 1000@"IVXLCDM"?/:x; +/v*_-1^(>':v),0}

2
Task/Roman-numerals-Decode/K/roman-numerals-decode-2.k Normal file
View file

@ -0,0 +1,2 @@
romd'("MCMXC";"MMVIII";"MDCLXVI")
1990 2008 1666

Some files were not shown because too many files have changed in this diff Show more