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

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

4
Task/Roman-numerals-Encode/00-META.yaml Normal file
View file

@ -0,0 +1,4 @@
---
category:
- String_manipulation
from: http://rosettacode.org/wiki/Roman_numerals/Encode

10
Task/Roman-numerals-Encode/00-TASK.txt Normal file
View file

@ -0,0 +1,10 @@
;Task:
Create a function taking a positive integer as its parameter and returning a string containing the Roman numeral representation of that integer. Modern Roman numerals are written by expressing each digit separately, starting with the left most digit and skipping any digit with a value of zero.
In Roman numerals:
* 1990 is rendered: 1000=M, 900=CM, 90=XC; resulting in MCMXC
* 2008 is written as 2000=MM, 8=VIII; or MMVIII
* 1666 uses each Roman symbol in descending order: MDCLXVI
<br><br>

15
Task/Roman-numerals-Encode/11l/roman-numerals-encode.11l Normal file
View file

@ -0,0 +1,15 @@
V anums = [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]
V rnums = ‘M CM D CD C XC L XL X IX V IV I’.split(‘ ’)
F to_roman(=x)
V ret = ‘’
L(a, r) zip(:anums, :rnums)
(V n, x) = divmod(x, a)
ret ‘’= r * n
R ret
V test = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 25, 30, 40,
50, 60, 69, 70, 80, 90, 99, 100, 200, 300, 400, 500, 600, 666, 700, 800, 900, 1000,
1009, 1444, 1666, 1945, 1997, 1999, 2000, 2008, 2010, 2011, 2500, 3000, 3999]
L(val) test
print(val‘ - ’to_roman(val))

52
Task/Roman-numerals-Encode/360-Assembly/roman-numerals-encode.360 Normal file
View file

@ -0,0 +1,52 @@
* Roman numerals Encode - 11/05/2020
ROMAENC CSECT
USING ROMAENC,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(8)) do i=1 to hbound(nums)
LR R1,R6 i
SLA R1,1 ~
LH R8,NUMS-2(R1) n=nums(i)
MVC PG,=CL80'.... :' clear buffer
LA R9,PG @pg
XDECO R8,XDEC edit n
MVC 0(4,R9),XDEC+8 output n
LA R9,7(R9) @pg+=7
LA R7,1 j=1
DO WHILE=(C,R7,LE,=A(13)) do j=1 to 13
LR R1,R7 j
SLA R1,1 ~
LH R3,ARABIC-2(R1) aj=arabic(j)
DO WHILE=(CR,R8,GE,R3) while n>=aj
LR R1,R7 j
SLA R1,1 ~
LA R4,ROMAN-2(R1) roman(j)
MVC 0(2,R9),0(R4) output roman(j)
IF CLI,1(R9),NE,C' ' THEN if roman(j)[2]=' ' then
LA R9,2(R9) @pg+=2
ELSE , else
LA R9,1(R9) @pg+=1
ENDIF , endif
SR R8,R3 n-=aj
ENDDO , endwile
LA R7,1(R7) j++
ENDDO , enddo j
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 save
ARABIC DC H'1000',H'900',H'500',H'400',H'100',H'90'
DC H'50',H'40',H'10',H'9',H'5',H'4',H'1'
ROMAN DC CL2'M',CL2'CM',CL2'D',CL2'CD',CL2'C',CL2'XC'
DC CL2'L',CL2'XL',CL2'X',CL2'IX',CL2'V',CL2'IV',CL2'I'
NUMS DC H'14',H'16',H'21',H'888',H'1492',H'1999',H'2020',H'3999'
PG DS CL80 buffer
XDEC DS CL12 temp for xdeco
REGEQU
END ROMAENC

99
Task/Roman-numerals-Encode/8080-Assembly/roman-numerals-encode.8080 Normal file
View file

@ -0,0 +1,99 @@
org 100h
jmp test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Takes a 16-bit integer in HL, and stores it
;; as a 0-terminated string starting at BC.
;; On exit, all registers destroyed; BC pointing at
;; end of string.
mkroman: push h ; put input on stack
lxi h,mkromantab
mkromandgt: mov a,m ; scan ahead to next entry
ana a
inx h
jnz mkromandgt
xthl ; load number
mov a,h ; if zero, we're done
ora l
jz mkromandone
xthl ; load next entry from table
mov e,m ; de = number
inx h
mov d,m
inx h
xthl ; load number
xra a ; find how many we need
subtract: inr a ; with trial subtraction
dad d
jc subtract
push psw ; keep counter
mov a,d ; we subtracted one too many
cma ; so we need to add one back
mov d,a
mov a,e
cma
mov e,a
inx d
dad d
pop d ; restore counter (into D)
xthl ; load table pointer
stringouter: dcr d ; do we need to include one?
jz mkromandgt
push h ; keep string location
stringinner: mov a,m ; copy string into target
stax b
ana a ; done yet?
jz stringdone
inx h
inx b ; copy next character
jmp stringinner
stringdone: pop h ; restore string location
jmp stringouter
mkromandone: pop d ; remove temporary variable from stack
ret
mkromantab: db 0
db 18h,0fch,'M',0 ; The value for each entry
db 7ch,0fch,'CM',0 ; is stored already negated
db 0ch,0feh,'D',0 ; so that it can be immediately
db 70h,0feh,'CD',0 ; added using `dad'.
db 9ch,0ffh,'C',0 ; This also has the convenient
db 0a6h,0ffh,'XC',0 ; property of not having any
db 0ceh,0ffh,'L',0 ; zero bytes except the string
db 0d8h,0ffh,'XL',0 ; and row terminators.
db 0f6h,0ffh,'X',0
db 0f7h,0ffh,'IX',0
db 0fbh,0ffh,'V',0
db 0fch,0ffh,'IV',0
db 0ffh,0ffh,'I',0
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test code
test: mvi c,10 ; read string from console
lxi d,dgtbufdef
call 5
lxi h,0 ; convert to integer
lxi b,dgtbuf
readdgt: ldax b
ana a
jz convert
dad h ; hl *= 10
mov d,h
mov e,l
dad h
dad h
dad d
sui '0'
mov e,a
mvi d,0
dad d
inx b
jmp readdgt
convert: lxi b,romanbuf ; convert to roman
call mkroman
mvi a,'$' ; switch string terminator
stax b
mvi c,9 ; output result
lxi d,romanbuf
jmp 5
nl: db 13,10,'$'
dgtbufdef: db 5,0
dgtbuf: ds 6
romanbuf:

30
Task/Roman-numerals-Encode/8086-Assembly/roman-numerals-encode-1.8086 Normal file
View file

@ -0,0 +1,30 @@
mov ax,0070h
call EncodeRoman
mov si,offset StringRam
call PrintString
call NewLine
mov ax,1776h
call EncodeRoman
mov si,offset StringRam
call PrintString
call NewLine
mov ax,2021h
call EncodeRoman
mov si,offset StringRam
call PrintString
call NewLine
mov ax,3999h
call EncodeRoman
mov si,offset StringRam
call PrintString
call NewLine
mov ax,4000h
call EncodeRoman
mov si,offset StringRam
ReturnToDos ;macro that calls the int that exits dos

174
Task/Roman-numerals-Encode/8086-Assembly/roman-numerals-encode-2.8086 Normal file
View file

@ -0,0 +1,174 @@
;ROMAN NUMERALS MODULE
EncodeRoman:
;takes a BCD value in AX and stores its Roman numeral equivalent in ram.
call UnpackBCD
cmp dh,03h
jng continue_EncodeRoman
;roman numerals only go up to 3999.
jmp errorhandler_encodeRoman_inputTooBig
continue_EncodeRoman:
mov si,offset StringRam
;using SI as destination of roman numerals.
push ax
push cx
mov ch,0
mov cl,dh ;loop counter
cmp dh,0
jz skipThousands
encodeRoman_handleThousands:
mov al,"M"
mov [ds:si],al ;store in string ram
inc si
; call PrintChar
loop encodeRoman_handleThousands
skipThousands:
pop cx
pop ax
encodeRoman_HandleHundreds:
pushall
mov bh,0
mov bl,dl ;use bx as an offset into Roman_Lookup_Master
SHL bl,1
SHL bl,1 ;multiply by 2, we are indexing into a table with 4 bytes per row.
mov di,offset Roman_Lookup_Master
mov cx,4
getChar_Hundreds:
mov al,[bx+es:di] ;get first char index
push bx
push di
mov di,offset Roman_Hund
mov bl,al
mov al,[bx+es:di]
cmp al,0
jz skipNullChar_RomanHund
mov [ds:si],al ;store in ram
inc si
; call PrintChar
skipNullChar_RomanHund:
pop di
pop bx
inc di
loop getChar_Hundreds
popall
encodeRoman_HandleTens:
pushall
mov bh,0
mov bl,ah ;use bx as an offset into Roman_Lookup_Master
SHL bl,1
SHL bl,1 ;multiply by 2, we are indexing into a table with 4 bytes per row.
mov di,offset Roman_Lookup_Master
mov cx,4
getChar_Tens:
mov al,[bx+es:di] ;get first char index
push bx
push di
mov di,offset Roman_Tens
mov bl,al
mov al,[bx+es:di]
cmp al,0
jz skipNullChar_RomanTens
mov [ds:si],al ;store in ram
inc si
; call PrintChar
skipNullChar_RomanTens:
pop di
pop bx
inc di
loop getChar_Tens
popall
encodeRoman_HandleOnes:
pushall
mov bh,0
mov bl,al ;use bx as an offset into Roman_Lookup_Master
SHL bl,1
SHL bl,1 ;multiply by 2, we are indexing into a table with 4 bytes per row.
mov di,offset Roman_Lookup_Master
mov cx,4
getChar_Ones:
mov al,[bx+es:di] ;get first char index
push bx
push di
mov di,offset Roman_Ones
mov bl,al
mov al,[bx+es:di]
cmp al,0
jz skipNullChar_RomanOnes
mov [ds:si],al ;store in ram
inc si
; call PrintChar
skipNullChar_RomanOnes:
pop di
pop bx
inc di
loop getChar_Ones
popall
mov al,0
mov [ds:si],al ;place a null terminator at the end of the string.
ret
errorhandler_encodeRoman_inputTooBig:
push ds
push ax
LoadSegment ds,ax,@data
mov al,01h
mov byte ptr [ds:error_code],al
mov ax, offset EncodeRoman
mov word ptr [ds:error_routine],ax
LoadSegment ds,ax,@code
mov si,offset Roman_Error
call PrintString
pop ax
pop ds
stc ;set carry, allowing program to branch if error occurred.
ret
Roman_Lookup_Master db 0,0,0,0 ;0
db 0,0,0,1 ;1
db 0,0,1,1 ;2
db 0,1,1,1 ;3
db 0,0,1,2 ;4
db 0,0,0,2 ;5
db 0,0,2,1 ;6
db 0,2,1,1 ;7
db 2,1,1,1 ;8
db 0,0,1,3 ;9
Roman_Ones db 0,"IVX" ;the same pattern is used regardless of what power of 10 we're working with
Roman_Tens db 0,"XLC"
Roman_Hund db 0,"CDM"
Roman_Error db "ERROR: BAD INPUT",0
UnpackBCD:
;converts a "packed" BCD value in AX to an "unpacked" value in DX.AX
;DX is the high byte, AX is the low byte.
;CLOBBERS DX AND AX.
mov dx,0
mov dl,ah
mov ah,0
push cx
mov cl,4
rol dx,cl
;BEFORE: DX = 00XYh
;AFTER: DX = 0XY0h
ror dl,cl ;DX = 0X0Yh
rol ax,cl
;BEFORE: AX = 00XYh
;AFTER: AX = 0XY0h
ror al,cl ;AX = 0X0Yh
pop cx
ret

20
Task/Roman-numerals-Encode/8086-Assembly/roman-numerals-encode-3.8086 Normal file
View file

@ -0,0 +1,20 @@
pushall macro
push ax
push bx
push cx
push dx
push ds
push es
push di
;I forgot SI in this macro, but once you add it in the code stops working! So I left it out.
endm
popall macro
pop di
pop es
pop ds
pop dx
pop cx
pop bx
pop ax
endm

29
Task/Roman-numerals-Encode/ALGOL-68/roman-numerals-encode.alg Normal file
View file

@ -0,0 +1,29 @@
[]CHAR roman = "MDCLXVmdclxvi"; # UPPERCASE for thousands #
[]CHAR adjust roman = "CCXXmmccxxii";
[]INT arabic = (1000000, 500000, 100000, 50000, 10000, 5000, 1000, 500, 100, 50, 10, 5, 1);
[]INT adjust arabic = (100000, 100000, 10000, 10000, 1000, 1000, 100, 100, 10, 10, 1, 1, 0);
PROC arabic to roman = (INT dclxvi)STRING: (
INT in := dclxvi; # 666 #
STRING out := "";
FOR scale TO UPB roman WHILE in /= 0 DO
INT multiples = in OVER arabic[scale];
in -:= arabic[scale] * multiples;
out +:= roman[scale] * multiples;
IF in >= -adjust arabic[scale] + arabic[scale] THEN
in -:= -adjust arabic[scale] + arabic[scale];
out +:= adjust roman[scale] + roman[scale]
FI
OD;
out
);
main:(
[]INT test = (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,25,30,40,50,60,69,70,
80,90,99,100,200,300,400,500,600,666,700,800,900,1000,1009,1444,1666,1945,1997,1999,
2000,2008,2500,3000,4000,4999,5000,6666,10000,50000,100000,500000,1000000,max int);
FOR key TO UPB test DO
INT val = test[key];
print((val, " - ", arabic to roman(val), new line))
OD
)

51
Task/Roman-numerals-Encode/ALGOL-W/roman-numerals-encode.alg Normal file
View file

@ -0,0 +1,51 @@
BEGIN
PROCEDURE ROMAN (INTEGER VALUE NUMBER; STRING(15) RESULT CHARACTERS; INTEGER RESULT LENGTH);
COMMENT
Returns the Roman number of an integer between 1 and 3999.
"MMMDCCCLXXXVIII" (15 characters long) is the longest Roman number under 4000;
BEGIN
INTEGER PLACE, POWER;
PROCEDURE APPEND (STRING(1) VALUE C);
BEGIN CHARACTERS(LENGTH|1) := C; LENGTH := LENGTH + 1 END;
PROCEDURE I; APPEND(CASE PLACE OF ("I","X","C","M"));
PROCEDURE V; APPEND(CASE PLACE OF ("V","L","D"));
PROCEDURE X; APPEND(CASE PLACE OF ("X","C","M"));
ASSERT (NUMBER >= 1) AND (NUMBER < 4000);
CHARACTERS := " ";
LENGTH := 0;
POWER := 1000;
PLACE := 4;
WHILE PLACE > 0 DO
BEGIN
CASE NUMBER DIV POWER + 1 OF BEGIN
BEGIN END;
BEGIN I END;
BEGIN I; I END;
BEGIN I; I; I END;
BEGIN I; V END;
BEGIN V END;
BEGIN V; I END;
BEGIN V; I; I END;
BEGIN V; I; I; I END;
BEGIN I; X END
END;
NUMBER := NUMBER REM POWER;
POWER := POWER DIV 10;
PLACE := PLACE - 1
END
END ROMAN;
INTEGER I;
STRING(15) S;
ROMAN(1, S, I); WRITE(S, I);
ROMAN(3999, S, I); WRITE(S, I);
ROMAN(3888, S, I); WRITE(S, I);
ROMAN(2009, S, I); WRITE(S, I);
ROMAN(405, S, I); WRITE(S, I);
END.

10
Task/Roman-numerals-Encode/APL/roman-numerals-encode.apl Normal file
View file

@ -0,0 +1,10 @@
toRoman←{
⍝ Digits and corresponding values
ds←((⊢≠⊃)⊆⊢)' M CM D CD C XC L XL X IX V IV I'
vs←1000, ,100 10 1∘.×9 5 4 1
⍝ Input ≤ 0 is invalid
⍵≤0:⎕SIGNAL 11
{ 0=d←⊃⍸vs≤⍵:⍬ ⍝ Find highest digit in number
(d⊃ds),∇⍵-d⊃vs ⍝ While one exists, add it and subtract from number
}⍵
}

41
Task/Roman-numerals-Encode/ASIC/roman-numerals-encode.asic Normal file
View file

@ -0,0 +1,41 @@
REM Roman numerals/Encode
DIM Weights(12)
DIM Symbols$(12)
DATA 1000, "M", 900, "CM", 500, "D", 400, "CD", 100, "C", 90, "XC", 50, "L"
DATA 40, "XL", 10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I"
REM 3888 or MMMDCCCLXXXVIII (15 chars) is the longest string properly encoded
REM with these symbols.
FOR J = 0 TO 12
READ Weights(J)
READ Symbols$(J)
NEXT J
AValue = 1990
GOSUB ToRoman:
PRINT Roman$
REM MCMXC
AValue = 2022
GOSUB ToRoman:
PRINT Roman$
REM MMXXII
AValue = 3888
GOSUB ToRoman:
PRINT Roman$
REM MMMDCCCLXXXVIII
END
ToRoman:
REM Result: Roman$
Roman$ = ""
I = 0
Loop:
IF (I > 12 THEN ExitToRoman:
IF AValue <= 0 THEN ExitToRoman:
WHILE AValue >= Weights(I)
Roman$ = Roman$ + Symbols$(I)
AValue = AValue - Weights(I)
WEND
I = I + 1
GOTO Loop:
ExitToRoman:
RETURN

26
Task/Roman-numerals-Encode/AWK/roman-numerals-encode.awk Normal file
View file

@ -0,0 +1,26 @@
# syntax: GAWK -f ROMAN_NUMERALS_ENCODE.AWK
BEGIN {
leng = split("1990 2008 1666",arr," ")
for (i=1; i<=leng; i++) {
n = arr[i]
printf("%s = %s\n",n,dec2roman(n))
}
exit(0)
}
function dec2roman(number, v,w,x,y,roman1,roman10,roman100,roman1000) {
number = int(number) # force to integer
if (number < 1 || number > 3999) { # number is too small | big
return
}
split("I II III IV V VI VII VIII IX",roman1," ") # 1 2 ... 9
split("X XX XXX XL L LX LXX LXXX XC",roman10," ") # 10 20 ... 90
split("C CC CCC CD D DC DCC DCCC CM",roman100," ") # 100 200 ... 900
split("M MM MMM",roman1000," ") # 1000 2000 3000
v = (number - (number % 1000)) / 1000
number = number % 1000
w = (number - (number % 100)) / 100
number = number % 100
x = (number - (number % 10)) / 10
y = number % 10
return(roman1000[v] roman100[w] roman10[x] roman1[y])
}

40
Task/Roman-numerals-Encode/Action-/roman-numerals-encode.action Normal file
View file

@ -0,0 +1,40 @@
DEFINE PTR="CARD"
CARD ARRAY arabic=[1000 900 500 400 100 90 50 40 10 9 5 4 1]
PTR ARRAY roman(13)
PROC InitRoman()
roman(0)="M" roman(1)="CM" roman(2)="D" roman(3)="CD"
roman(4)="C" roman(5)="XC" roman(6)="L" roman(7)="XL"
roman(8)="X" roman(9)="IX" roman(10)="V" roman(11)="IV" roman(12)="I"
RETURN
PROC EncodeRomanNumber(CARD n CHAR ARRAY res)
BYTE i,len
CHAR ARRAY tmp
res(0)=0 len=0
FOR i=0 TO 12
DO
WHILE arabic(i)<=n
DO
tmp=roman(i)
SAssign(res,tmp,len+1,len+1+tmp(0))
len==+tmp(0)
n==-arabic(i)
OD
OD
res(0)=len
RETURN
PROC Main()
CARD ARRAY data=[1990 2008 5555 1666 3888 3999]
BYTE i
CHAR ARRAY r(20)
InitRoman()
FOR i=0 TO 5
DO
EncodeRomanNumber(data(i),r)
PrintF("%U=%S%E",data(i),r)
OD
RETURN

14
Task/Roman-numerals-Encode/ActionScript/roman-numerals-encode-1.as Normal file
View file

@ -0,0 +1,14 @@
function arabic2roman(num:Number):String {
var lookup:Object = {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};
var roman:String = "", i:String;
for (i in lookup) {
while (num >= lookup[i]) {
roman += i;
num -= lookup[i];
}
}
return roman;
}
trace("1990 in roman is " + arabic2roman(1990));
trace("2008 in roman is " + arabic2roman(2008));
trace("1666 in roman is " + arabic2roman(1666));

13
Task/Roman-numerals-Encode/ActionScript/roman-numerals-encode-2.as Normal file
View file

@ -0,0 +1,13 @@
function roman2arabic(roman:String):Number {
var romanArr:Array = roman.toUpperCase().split('');
var lookup:Object = {I:1, V:5, X:10, L:50, C:100, D:500, M:1000};
var num:Number = 0, val:Number = 0;
while (romanArr.length) {
val = lookup[romanArr.shift()];
num += val * (val < lookup[romanArr[0]] ? -1 : 1);
}
return num;
}
trace("MCMXC in arabic is " + roman2arabic("MCMXC"));
trace("MMVIII in arabic is " + roman2arabic("MMVIII"));
trace("MDCLXVI in arabic is " + roman2arabic("MDCLXVI"));

33
Task/Roman-numerals-Encode/Ada/roman-numerals-encode.ada Normal file
View file

@ -0,0 +1,33 @@
with Ada.Text_IO; use Ada.Text_IO;
procedure Roman_Numeral_Test is
function To_Roman (Number : Positive) return String is
subtype Digit is Integer range 0..9;
function Roman (Figure : Digit; I, V, X : Character) return String is
begin
case Figure is
when 0 => return "";
when 1 => return "" & I;
when 2 => return I & I;
when 3 => return I & I & I;
when 4 => return I & V;
when 5 => return "" & V;
when 6 => return V & I;
when 7 => return V & I & I;
when 8 => return V & I & I & I;
when 9 => return I & X;
end case;
end Roman;
begin
pragma Assert (Number >= 1 and Number < 4000);
return
Roman (Number / 1000, 'M', ' ', ' ') &
Roman (Number / 100 mod 10, 'C', 'D', 'M') &
Roman (Number / 10 mod 10, 'X', 'L', 'C') &
Roman (Number mod 10, 'I', 'V', 'X');
end To_Roman;
begin
Put_Line (To_Roman (1999));
Put_Line (To_Roman (25));
Put_Line (To_Roman (944));
end Roman_Numeral_Test;

137
Task/Roman-numerals-Encode/AppleScript/roman-numerals-encode.applescript Normal file
View file

@ -0,0 +1,137 @@
------------------ ROMAN INTEGER STRINGS -----------------
-- roman :: Int -> String
on roman(n)
set kvs to {["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]}
script stringAddedValueDeducted
on |λ|(balance, kv)
set {k, v} to kv
set {q, r} to quotRem(balance, v)
if q > 0 then
{r, concat(replicate(q, k))}
else
{r, ""}
end if
end |λ|
end script
concat(snd(mapAccumL(stringAddedValueDeducted, n, kvs)))
end roman
--------------------------- TEST -------------------------
on run
map(roman, [2016, 1990, 2008, 2000, 1666])
--> {"MMXVI", "MCMXC", "MMVIII", "MM", "MDCLXVI"}
end run
---------------- GENERIC LIBRARY FUNCTIONS ---------------
-- concat :: [[a]] -> [a] | [String] -> String
on concat(xs)
script append
on |λ|(a, b)
a & b
end |λ|
end script
if length of xs > 0 and ¬
class of (item 1 of xs) is string then
set unit to ""
else
set unit to {}
end if
foldl(append, unit, xs)
end concat
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- 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
-- 'The mapAccumL function behaves like a combination of map and foldl;
-- it applies a function to each element of a list, passing an
-- accumulating parameter from left to right, and returning a final
-- value of this accumulator together with the new list.' (see Hoogle)
-- mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
on mapAccumL(f, acc, xs)
script
on |λ|(a, x)
tell mReturn(f) to set pair to |λ|(item 1 of a, x)
[item 1 of pair, (item 2 of a) & {item 2 of pair}]
end |λ|
end script
foldl(result, [acc, {}], xs)
end mapAccumL
-- 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
-- quotRem :: Integral a => a -> a -> (a, a)
on quotRem(m, n)
{m div n, m mod n}
end quotRem
-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length
-- replicate :: Int -> a -> [a]
on replicate(n, a)
set out to {}
if n < 1 then return out
set dbl to {a}
repeat while (n > 1)
if (n mod 2) > 0 then set out to out & dbl
set n to (n div 2)
set dbl to (dbl & dbl)
end repeat
return out & dbl
end replicate
-- snd :: (a, b) -> b
on snd(xs)
if class of xs is list and length of xs = 2 then
item 2 of xs
else
missing value
end if
end snd

7
Task/Roman-numerals-Encode/Applesoft-BASIC/roman-numerals-encode.basic Normal file
View file

@ -0,0 +1,7 @@
1 N = 1990: GOSUB 5: PRINT N" = "V$
2 N = 2008: GOSUB 5: PRINT N" = "V$
3 N = 1666: GOSUB 5: PRINT N" = "V$;
4 END
5 V = N:V$ = "": FOR I = 0 TO 12: FOR L = 1 TO 0 STEP 0:A = VAL ( MID$ ("1E3900500400100+90+50+40+10+09+05+04+01",I * 3 + 1,3))
6 L = (V - A) > = 0:V$ = V$ + MID$ ("M.CMD.CDC.XCL.XLX.IXV.IVI",I * 2 + 1,(I - INT (I / 2) * 2 + 1) * L):V = V - A * L: NEXT L,I
7 RETURN

27
Task/Roman-numerals-Encode/Arturo/roman-numerals-encode.arturo Normal file
View file

@ -0,0 +1,27 @@
nums: [[1000 "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"])
toRoman: function [x][
ret: ""
idx: 0
initial: x
loop nums 'num [
d: num\0
l: num\1
i: 0
while [i<initial/d] [
ret: ret ++ l
i: i+1
]
initial: mod initial d
]
return ret
]
loop [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 25 30 40
50 60 69 70 80 90 99 100 200 300 400 500 600 666 700 800 900
1000 1009 1444 1666 1945 1997 1999 2000 2008 2010 2011 2500
3000 3999] 'n
-> print [n "->" toRoman n]

28
Task/Roman-numerals-Encode/AutoHotkey/roman-numerals-encode.ahk Normal file
View file

@ -0,0 +1,28 @@
MsgBox % stor(444)
stor(value)
{
romans = M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I
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
Loop, Parse, romans, `,
{
While, value >= %A_LoopField%
{
result .= A_LoopField
value := value - (%A_LoopField%)
}
}
Return result . "O"
}

24
Task/Roman-numerals-Encode/AutoLISP/roman-numerals-encode.l Normal file
View file

@ -0,0 +1,24 @@
(defun c:roman() (romanNumber (getint "\n Enter number > "))
(defun romanNumber (n / uni dec hun tho nstr strlist nlist rom)
(if (and (> n 0) (<= n 3999))
(progn
(setq
UNI (list "" "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX")
DEC (list "" "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC")
HUN (list "" "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM")
THO (list "" "M" "MM" "MMM")
nstr (itoa n)
)
(while (> (strlen nstr) 0) (setq strlist (append strlist (list (substr nstr 1 1))) nstr (substr nstr 2 (strlen nstr))))
(setq nlist (mapcar 'atoi strlist))
(cond
((> n 999)(setq rom(strcat(nth (car nlist) THO)(nth (cadr nlist) HUN)(nth (caddr nlist) DEC) (nth (last nlist)UNI ))))
((and (> n 99)(<= n 999))(setq rom(strcat (nth (car nlist) HUN)(nth (cadr nlist) DEC) (nth (last nlist)UNI ))))
((and (> n 9)(<= n 99))(setq rom(strcat (nth (car nlist) DEC) (nth (last nlist)UNI ))))
((<= n 9)(setq rom(nth (last nlist)UNI)))
)
)
(princ "\nNumber out of range!")
)
rom
)

16
Task/Roman-numerals-Encode/BASIC256/roman-numerals-encode.basic Normal file
View file

@ -0,0 +1,16 @@
print 1666+" = "+convert$(1666)
print 2008+" = "+convert$(2008)
print 1001+" = "+convert$(1001)
print 1999+" = "+convert$(1999)
function convert$(value)
convert$=""
arabic = {1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 }
roman$ = {"M", "CM", "D","CD", "C","XC","L","XL","X","IX","V","IV","I"}
for i = 0 to 12
while value >= arabic[i]
convert$ += roman$[i]
value = value - arabic[i]
end while
next i
end function

18
Task/Roman-numerals-Encode/BBC-BASIC/roman-numerals-encode.basic Normal file
View file

@ -0,0 +1,18 @@
PRINT ;1999, FNroman(1999)
PRINT ;2012, FNroman(2012)
PRINT ;1666, FNroman(1666)
PRINT ;3888, FNroman(3888)
END
DEF FNroman(n%)
LOCAL i%, r$, arabic%(), roman$()
DIM arabic%(12), roman$(12)
arabic%() = 1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900,1000
roman$() = "I","IV", "V","IX", "X","XL", "L","XC", "C","CD", "D","CM", "M"
FOR i% = 12 TO 0 STEP -1
WHILE n% >= arabic%(i%)
r$ += roman$(i%)
n% -= arabic%(i%)
ENDWHILE
NEXT
= r$

42
Task/Roman-numerals-Encode/BCPL/roman-numerals-encode.bcpl Normal file
View file

@ -0,0 +1,42 @@
get "libhdr"
let toroman(n, v) = valof
$( let extract(n, val, rmn, v) = valof
$( while n >= val
$( n := n - val;
for i=1 to rmn%0 do v%(v%0+i) := rmn%i
v%0 := v%0 + rmn%0
$)
resultis n
$)
v%0 := 0
n := extract(n, 1000, "M", v)
n := extract(n, 900, "CM", v)
n := extract(n, 500, "D", v)
n := extract(n, 400, "CD", v)
n := extract(n, 100, "C", v)
n := extract(n, 90, "XC", v)
n := extract(n, 50, "L", v)
n := extract(n, 40, "XL", v)
n := extract(n, 10, "X", v)
n := extract(n, 9, "IX", v)
n := extract(n, 5, "V", v)
n := extract(n, 4, "IV", v)
n := extract(n, 1, "I", v)
resultis v
$)
let show(n) be
$( let v = vec 50
writef("%I4 = %S*N", n, toroman(n, v))
$)
let start() be
$( show(1666)
show(2008)
show(1001)
show(1999)
show(3888)
show(2021)
$)

8
Task/Roman-numerals-Encode/BQN/roman-numerals-encode-1.bqn Normal file
View file

@ -0,0 +1,8 @@
⟨ToRoman⇐R⟩ ← {
ds ← 1↓¨(¯1+`⊏⊸=)⊸⊔" I IV V IX X XL L XC C CD D CM M"
vs ← 1e3∾˜ ⥊1‿4‿5‿9×⌜˜10⋆↕3
R ⇐ {
𝕨𝕊0: "";
(⊑⟜ds∾·𝕊𝕩-⊑⟜vs) 1-˜⊑vs⍋𝕩
}
}

2
Task/Roman-numerals-Encode/BQN/roman-numerals-encode-2.bqn Normal file
View file

@ -0,0 +1,2 @@
ToRoman¨ 1990‿2008‿1666‿2021
⟨ "MCMXC" "MMVIII" "MDCLXVI" "MMXXI" ⟩

23
Task/Roman-numerals-Encode/BaCon/roman-numerals-encode.bacon Normal file
View file

@ -0,0 +1,23 @@
OPTION BASE 1
GLOBAL roman$[] = { "M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I" }
GLOBAL number[] = { 1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 }
FUNCTION toroman$(value)
LOCAL result$
DOTIMES UBOUND(number)
WHILE value >= number[_]
result$ = result$ & roman$[_]
DECR value, number[_]
WEND
DONE
RETURN result$
ENDFUNC
PRINT toroman$(1990)
PRINT toroman$(2008)
PRINT toroman$(1666)

32
Task/Roman-numerals-Encode/Batch-File/roman-numerals-encode.bat Normal file
View file

@ -0,0 +1,32 @@
@echo off
setlocal enabledelayedexpansion
set cnt=0&for %%A in (1000,900,500,400,100,90,50,40,10,9,5,4,1) do (set arab!cnt!=%%A&set /a cnt+=1)
set cnt=0&for %%R in (M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I) do (set rom!cnt!=%%R&set /a cnt+=1)
::Testing
call :toRoman 2009
echo 2009 = !result!
call :toRoman 1666
echo 1666 = !result!
call :toRoman 3888
echo 3888 = !result!
pause>nul
exit/b 0
::The "function"...
:toRoman
set value=%1
set result=
for /l %%i in (0,1,12) do (
set a=%%i
call :add_val
)
goto :EOF
:add_val
if !value! lss !arab%a%! goto :EOF
set result=!result!!rom%a%!
set /a value-=!arab%a%!
goto add_val

6
Task/Roman-numerals-Encode/Befunge/roman-numerals-encode.bf Normal file
View file

@ -0,0 +1,6 @@
&>0\0>00p:#v_$ >:#,_ $ @
4-v >5+#:/#<\55+%:5/\5%:
vv_$9+00g+5g\00g8+>5g\00
g>\20p>:10p00g \#v _20gv
> 2+ v^-1g01\g5+8<^ +9 _
IVXLCDM

49
Task/Roman-numerals-Encode/Bracmat/roman-numerals-encode.bracmat Normal file
View file

@ -0,0 +1,49 @@
( ( encode
= indian roman cifr tenfoldroman letter tenfold
. !arg:#?indian
& :?roman
& whl
' ( @(!indian:#%?cifr ?indian)
& :?tenfoldroman
& whl
' ( !roman:%?letter ?roman
& !tenfoldroman
( (I.X)
(V.L)
(X.C)
(L.D)
(C.M)
: ? (!letter.?tenfold) ?
& !tenfold
| "*"
)
: ?tenfoldroman
)
& !tenfoldroman:?roman
& ( !cifr:9&!roman I X:?roman
| !cifr:~<4
& !roman
(!cifr:4&I|)
V
: ?roman
& !cifr+-5:?cifr
& ~
| whl
' ( !cifr+-1:~<0:?cifr
& !roman I:?roman
)
)
)
& ( !roman:? "*" ?&~`
| str$!roman
)
)
& 1990 2008 1666 3888 3999 4000:?NS
& whl
' ( !NS:%?N ?NS
& out
$ ( encode$!N:?K&!N !K
| str$("Can't convert " !N " to Roman numeral")
)
)
);

41
Task/Roman-numerals-Encode/C++/roman-numerals-encode-1.cpp Normal file
View file

@ -0,0 +1,41 @@
#include <iostream>
#include <string>
std::string to_roman(int value)
{
struct romandata_t { int value; char const* numeral; };
static romandata_t const romandata[] =
{ 1000, "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",
0, NULL }; // end marker
std::string result;
for (romandata_t const* current = romandata; current->value > 0; ++current)
{
while (value >= current->value)
{
result += current->numeral;
value -= current->value;
}
}
return result;
}
int main()
{
for (int i = 1; i <= 4000; ++i)
{
std::cout << to_roman(i) << std::endl;
}
}

32
Task/Roman-numerals-Encode/C++/roman-numerals-encode-2.cpp Normal file
View file

@ -0,0 +1,32 @@
#include <iostream>
#include <string>
std::string to_roman(int x) {
if (x <= 0)
return "Negative or zero!";
auto roman_digit = [](char one, char five, char ten, int x) {
if (x <= 3)
return std::string().assign(x, one);
if (x <= 5)
return std::string().assign(5 - x, one) + five;
if (x <= 8)
return five + std::string().assign(x - 5, one);
return std::string().assign(10 - x, one) + ten;
};
if (x >= 1000)
return x - 1000 > 0 ? "M" + to_roman(x - 1000) : "M";
if (x >= 100) {
auto s = roman_digit('C', 'D', 'M', x / 100);
return x % 100 > 0 ? s + to_roman(x % 100) : s;
}
if (x >= 10) {
auto s = roman_digit('X', 'L', 'C', x / 10);
return x % 10 > 0 ? s + to_roman(x % 10) : s;
}
return roman_digit('I', 'V', 'X', x);
}
int main() {
for (int i = 0; i < 2018; i++)
std::cout << i << " --> " << to_roman(i) << std::endl;
}

28
Task/Roman-numerals-Encode/C-sharp/roman-numerals-encode-1.cs Normal file
View file

@ -0,0 +1,28 @@
using System;
class Program
{
static uint[] nums = { 1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 };
static string[] rum = { "M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I" };
static string ToRoman(uint number)
{
string value = "";
for (int i = 0; i < nums.Length && number != 0; i++)
{
while (number >= nums[i])
{
number -= nums[i];
value += rum[i];
}
}
return value;
}
static void Main()
{
for (uint number = 1; number <= 1 << 10; number *= 2)
{
Console.WriteLine("{0} = {1}", number, ToRoman(number));
}
}
}

17
Task/Roman-numerals-Encode/C-sharp/roman-numerals-encode-2.cs Normal file
View file

@ -0,0 +1,17 @@
Func<int, string> toRoman = (number) =>
new Dictionary<int, string>
{
{1000, "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"}
}.Aggregate(new string('I', number), (m, _) => m.Replace(new string('I', _.Key), _.Value));

24
Task/Roman-numerals-Encode/C/roman-numerals-encode-1.c Normal file
View file

@ -0,0 +1,24 @@
#include <stdio.h>
int main() {
int arabic[] = {1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1};
// There is a bug: "XL\0" is translated into sequence 58 4C 00 00, i.e. it is 4-bytes long...
// Should be "XL" without \0 etc.
//
char roman[13][3] = {"M\0", "CM\0", "D\0", "CD\0", "C\0", "XC\0", "L\0", "XL\0", "X\0", "IX\0", "V\0", "IV\0", "I\0"};
int N;
printf("Enter arabic number:\n");
scanf("%d", &N);
printf("\nRoman number:\n");
for (int i = 0; i < 13; i++) {
while (N >= arabic[i]) {
printf("%s", roman[i]);
N -= arabic[i];
}
}
return 0;
}

89
Task/Roman-numerals-Encode/C/roman-numerals-encode-2.c Normal file
View file

@ -0,0 +1,89 @@
#define _CRT_SECURE_NO_WARNINGS
#include <stdio.h>
#include <string.h>
int RomanNumerals_parseInt(const char* string)
{
int value;
return scanf("%u", &value) == 1 && value > 0 ? value : 0;
}
const char* RomanNumerals_toString(int value)
{
#define ROMAN_NUMERALS_MAX_OUTPUT_STRING_SIZE 64
static buffer[ROMAN_NUMERALS_MAX_OUTPUT_STRING_SIZE];
const static int maxValue = 5000;
const static int minValue = 1;
const static struct Digit {
char string[4]; // It's better to use 4 than 3 (aligment).
int value;
} digits[] = {
{"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 },
{"?", 0}
};
*buffer = '\0'; // faster than memset(buffer, 0, sizeof(buffer));
if (minValue <= value && value <= maxValue)
{
struct Digit* digit = &digits[0];
while (digit->value)
{
while (value >= digit->value)
{
value -= digit->value;
// It is not necessary - total length would not be exceeded...
// if (strlen(buffer) + strlen(digit->string) < sizeof(buffer))
strcat(buffer, digit->string);
}
digit++;
}
}
return buffer;
}
int main(int argc, char* argv[])
{
if (argc < 2)
{
// Blanks are needed for a consistient blackground on some systems.
// BTW, puts append an extra newline at the end.
//
puts("Write given numbers as Roman numerals. \n"
" \n"
"Usage: \n"
" roman n1 n2 n3 ... \n"
" \n"
"where n1 n2 n3 etc. are Arabic numerals\n");
int numbers[] = { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1498, 2022 };
for (int i = 0; i < sizeof(numbers) / sizeof(int); i++)
{
printf("%4d = %s\n",
numbers[i], RomanNumerals_toString(numbers[i]));
}
}
else
{
for (int i = 1; i < argc; i++)
{
int number = RomanNumerals_parseInt(argv[i]);
if (number)
{
puts(RomanNumerals_toString(number));
}
else
{
puts("???");
}
}
}
return 0;
}

47
Task/Roman-numerals-Encode/CLU/roman-numerals-encode.clu Normal file
View file

@ -0,0 +1,47 @@
roman = cluster is encode
rep = null
dmap = struct[v: int, s: string]
darr = array[dmap]
own chunks: darr := darr$
[dmap${v: 1000, s: "M"},
dmap${v: 900, s: "CM"},
dmap${v: 500, s: "D"},
dmap${v: 400, s: "CD"},
dmap${v: 100, s: "C"},
dmap${v: 90, s: "XC"},
dmap${v: 50, s: "L"},
dmap${v: 40, s: "XL"},
dmap${v: 10, s: "X"},
dmap${v: 9, s: "IX"},
dmap${v: 5, s: "V"},
dmap${v: 4, s: "IV"},
dmap${v: 1, s: "I"}]
largest_chunk = proc (i: int) returns (int, string)
for chunk: dmap in darr$elements(chunks) do
if chunk.v <= i then return (chunk.v, chunk.s) end
end
return (0, "")
end largest_chunk
encode = proc (i: int) returns (string)
result: string := ""
while i > 0 do
val: int chunk: string
val, chunk := largest_chunk(i)
result := result || chunk
i := i - val
end
return (result)
end encode
end roman
start_up = proc ()
po: stream := stream$primary_output()
tests: array[int] := array[int]$[1666, 2008, 1001, 1999, 3888, 2021]
for test: int in array[int]$elements(tests) do
stream$putl(po, int$unparse(test) || " = " || roman$encode(test))
end
end start_up

53
Task/Roman-numerals-Encode/COBOL/roman-numerals-encode.cobol Normal file
View file

@ -0,0 +1,53 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. TOROMAN.
DATA DIVISION.
working-storage section.
01 ws-number pic 9(4) value 0.
01 ws-save-number pic 9(4).
01 ws-tbl-def.
03 filler pic x(7) value '1000M '.
03 filler pic x(7) value '0900CM '.
03 filler pic x(7) value '0500D '.
03 filler pic x(7) value '0400CD '.
03 filler pic x(7) value '0100C '.
03 filler pic x(7) value '0090XC '.
03 filler pic x(7) value '0050L '.
03 filler pic x(7) value '0040XL '.
03 filler pic x(7) value '0010X '.
03 filler pic x(7) value '0009IX '.
03 filler pic x(7) value '0005V '.
03 filler pic x(7) value '0004IV '.
03 filler pic x(7) value '0001I '.
01 filler redefines ws-tbl-def.
03 filler occurs 13 times indexed by rx.
05 ws-tbl-divisor pic 9(4).
05 ws-tbl-roman-ch pic x(1) occurs 3 times indexed by cx.
01 ocx pic 99.
01 ws-roman.
03 ws-roman-ch pic x(1) occurs 16 times.
PROCEDURE DIVISION.
accept ws-number
perform
until ws-number = 0
move ws-number to ws-save-number
if ws-number > 0 and ws-number < 4000
initialize ws-roman
move 0 to ocx
perform varying rx from 1 by +1
until ws-number = 0
perform until ws-number < ws-tbl-divisor (rx)
perform varying cx from 1 by +1
until ws-tbl-roman-ch (rx, cx) = spaces
compute ocx = ocx + 1
move ws-tbl-roman-ch (rx, cx) to ws-roman-ch (ocx)
end-perform
compute ws-number = ws-number - ws-tbl-divisor (rx)
end-perform
end-perform
display 'inp=' ws-save-number ' roman=' ws-roman
else
display 'inp=' ws-save-number ' invalid'
end-if
accept ws-number
end-perform
.

45
Task/Roman-numerals-Encode/Ceylon/roman-numerals-encode.ceylon Normal file
View file

@ -0,0 +1,45 @@
shared void run() {
class Numeral(shared Character char, shared Integer int) {}
value tiers = [
[Numeral('I', 1), Numeral('V', 5), Numeral('X', 10)],
[Numeral('X', 10), Numeral('L', 50), Numeral('C', 100)],
[Numeral('C', 100), Numeral('D', 500), Numeral('M', 1k)]
];
String toRoman(Integer hindu, Integer tierIndex = 2) {
assert (exists tier = tiers[tierIndex]);
" Finds if it's a two character numeral like iv, ix, xl, xc, cd and cm."
function findTwoCharacterNumeral() =>
if (exists bigNum = tier.rest.find((numeral) => numeral.int - tier.first.int <= hindu < numeral.int))
then [tier.first, bigNum]
else null;
if (hindu <= 0) {
// if it's zero then we are done!
return "";
}
else if (exists [smallNum, bigNum] = findTwoCharacterNumeral()) {
value twoCharSymbol = "``smallNum.char````bigNum.char``";
value twoCharValue = bigNum.int - smallNum.int;
return "``twoCharSymbol````toRoman(hindu - twoCharValue, tierIndex)``";
}
else if (exists num = tier.reversed.find((Numeral elem) => hindu >= elem.int)) {
return "``num.char````toRoman(hindu - num.int, tierIndex)``";
}
else {
// nothing was found so move to the next smaller tier!
return toRoman(hindu, tierIndex - 1);
}
}
assert (toRoman(1) == "I");
assert (toRoman(2) == "II");
assert (toRoman(4) == "IV");
assert (toRoman(1666) == "MDCLXVI");
assert (toRoman(1990) == "MCMXC");
assert (toRoman(2008) == "MMVIII");
}

19
Task/Roman-numerals-Encode/Chipmunk-Basic/roman-numerals-encode.basic Normal file
View file

@ -0,0 +1,19 @@
100 cls
110 dim arabic(12), roman$(12)
120 for j = 0 to 12 : read arabic(j),roman$(j) : next j
130 data 1000,"M", 900,"CM", 500,"D", 400,"CD", 100,"C", 90,"XC"
140 data 50,"L",40,"XL",10,"X",9,"IX",5,"V",4,"IV",1,"I"
187 avalor = 1990 : print avalor "= "; : gosub 220 : print roman$ ' MCMXC
188 avalor = 2008 : print avalor "= "; : gosub 220 : print roman$ ' MMXXII
189 avalor = 1666 : print avalor "= "; : gosub 220 : print roman$ ' MDCLXVI
200 end
210 rem Encode to Roman
220 roman$ = "" : i = 0
230 while (i <= 12) and (avalor > 0)
240 while avalor >= arabic(i)
250 roman$ = roman$+roman$(i)
260 avalor = avalor-arabic(i)
270 wend
280 i = i+1
290 wend
300 return

7
Task/Roman-numerals-Encode/Clojure/roman-numerals-encode-1.clj Normal file
View file

@ -0,0 +1,7 @@
(def arabic->roman
(partial clojure.pprint/cl-format nil "~@R"))
(arabic->roman 147)
;"CXXIII"
(arabic->roman 99)
;"XCIX"

17
Task/Roman-numerals-Encode/Clojure/roman-numerals-encode-2.clj Normal file
View file

@ -0,0 +1,17 @@
(def roman-map
(sorted-map
1 "I", 4 "IV", 5 "V", 9 "IX",
10 "X", 40 "XL", 50 "L", 90 "XC",
100 "C", 400 "CD", 500 "D", 900 "CM"
1000 "M"))
(defn int->roman [n]
{:pre (integer? n)}
(loop [res (StringBuilder.), n n]
(if-let [v (roman-map n)]
(str (.append res v))
(let [[k v] (->> roman-map keys (filter #(> n %)) last (find roman-map))]
(recur (.append res v) (- n k))))))
(int->roman 1999)
; "MCMXCIX"

16
Task/Roman-numerals-Encode/Clojure/roman-numerals-encode-3.clj Normal file
View file

@ -0,0 +1,16 @@
(defn a2r [a]
(let [rv '(1000 500 100 50 10 5 1)
rm (zipmap rv "MDCLXVI")
dv (->> rv (take-nth 2) next #(interleave % %))]
(loop [a a rv rv dv dv r nil]
(if (<= a 0)
r
(let [v (first rv)
d (or (first dv) 0)
l (- v d)]
(cond
(= a v) (str r (rm v))
(= a l) (str r (rm d) (rm v))
(and (> a v) (> a l)) (recur (- a v) rv dv (str r (rm v)))
(and (< a v) (< a l)) (recur a (rest rv) (rest dv) r)
:else (recur (- a l) (rest rv) (rest dv) (str r (rm d) (rm v)))))))))

5
Task/Roman-numerals-Encode/Clojure/roman-numerals-encode-4.clj Normal file
View file

@ -0,0 +1,5 @@
(a2r 1666)
"MDCLXVI"
(map a2r [1000 1 389 45])
("M" "I" "CCCLXXXIX" "XLV")

20
Task/Roman-numerals-Encode/Clojure/roman-numerals-encode-5.clj Normal file
View file

@ -0,0 +1,20 @@
(def roman-map
(sorted-map-by >
1 "I", 4 "IV", 5 "V", 9 "IX",
10 "X", 40 "XL", 50 "L", 90 "XC",
100 "C", 400 "CD", 500 "D", 900 "CM"
1000 "M"))
(defn a2r
([r]
(reduce str (a2r r (keys roman-map))))
([r n]
(when-not (empty? n)
(let [e (first n)
v (- r e)
roman (roman-map e)]
(cond
(< v 0) (a2r r (rest n))
(= v 0) (cons roman [])
(>= v e) (cons roman (a2r v n))
(< v e) (cons roman (a2r v (rest n))))))))

5
Task/Roman-numerals-Encode/Clojure/roman-numerals-encode-6.clj Normal file
View file

@ -0,0 +1,5 @@
(a2r 1666)
"MDCLXVI"
(map a2r [1000 1 389 45])
("M" "I" "CCCLXXXIX" "XLV")

46
Task/Roman-numerals-Encode/CoffeeScript/roman-numerals-encode.coffee Normal file
View file

@ -0,0 +1,46 @@
decimal_to_roman = (n) ->
# This should work for any positive integer, although it
# gets a bit preposterous for large numbers.
if n >= 4000
thousands = decimal_to_roman n / 1000
ones = decimal_to_roman n % 1000
return "M(#{thousands})#{ones}"
s = ''
translate_each = (min, roman) ->
while n >= min
n -= min
s += roman
translate_each 1000, "M"
translate_each 900, "CM"
translate_each 500, "D"
translate_each 400, "CD"
translate_each 100, "C"
translate_each 90, "XC"
translate_each 50, "L"
translate_each 40, "XL"
translate_each 10, "X"
translate_each 9, "IX"
translate_each 5, "V"
translate_each 4, "IV"
translate_each 1, "I"
s
###################
tests =
IV: 4
XLII: 42
MCMXC: 1990
MMVIII: 2008
MDCLXVI: 1666
'M(IV)': 4000
'M(VI)IX': 6009
'M(M(CXXIII)CDLVI)DCCLXXXIX': 123456789
'M(MMMV)I': 3005001
for expected, decimal of tests
roman = decimal_to_roman(decimal)
if roman == expected
console.log "#{decimal} = #{roman}"
else
console.log "error for #{decimal}: #{roman} is wrong"

26
Task/Roman-numerals-Encode/Commodore-BASIC/roman-numerals-encode-1.basic Normal file
View file

@ -0,0 +1,26 @@
100 DIM RN$(12),NV(12)
110 FOR I=0 TO 12
120 : READ RN$(I), NV(I)
130 NEXT I
140 DATA M,1000, CM,900, D,500, CD,400
150 DATA C, 100, XC, 90, L, 50, XL, 40
160 DATA X, 10, IX, 9, V, 5, IV, 4
170 DATA I, 1
180 PRINT CHR$(19);CHR$(19);CHR$(147);CHR$(18);
190 PRINT "***** ROMAN NUMERAL ENCODER *****";CHR$(27);"T"
200 DO
210 : PRINT "ENTER NUMBER (0 TO QUIT):";
220 : OPEN 1,0:INPUT#1,AN$:CLOSE 1:PRINT
230 : AN=VAL(AN$):IF AN=0 THEN EXIT
240 : RN$=""
250 : DO WHILE AN > 0
260 : FOR I=0 TO 12
270 : IF AN >= NV(I) THEN BEGIN
280 : RN$ = RN$+ RN$(I)
290 : AN = AN - NV(I)
300 : GOTO 330
310 : BEND
320 : NEXT I
330 : LOOP
340 : PRINT RN$;CHR$(13)
350 LOOP

25
Task/Roman-numerals-Encode/Commodore-BASIC/roman-numerals-encode-2.basic Normal file
View file

@ -0,0 +1,25 @@
100 DIM RN$(12),NV(12)
110 FOR I=0 TO 12
120 : READ RN$(I), NV(I)
130 NEXT I
140 DATA M,1000, CM,900, D,500, CD,400
150 DATA C, 100, XC, 90, L, 50, XL, 40
160 DATA X, 10, IX, 9, V, 5, IV, 4
170 DATA I, 1
180 PRINT CHR$(19);CHR$(19);CHR$(147);CHR$(18);
190 PRINT "***** ROMAN NUMERAL ENCODER *****";CHR$(27);"T"
200 DO
210 : PRINT "ENTER NUMBER (0 TO QUIT):";
220 : OPEN 1,0:INPUT#1,AN$:CLOSE 1:PRINT
230 : AN=VAL(AN$):IF AN=0 THEN EXIT
240 : RN$=""
250 : DO WHILE AN > 0
260 : FOR I=0 TO 12
270 : IF AN < NV(I) THEN 320
280 : RN$ = RN$+ RN$(I)
290 : AN = AN - NV(I)
300 : I = 12
320 : NEXT I
330 : LOOP
340 : PRINT RN$;CHR$(13)
350 LOOP

25
Task/Roman-numerals-Encode/Commodore-BASIC/roman-numerals-encode-3.basic Normal file
View file

@ -0,0 +1,25 @@
100 DIM RN$(12),NV(12)
110 FOR I=0 TO 12
120 : READ RN$(I), NV(I)
130 NEXT I
140 DATA M,1000, CM,900, D,500, CD,400
150 DATA C, 100, XC, 90, L, 50, XL, 40
160 DATA X, 10, IX, 9, V, 5, IV, 4
170 DATA I, 1
180 PRINT CHR$(19);CHR$(19);CHR$(147);CHR$(18);
190 PRINT "***** ROMAN NUMERAL ENCODER *****";
200 REM BEGIN MAIN LOOP
210 : PRINT "NUMBER (0 TO QUIT):";
220 : OPEN 1,0:INPUT#1,AN$:CLOSE 1:PRINT
230 : AN=VAL(AN$):IF AN=0 THEN END
240 : RN$=""
250 : IF AN <= 0 THEN 340
260 : FOR I=0 TO 12
270 : IF AN < NV(I) THEN 320
280 : RN$ = RN$+ RN$(I)
290 : AN = AN - NV(I)
300 : I = 12
320 : NEXT I
330 : GOTO 250
340 : PRINT RN$;CHR$(13)
350 GOTO 210

2
Task/Roman-numerals-Encode/Common-Lisp/roman-numerals-encode.lisp Normal file
View file

@ -0,0 +1,2 @@
(defun roman-numeral (n)
(format nil "~@R" n))

58
Task/Roman-numerals-Encode/Cowgol/roman-numerals-encode.cowgol Normal file
View file

@ -0,0 +1,58 @@
include "cowgol.coh";
include "argv.coh";
# Encode the given number as a Roman numeral
sub decimalToRoman(num: uint16, buf: [uint8]): (rslt: [uint8]) is
# return the start of the buffer for easy printing
rslt := buf;
# Add string to buffer
sub Add(str: [uint8]) is
while [str] != 0 loop
[buf] := [str];
buf := @next buf;
str := @next str;
end loop;
end sub;
# Table of Roman numerals
record Roman is
value: uint16;
string: [uint8];
end record;
var numerals: Roman[] := {
{1000, "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"}
};
var curNum := &numerals as [Roman];
while num != 0 loop
while num >= curNum.value loop
Add(curNum.string);
num := num - curNum.value;
end loop;
curNum := @next curNum;
end loop;
[buf] := 0; # terminate the string
end sub;
# Read numbers from the command line and print the corresponding Roman numerals
ArgvInit();
var buffer: uint8[100];
loop
var argmt := ArgvNext();
if argmt == (0 as [uint8]) then
break;
end if;
var dummy: [uint8];
var number: int32;
(number, dummy) := AToI(argmt);
print(decimalToRoman(number as uint16, &buffer as [uint8]));
print_nl();
end loop;

26
Task/Roman-numerals-Encode/D/roman-numerals-encode.d Normal file
View file

@ -0,0 +1,26 @@
string toRoman(int n) pure nothrow
in {
assert(n < 5000);
} body {
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"];
string roman;
foreach (i, w; weights) {
while (n >= w) {
roman ~= symbols[i];
n -= w;
}
if (n == 0)
break;
}
return roman;
} unittest {
assert(toRoman(455) == "CDLV");
assert(toRoman(3456) == "MMMCDLVI");
assert(toRoman(2488) == "MMCDLXXXVIII");
}
void main() {}

20
Task/Roman-numerals-Encode/DWScript/roman-numerals-encode.dw Normal file
View file

@ -0,0 +1,20 @@
const weights = [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1];
const symbols = ["M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I"];
function toRoman(n : Integer) : String;
var
i, w : Integer;
begin
for i := 0 to weights.High do begin
w := weights[i];
while n >= w do begin
Result += symbols[i];
n -= w;
end;
if n = 0 then Break;
end;
end;
PrintLn(toRoman(455));
PrintLn(toRoman(3456));
PrintLn(toRoman(2488));

28
Task/Roman-numerals-Encode/Delphi/roman-numerals-encode.delphi Normal file
View file

@ -0,0 +1,28 @@
program RomanNumeralsEncode;
{$APPTYPE CONSOLE}
function IntegerToRoman(aValue: Integer): string;
var
i: Integer;
const
WEIGHTS: array[0..12] of Integer = (1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1);
SYMBOLS: array[0..12] of string = ('M', 'CM', 'D', 'CD', 'C', 'XC', 'L', 'XL', 'X', 'IX', 'V', 'IV', 'I');
begin
for i := Low(WEIGHTS) to High(WEIGHTS) do
begin
while aValue >= WEIGHTS[i] do
begin
Result := Result + SYMBOLS[i];
aValue := aValue - WEIGHTS[i];
end;
if aValue = 0 then
Break;
end;
end;
begin
Writeln(IntegerToRoman(1990)); // MCMXC
Writeln(IntegerToRoman(2008)); // MMVIII
Writeln(IntegerToRoman(1666)); // MDCLXVI
end.

25
Task/Roman-numerals-Encode/ECL/roman-numerals-encode.ecl Normal file
View file

@ -0,0 +1,25 @@
RomanEncode(UNSIGNED Int) := 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;
dsWeights := DATASET(13,TRANSFORM(ProcessRec,SELF.val := Int, SELF := []));
SymbolStr(i,n,STRING s) := CHOOSE(n+1,'',SetSymbols[i],SetSymbols[i]+SetSymbols[i],SetSymbols[i]+SetSymbols[i]+SetSymbols[i],s);
RECORDOF(dsWeights) XF(dsWeights L, dsWeights R, INTEGER C) := TRANSFORM
ThisVal := IF(C=1,R.Val,L.Val);
IsDone := ThisVal = 0;
SELF.Roman := IF(IsDone,L.Roman,L.Roman + SymbolStr(C,ThisVal DIV SetWeights[C],L.Roman));
SELF.val := IF(IsDone,0,ThisVal - ((ThisVal DIV SetWeights[C])*SetWeights[C]));
END;
i := ITERATE(dsWeights,XF(LEFT,RIGHT,COUNTER));
RETURN i[13].Roman;
END;
RomanEncode(1954); //MCMLIV
RomanEncode(1990 ); //MCMXC
RomanEncode(2008 ); //MMVIII
RomanEncode(1666); //MDCLXVI

25
Task/Roman-numerals-Encode/ERRE/roman-numerals-encode.erre Normal file
View file

@ -0,0 +1,25 @@
PROGRAM ARAB2ROMAN
DIM ARABIC%[12],ROMAN$[12]
PROCEDURE TOROMAN(VALUE->ANS$)
LOCAL RESULT$
FOR I%=0 TO 12 DO
WHILE VALUE>=ARABIC%[I%] DO
RESULT$+=ROMAN$[I%]
VALUE-=ARABIC%[I%]
END WHILE
END FOR
ANS$=RESULT$
END PROCEDURE
BEGIN
!
!Testing
!
ARABIC%[]=(1000,900,500,400,100,90,50,40,10,9,5,4,1)
ROMAN$[]=("M","CM","D","CD","C","XC","L","XL","X","IX","V","IV","I")
TOROMAN(2009->ANS$) PRINT("2009 = ";ANS$)
TOROMAN(1666->ANS$) PRINT("1666 = ";ANS$)
TOROMAN(3888->ANS$) PRINT("3888 = ";ANS$)
END PROGRAM

17
Task/Roman-numerals-Encode/EasyLang/roman-numerals-encode.easy Normal file
View file

@ -0,0 +1,17 @@
proc dec2rom dec . rom$ .
values[] = [ 1000 900 500 400 100 90 50 40 10 9 5 4 1 ]
symbol$[] = [ "M" "CM" "D" "CD" "C" "XC" "L" "XL" "X" "IX" "V" "IV" "I" ]
rom$ = ""
for i = 1 to len values[]
while dec >= values[i]
rom$ &= symbol$[i]
dec -= values[i]
.
.
.
call dec2rom 1990 r$
print r$
call dec2rom 2008 r$
print r$
call dec2rom 1666 r$
print r$

59
Task/Roman-numerals-Encode/Eiffel/roman-numerals-encode.e Normal file
View file

@ -0,0 +1,59 @@
class
APPLICATION
create
make
feature {NONE} -- Initialization
make
local
numbers: ARRAY [INTEGER]
do
numbers := <<1990, 2008, 1666, 3159, 1977, 2010>>
-- "MCMXC", "MMVIII", "MDCLXVI", "MMMCLIX", "MCMLXXVII", "MMX"
across numbers as n loop
print (n.item.out + " in decimal Arabic numerals is " +
decimal_to_roman (n.item) + " in Roman numerals.%N")
end
end
feature -- Roman numerals
decimal_to_roman (a_int: INTEGER): STRING
-- Representation of integer `a_int' as Roman numeral
require
a_int > 0
local
dnums: ARRAY[INTEGER]
rnums: ARRAY[STRING]
dnum: INTEGER
rnum: STRING
i: INTEGER
do
dnums := <<1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1>>
rnums := <<"M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I">>
dnum := a_int
rnum := ""
from
i := 1
until
i > dnums.count or dnum <= 0
loop
from
until
dnum < dnums[i]
loop
dnum := dnum - dnums[i]
rnum := rnum + rnums[i]
end
i := i + 1
end
Result := rnum
end
end

16
Task/Roman-numerals-Encode/Ela/roman-numerals-encode.ela Normal file
View file

@ -0,0 +1,16 @@
open number string math
digit x y z k =
[[x],[x,x],[x,x,x],[x,y],[y],[y,x],[y,x,x],[y,x,x,x],[x,z]] :
(toInt k - 1)
toRoman 0 = ""
toRoman x | x < 0 = fail "Negative roman numeral"
| x >= 1000 = 'M' :: toRoman (x - 1000)
| x >= 100 = let (q,r) = x `divrem` 100 in
digit 'C' 'D' 'M' q ++ toRoman r
| x >= 10 = let (q,r) = x `divrem` 10 in
digit 'X' 'L' 'C' q ++ toRoman r
| else = digit 'I' 'V' 'X' x
map (join "" << toRoman) [1999,25,944]

32
Task/Roman-numerals-Encode/Elena/roman-numerals-encode.elena Normal file
View file

@ -0,0 +1,32 @@
import system'collections;
import system'routines;
import extensions;
import extensions'text;
static RomanDictionary = Dictionary.new()
.setAt(1000, "M")
.setAt(900, "CM")
.setAt(500, "D")
.setAt(400, "CD")
.setAt(100, "C")
.setAt(90, "XC")
.setAt(50, "L")
.setAt(40, "XL")
.setAt(10, "X")
.setAt(9, "IX")
.setAt(5, "V")
.setAt(4, "IV")
.setAt(1, "I");
extension op
{
toRoman()
= RomanDictionary.accumulate(new StringWriter("I", self), (m,kv => m.replace(new StringWriter("I",kv.Key), kv.Value)));
}
public program()
{
console.printLine("1990 : ", 1990.toRoman());
console.printLine("2008 : ", 2008.toRoman());
console.printLine("1666 : ", 1666.toRoman())
}

17
Task/Roman-numerals-Encode/Elixir/roman-numerals-encode-1.elixir Normal file
View file

@ -0,0 +1,17 @@
defmodule Roman_numeral do
def encode(0), do: ''
def encode(x) when x >= 1000, do: [?M | encode(x - 1000)]
def encode(x) when x >= 100, do: digit(div(x,100), ?C, ?D, ?M) ++ encode(rem(x,100))
def encode(x) when x >= 10, do: digit(div(x,10), ?X, ?L, ?C) ++ encode(rem(x,10))
def encode(x) when x >= 1, do: digit(x, ?I, ?V, ?X)
defp digit(1, x, _, _), do: [x]
defp digit(2, x, _, _), do: [x, x]
defp digit(3, x, _, _), do: [x, x, x]
defp digit(4, x, y, _), do: [x, y]
defp digit(5, _, y, _), do: [y]
defp digit(6, x, y, _), do: [y, x]
defp digit(7, x, y, _), do: [y, x, x]
defp digit(8, x, y, _), do: [y, x, x, x]
defp digit(9, x, _, z), do: [x, z]
end

10
Task/Roman-numerals-Encode/Elixir/roman-numerals-encode-2.elixir Normal file
View file

@ -0,0 +1,10 @@
defmodule Roman_numeral do
@symbols [ {1000, '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'} ]
def encode(num) do
{roman,_} = Enum.reduce(@symbols, {[], num}, fn {divisor, letter}, {memo, n} ->
{memo ++ List.duplicate(letter, div(n, divisor)), rem(n, divisor)}
end)
Enum.join(roman)
end
end

3
Task/Roman-numerals-Encode/Elixir/roman-numerals-encode-3.elixir Normal file
View file

@ -0,0 +1,3 @@
Enum.each([1990, 2008, 1666], fn n ->
IO.puts "#{n}: #{Roman_numeral.encode(n)}"
end)

17
Task/Roman-numerals-Encode/Emacs-Lisp/roman-numerals-encode.l Normal file
View file

@ -0,0 +1,17 @@
(defun ar2ro (AN)
"Translate from arabic number AN to roman number.
For example, (ar2ro 1666) returns (M D C L X V I)."
(cond
((>= AN 1000) (cons 'M (ar2ro (- AN 1000))))
((>= AN 900) (cons 'C (cons 'M (ar2ro (- AN 900)))))
((>= AN 500) (cons 'D (ar2ro (- AN 500))))
((>= AN 400) (cons 'C (cons 'D (ar2ro (- AN 400)))))
((>= AN 100) (cons 'C (ar2ro (- AN 100))))
((>= AN 90) (cons 'X (cons 'C (ar2ro (- AN 90)))))
((>= AN 50) (cons 'L (ar2ro (- AN 50))))
((>= AN 40) (cons 'X (cons 'L (ar2ro (- AN 40)))))
((>= AN 10) (cons 'X (ar2ro (- AN 10))))
((>= AN 5) (cons 'V (ar2ro (- AN 5))))
((>= AN 4) (cons 'I (cons 'V (ar2ro (- AN 4)))))
((>= AN 1) (cons 'I (ar2ro (- AN 1))))
((= AN 0) nil)))

20
Task/Roman-numerals-Encode/Erlang/roman-numerals-encode-1.erl Normal file
View file

@ -0,0 +1,20 @@
-module(roman).
-export([to_roman/1]).
to_roman(0) -> [];
to_roman(X) when X >= 1000 -> [$M | to_roman(X - 1000)];
to_roman(X) when X >= 100 ->
digit(X div 100, $C, $D, $M) ++ to_roman(X rem 100);
to_roman(X) when X >= 10 ->
digit(X div 10, $X, $L, $C) ++ to_roman(X rem 10);
to_roman(X) when X >= 1 -> digit(X, $I, $V, $X).
digit(1, X, _, _) -> [X];
digit(2, X, _, _) -> [X, X];
digit(3, X, _, _) -> [X, X, X];
digit(4, X, Y, _) -> [X, Y];
digit(5, _, Y, _) -> [Y];
digit(6, X, Y, _) -> [Y, X];
digit(7, X, Y, _) -> [Y, X, X];
digit(8, X, Y, _) -> [Y, X, X, X];
digit(9, X, _, Z) -> [X, Z].

20
Task/Roman-numerals-Encode/Erlang/roman-numerals-encode-2.erl Normal file
View file

@ -0,0 +1,20 @@
-module( roman_numerals ).
-export( [encode_from_integer/1]).
-record( encode_acc, {n, romans=""} ).
encode_from_integer( N ) when N > 0 ->
#encode_acc{romans=Romans} = lists:foldl( fun encode_from_integer/2, #encode_acc{n=N}, map() ),
Romans.
encode_from_integer( _Map, #encode_acc{n=0}=Acc ) -> Acc;
encode_from_integer( {_Roman, Value}, #encode_acc{n=N}=Acc ) when N < Value -> Acc;
encode_from_integer( {Roman, Value}, #encode_acc{n=N, romans=Romans} ) ->
Times = N div Value,
New_roman = lists:flatten( lists:duplicate(Times, Roman) ),
#encode_acc{n=N - (Times * Value), romans=Romans ++ New_roman}.
map() -> [{"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}].

18
Task/Roman-numerals-Encode/Euphoria/roman-numerals-encode.euphoria Normal file
View file

@ -0,0 +1,18 @@
constant arabic = {1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 }
constant roman = {"M", "CM", "D","CD", "C","XC","L","XL","X","IX","V","IV","I"}
function toRoman(integer val)
sequence result
result = ""
for i = 1 to 13 do
while val >= arabic[i] do
result &= roman[i]
val -= arabic[i]
end while
end for
return result
end function
printf(1,"%d = %s\n",{2009,toRoman(2009)})
printf(1,"%d = %s\n",{1666,toRoman(1666)})
printf(1,"%d = %s\n",{3888,toRoman(3888)})

1
Task/Roman-numerals-Encode/Excel/roman-numerals-encode-1.excel Normal file
View file

@ -0,0 +1 @@
=ROMAN(2013,0)

1
Task/Roman-numerals-Encode/Excel/roman-numerals-encode-2.excel Normal file
View file

@ -0,0 +1 @@
MMXIII

28
Task/Roman-numerals-Encode/F-Sharp/roman-numerals-encode.fs Normal file
View file

@ -0,0 +1,28 @@
let digit x y z = function
1 -> x
| 2 -> x + x
| 3 -> x + x + x
| 4 -> x + y
| 5 -> y
| 6 -> y + x
| 7 -> y + x + x
| 8 -> y + x + x + x
| 9 -> x + z
| _ -> failwith "invalid call to digit"
let rec to_roman acc = function
| x when x >= 1000 -> to_roman (acc + "M") (x - 1000)
| x when x >= 100 -> to_roman (acc + digit "C" "D" "M" (x / 100)) (x % 100)
| x when x >= 10 -> to_roman (acc + digit "X" "L" "C" (x / 10)) (x % 10)
| x when x > 0 -> acc + digit "I" "V" "X" x
| 0 -> acc
| _ -> failwith "invalid call to_roman (negative input)"
let roman n = to_roman "" n
[<EntryPoint>]
let main args =
[1990; 2008; 1666]
|> List.map (fun n -> roman n)
|> List.iter (printfn "%s")
0

14
Task/Roman-numerals-Encode/FALSE/roman-numerals-encode.false Normal file
View file

@ -0,0 +1,14 @@
^$." "
[$999>][1000- "M"]#
$899> [ 900-"CM"]?
$499> [ 500- "D"]?
$399> [ 400-"CD"]?
[$ 99>][ 100- "C"]#
$ 89> [ 90-"XC"]?
$ 49> [ 50- "L"]?
$ 39> [ 40-"XL"]?
[$ 9>][ 10- "X"]#
$ 8> [ 9-"IX"]?
$ 4> [ 5- "V"]?
$ 3> [ 4-"IV"]?
[$ ][ 1- "I"]#%

3
Task/Roman-numerals-Encode/Factor/roman-numerals-encode-1.factor Normal file
View file

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

16
Task/Roman-numerals-Encode/Factor/roman-numerals-encode-2.factor Normal file
View file

@ -0,0 +1,16 @@
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 }
ERROR: roman-range-error n ;
: roman-range-check ( n -- n )
dup 1 10000 between? [ roman-range-error ] unless ;
: >roman ( n -- str )
roman-range-check
roman-values roman-digits [
[ /mod swap ] dip <repetition> concat
] 2map "" concat-as nip ;

38
Task/Roman-numerals-Encode/Fan/roman-numerals-encode.fan Normal file
View file

@ -0,0 +1,38 @@
**
** converts a number to its roman numeral representation
**
class RomanNumerals
{
private Str digit(Str x, Str y, Str z, Int i)
{
switch (i)
{
case 1: return x
case 2: return x+x
case 3: return x+x+x
case 4: return x+y
case 5: return y
case 6: return y+x
case 7: return y+x+x
case 8: return y+x+x+x
case 9: return x+z
}
return ""
}
Str toRoman(Int i)
{
if (i>=1000) { return "M" + toRoman(i-1000) }
if (i>=100) { return digit("C", "D", "M", i/100) + toRoman(i%100) }
if (i>=10) { return digit("X", "L", "C", i/10) + toRoman(i%10) }
if (i>=1) { return digit("I", "V", "X", i) }
return ""
}
Void main()
{
2000.times |i| { echo("$i = ${toRoman(i)}") }
}
}

18
Task/Roman-numerals-Encode/Forth/roman-numerals-encode-1.fth Normal file
View file

@ -0,0 +1,18 @@
: vector create ( n -- ) 0 do , loop does> ( n -- ) swap cells + @ execute ;
\ these are ( numerals -- numerals )
: ,I dup c@ C, ; : ,V dup 1 + c@ C, ; : ,X dup 2 + c@ C, ;
\ these are ( numerals -- )
:noname ,I ,X drop ; :noname ,V ,I ,I ,I drop ; :noname ,V ,I ,I drop ;
:noname ,V ,I drop ; :noname ,V drop ; :noname ,I ,V drop ;
:noname ,I ,I ,I drop ; :noname ,I ,I drop ; :noname ,I drop ;
' drop ( 0 : no output ) 10 vector ,digit
: roman-rec ( numerals n -- ) 10 /mod dup if >r over 2 + r> recurse else drop then ,digit ;
: roman ( n -- c-addr u )
dup 0 4000 within 0= abort" EX LIMITO!"
HERE SWAP s" IVXLCDM" drop swap roman-rec HERE OVER - ;
1999 roman type \ MCMXCIX
25 roman type \ XXV
944 roman type \ CMXLIV

19
Task/Roman-numerals-Encode/Forth/roman-numerals-encode-2.fth Normal file
View file

@ -0,0 +1,19 @@
create romans 0 , 1 , 5 , 21 , 9 , 2 , 6 , 22 , 86 , 13 ,
does> swap cells + @ ;
: roman-digit ( a1 n1 a2 n2 -- a3)
drop >r romans
begin dup while tuck 4 mod 1- chars r@ + c@ over c! char+ swap 4 / repeat
r> drop drop
;
: (split) swap >r /mod r> swap ;
: >roman ( n1 a -- a n2)
tuck 1000 (split) s" M " roman-digit 100 (split) s" CDM" roman-digit
10 (split) s" XLC" roman-digit 1 (split) s" IVX" roman-digit nip over -
;
create (roman) 16 chars allot
1999 (roman) >roman type cr

35
Task/Roman-numerals-Encode/Fortran/roman-numerals-encode.f Normal file
View file

@ -0,0 +1,35 @@
program roman_numerals
implicit none
write (*, '(a)') roman (2009)
write (*, '(a)') roman (1666)
write (*, '(a)') roman (3888)
contains
function roman (n) result (r)
implicit none
integer, intent (in) :: n
integer, parameter :: d_max = 13
integer :: d
integer :: m
integer :: m_div
character (32) :: r
integer, dimension (d_max), parameter :: d_dec = &
& (/1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1/)
character (32), dimension (d_max), parameter :: d_rom = &
& (/'M ', 'CM', 'D ', 'CD', 'C ', 'XC', 'L ', 'XL', 'X ', 'IX', 'V ', 'IV', 'I '/)
r = ''
m = n
do d = 1, d_max
m_div = m / d_dec (d)
r = trim (r) // repeat (trim (d_rom (d)), m_div)
m = m - d_dec (d) * m_div
end do
end function roman
end program roman_numerals

20
Task/Roman-numerals-Encode/FreeBASIC/roman-numerals-encode-1.basic Normal file
View file

@ -0,0 +1,20 @@
DIM SHARED arabic(0 TO 12) AS Integer => {1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 }
DIM SHARED roman(0 TO 12) AS String*2 => {"M", "CM", "D","CD", "C","XC","L","XL","X","IX","V","IV","I"}
FUNCTION toRoman(value AS Integer) AS String
DIM i AS Integer
DIM result AS String
FOR i = 0 TO 12
DO WHILE value >= arabic(i)
result = result + roman(i)
value = value - arabic(i)
LOOP
NEXT i
toRoman = result
END FUNCTION
'Testing
PRINT "2009 = "; toRoman(2009)
PRINT "1666 = "; toRoman(1666)
PRINT "3888 = "; toRoman(3888)

31
Task/Roman-numerals-Encode/FreeBASIC/roman-numerals-encode-2.basic Normal file
View file

@ -0,0 +1,31 @@
' FB 1.05.0 Win64
Function romanEncode(n As Integer) As String
If n < 1 OrElse n > 3999 Then Return "" '' can only encode numbers in range 1 to 3999
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 thousands, hundreds, tens, units
thousands = n \ 1000
n Mod= 1000
hundreds = n \ 100
n Mod= 100
tens = n \ 10
units = n Mod 10
Dim roman As String = ""
If thousands > 0 Then roman += roman1(3 - thousands)
If hundreds > 0 Then roman += roman2(9 - hundreds)
If tens > 0 Then roman += roman3(9 - tens)
If units > 0 Then roman += roman4(9 - units)
Return roman
End Function
Dim a(2) As Integer = {1990, 2008, 1666}
For i As Integer = 0 To 2
Print a(i); " => "; romanEncode(a(i))
Next
Print
Print "Press any key to quit"
Sleep

36
Task/Roman-numerals-Encode/FutureBasic/roman-numerals-encode.basic Normal file
View file

@ -0,0 +1,36 @@
window 1
local fn DecimaltoRoman( decimal as short ) as Str15
short arabic(12)
Str15 roman(12)
long i
Str15 result : result = ""
arabic(0) = 1000 : arabic(1) = 900 : arabic(2) = 500 : arabic(3) = 400
arabic(4) = 100 : arabic(5) = 90 : arabic(6) = 50 : arabic(7) = 40
arabic(8) = 10 : arabic(9) = 9 : arabic(10) = 5 : arabic(11) = 4: arabic(12) = 1
roman(0) = "M" : roman(1) = "CM" : roman(2) = "D" : roman(3) = "CD"
roman(4) = "C" : roman(5) = "XC" : roman(6) = "L" : roman(7) = "XL"
roman(8) = "X" : roman(9) = "IX" : roman(10) = "V" : roman(11) = "IV" : roman(12) = "I"
for i = 0 to 12
while ( decimal >= arabic(i) )
result = result + roman(i)
decimal = decimal - arabic(i)
wend
next i
if result == "" then result = "Zepherium"
end fn = result
print "1990 = "; fn DecimaltoRoman( 1990 )
print "2008 = "; fn DecimaltoRoman( 2008 )
print "2016 = "; fn DecimaltoRoman( 2016 )
print "1666 = "; fn DecimaltoRoman( 1666 )
print "3888 = "; fn DecimaltoRoman( 3888 )
print "1914 = "; fn DecimaltoRoman( 1914 )
print "1000 = "; fn DecimaltoRoman( 1000 )
print " 513 = "; fn DecimaltoRoman( 513 )
print " 33 = "; fn DecimaltoRoman( 33 )
HandleEvents

22
Task/Roman-numerals-Encode/GW-BASIC/roman-numerals-encode.basic Normal file
View file

@ -0,0 +1,22 @@
10 REM Roman numerals/Encode
20 DIM WEIGHTS%(12), SYMBOLS$(12)
30 FOR J% = 0 TO 12: READ WEIGHTS%(J%), SYMBOLS$(J%): NEXT J%
40 DATA 1000, "M", 900, "CM", 500, "D", 400, "CD", 100, "C", 90, "XC"
50 DATA 50, "L", 40, "XL", 10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I"
60 REM 3888 or MMMDCCCLXXXVIII (15 chars) is
70 REM the longest string properly encoded
80 REM with these symbols.
90 AVALUE% = 1990: GOSUB 1000: PRINT ROMAN$ ' MCMXC
100 AVALUE% = 2022: GOSUB 1000: PRINT ROMAN$ ' MMXXII
110 AVALUE% = 3888: GOSUB 1000: PRINT ROMAN$ ' MMMDCCCLXXXVIII
120 END
990 REM Encode to roman
1000 ROMAN$ = "": I% = 0
1010 WHILE (I% <= 12) AND (AVALUE% > 0)
1020 WHILE AVALUE% >= WEIGHTS%(I%)
1030 ROMAN$ = ROMAN$ + SYMBOLS$(I%)
1040 AVALUE% = AVALUE% - WEIGHTS%(I%)
1050 WEND
1060 I% = I% + 1
1070 WEND
1080 RETURN

25
Task/Roman-numerals-Encode/Gambas/roman-numerals-encode.gambas Normal file
View file

@ -0,0 +1,25 @@
Public Sub Main()
'Testing
Print "2009 = "; toRoman(2009)
Print "1666 = "; toRoman(1666)
Print "3888 = "; toRoman(3888)
End
Function toRoman(value As Integer) As String
Dim result As String
Dim arabic As Integer[] = [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]
Dim roman As String[] = ["M", "CM", "D", "CD", "C", "XC", "L" , "XL", "X", "IX", "V", "IV", "I"]
For i As Integer = 0 To arabic.Max
Do While value >= arabic[i]
result &= roman[i]
value -= arabic[i]
Loop
Next
Return result
End Function

39
Task/Roman-numerals-Encode/Go/roman-numerals-encode.go Normal file
View file

@ -0,0 +1,39 @@
package main
import "fmt"
var (
m0 = []string{"", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX"}
m1 = []string{"", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC"}
m2 = []string{"", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM"}
m3 = []string{"", "M", "MM", "MMM", "I̅V̅",
"V̅", "V̅I̅", "V̅I̅I̅", "V̅I̅I̅I̅", "I̅X̅"}
m4 = []string{"", "X̅", "X̅X̅", "X̅X̅X̅", "X̅L̅",
"L̅", "L̅X̅", "L̅X̅X̅", "L̅X̅X̅X̅", "X̅C̅"}
m5 = []string{"", "C̅", "C̅C̅", "C̅C̅C̅", "C̅D̅",
"D̅", "D̅C̅", "D̅C̅C̅", "D̅C̅C̅C̅", "C̅M̅"}
m6 = []string{"", "M̅", "M̅M̅", "M̅M̅M̅"}
)
func formatRoman(n int) (string, bool) {
if n < 1 || n >= 4e6 {
return "", false
}
// this is efficient in Go. the seven operands are evaluated,
// then a single allocation is made of the exact size needed for the result.
return m6[n/1e6] + m5[n%1e6/1e5] + m4[n%1e5/1e4] + m3[n%1e4/1e3] +
m2[n%1e3/1e2] + m1[n%100/10] + m0[n%10],
true
}
func main() {
// show three numbers mentioned in task descriptions
for _, n := range []int{1990, 2008, 1666} {
r, ok := formatRoman(n)
if ok {
fmt.Println(n, "==", r)
} else {
fmt.Println(n, "not representable")
}
}
}

59
Task/Roman-numerals-Encode/Golo/roman-numerals-encode.golo Normal file
View file

@ -0,0 +1,59 @@
#!/usr/bin/env golosh
----
This module takes a decimal integer and converts it to a Roman numeral.
----
module Romannumeralsencode
augment java.lang.Integer {
function digits = |this| {
var remaining = this
let digits = vector[]
while remaining > 0 {
digits: prepend(remaining % 10)
remaining = remaining / 10
}
return digits
}
----
123: digitsWithPowers() will return [[1, 2], [2, 1], [3, 0]]
----
function digitsWithPowers = |this| -> vector[
[ this: digits(): get(i), (this: digits(): size() - 1) - i ] for (var i = 0, i < this: digits(): size(), i = i + 1)
]
function encode = |this| {
require(this > 0, "the integer must be positive!")
let romanPattern = |digit, powerOf10| -> match {
when digit == 1 then i
when digit == 2 then i + i
when digit == 3 then i + i + i
when digit == 4 then i + v
when digit == 5 then v
when digit == 6 then v + i
when digit == 7 then v + i + i
when digit == 8 then v + i + i + i
when digit == 9 then i + x
otherwise ""
} with {
i, v, x = [
[ "I", "V", "X" ],
[ "X", "L", "C" ],
[ "C", "D", "M" ],
[ "M", "?", "?" ]
]: get(powerOf10)
}
return vector[ romanPattern(digit, power) foreach digit, power in this: digitsWithPowers() ]: join("")
}
}
function main = |args| {
println("1990 == MCMXC? " + (1990: encode() == "MCMXC"))
println("2008 == MMVIII? " + (2008: encode() == "MMVIII"))
println("1666 == MDCLXVI? " + (1666: encode() == "MDCLXVI"))
}

28
Task/Roman-numerals-Encode/Groovy/roman-numerals-encode.groovy Normal file
View file

@ -0,0 +1,28 @@
symbols = [ 1:'I', 4:'IV', 5:'V', 9:'IX', 10:'X', 40:'XL', 50:'L', 90:'XC', 100:'C', 400:'CD', 500:'D', 900:'CM', 1000:'M' ]
def roman(arabic) {
def result = ""
symbols.keySet().sort().reverse().each {
while (arabic >= it) {
arabic-=it
result+=symbols[it]
}
}
return result
}
assert roman(1) == 'I'
assert roman(2) == 'II'
assert roman(4) == 'IV'
assert roman(8) == 'VIII'
assert roman(16) == 'XVI'
assert roman(32) == 'XXXII'
assert roman(25) == 'XXV'
assert roman(64) == 'LXIV'
assert roman(128) == 'CXXVIII'
assert roman(256) == 'CCLVI'
assert roman(512) == 'DXII'
assert roman(954) == 'CMLIV'
assert roman(1024) == 'MXXIV'
assert roman(1666) == 'MDCLXVI'
assert roman(1990) == 'MCMXC'
assert roman(2008) == 'MMVIII'

23
Task/Roman-numerals-Encode/Haskell/roman-numerals-encode-1.hs Normal file
View file

@ -0,0 +1,23 @@
digit :: Char -> Char -> Char -> Integer -> String
digit x y z k =
[[x], [x, x], [x, x, x], [x, y], [y], [y, x], [y, x, x], [y, x, x, x], [x, z]] !!
(fromInteger k - 1)
toRoman :: Integer -> String
toRoman 0 = ""
toRoman x
| x < 0 = error "Negative roman numeral"
toRoman x
| x >= 1000 = 'M' : toRoman (x - 1000)
toRoman x
| x >= 100 = digit 'C' 'D' 'M' q ++ toRoman r
where
(q, r) = x `divMod` 100
toRoman x
| x >= 10 = digit 'X' 'L' 'C' q ++ toRoman r
where
(q, r) = x `divMod` 10
toRoman x = digit 'I' 'V' 'X' x
main :: IO ()
main = print $ toRoman <$> [1999, 25, 944]

18
Task/Roman-numerals-Encode/Haskell/roman-numerals-encode-2.hs Normal file
View file

@ -0,0 +1,18 @@
import Data.Bifunctor (first)
import Data.List (mapAccumL)
import Data.Tuple (swap)
roman :: Int -> String
roman =
romanFromInt $
zip
[1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]
(words "M CM D CD C XC L XL X IX V IV I")
romanFromInt :: [(Int, String)] -> Int -> String
romanFromInt nks n = concat . snd $ mapAccumL go n nks
where
go a (v, s) = swap $ first ((>> s) . enumFromTo 1) $ quotRem a v
main :: IO ()
main = (putStrLn . unlines) (roman <$> [1666, 1990, 2008, 2016, 2018])

59
Task/Roman-numerals-Encode/Haskell/roman-numerals-encode-3.hs Normal file
View file

@ -0,0 +1,59 @@
module Main where
------------------------
-- ENCODER FUNCTION --
------------------------
romanDigits = "IVXLCDM"
-- Meaning and indices of the romanDigits sequence:
--
-- magnitude | 1 5 | index
-- -----------|-------|-------
-- 0 | I V | 0 1
-- 1 | X L | 2 3
-- 2 | C D | 4 5
-- 3 | M | 6
--
-- romanPatterns are index offsets into romanDigits,
-- from an index base of 2 * magnitude.
romanPattern 0 = [] -- empty string
romanPattern 1 = [0] -- I or X or C or M
romanPattern 2 = [0,0] -- II or XX...
romanPattern 3 = [0,0,0] -- III...
romanPattern 4 = [0,1] -- IV...
romanPattern 5 = [1] -- ...
romanPattern 6 = [1,0]
romanPattern 7 = [1,0,0]
romanPattern 8 = [1,0,0,0]
romanPattern 9 = [0,2]
encodeValue 0 _ = ""
encodeValue value magnitude = encodeValue rest (magnitude + 1) ++ digits
where
low = rem value 10 -- least significant digit (encoded now)
rest = div value 10 -- the other digits (to be encoded next)
indices = map addBase (romanPattern low)
addBase i = i + (2 * magnitude)
digits = map pickDigit indices
pickDigit i = romanDigits!!i
encode value = encodeValue value 0
------------------
-- TEST SUITE --
------------------
main = do
test "MCMXC" 1990
test "MMVIII" 2008
test "MDCLXVI" 1666
test expected value = putStrLn ((show value) ++ " = " ++ roman ++ remark)
where
roman = encode value
remark =
" (" ++
(if roman == expected then "PASS"
else ("FAIL, expected " ++ (show expected))) ++ ")"

22
Task/Roman-numerals-Encode/HicEst/roman-numerals-encode.hicest Normal file
View file

@ -0,0 +1,22 @@
CHARACTER Roman*20
CALL RomanNumeral(1990, Roman) ! MCMXC
CALL RomanNumeral(2008, Roman) ! MMVIII
CALL RomanNumeral(1666, Roman) ! MDCLXVI
END
SUBROUTINE RomanNumeral( arabic, roman)
CHARACTER roman
DIMENSION ddec(13)
DATA ddec/1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1/
roman = ' '
todo = arabic
DO d = 1, 13
DO rep = 1, todo / ddec(d)
roman = TRIM(roman) // TRIM(CHAR(d, 13, "M CM D CD C XC L XL X OX V IV I "))
todo = todo - ddec(d)
ENDDO
ENDDO
END

49
Task/Roman-numerals-Encode/Hoon/roman-numerals-encode-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-Encode/Hoon/roman-numerals-encode-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)
==

24
Task/Roman-numerals-Encode/IS-BASIC/roman-numerals-encode.basic Normal file
View file

@ -0,0 +1,24 @@
100 PROGRAM "Roman.bas"
110 DO
120 PRINT :INPUT PROMPT "Enter an arabic number: ":N
130 IF N<1 THEN EXIT DO
140 PRINT TOROMAN$(N)
150 LOOP
160 DEF TOROMAN$(X)
170 IF X>3999 THEN
180 LET TOROMAN$="Too big."
190 EXIT DEF
200 END IF
210 RESTORE
220 LET SUM$=""
230 FOR I=1 TO 13
240 READ ARABIC,ROMAN$
250 DO WHILE X>=ARABIC
260 LET SUM$=SUM$&ROMAN$
270 LET X=X-ARABIC
280 LOOP
290 NEXT
300 LET TOROMAN$=SUM$
310 END DEF
320 DATA 1000,"M",900,"CM",500,"D",400,"CD",100,"C",90,"XC"
330 DATA 50,"L",40,"XL",10,"X",9,"IX",5,"V",4,"IV",1,"I"

6
Task/Roman-numerals-Encode/Icon/roman-numerals-encode-1.icon Normal file
View file

@ -0,0 +1,6 @@
link numbers # commas, roman
procedure main(arglist)
every x := !arglist do
write(commas(x), " -> ",roman(x)|"*** can't convert to Roman numerals ***")
end

12
Task/Roman-numerals-Encode/Icon/roman-numerals-encode-2.icon Normal file
View file

@ -0,0 +1,12 @@
procedure roman(n) #: convert integer to Roman numeral
local arabic, result
static equiv
initial equiv := ["","I","II","III","IV","V","VI","VII","VIII","IX"]
integer(n) > 0 | fail
result := ""
every arabic := !n do
result := map(result,"IVXLCDM","XLCDM**") || equiv[arabic + 1]
if find("*",result) then fail else return result
end

3
Task/Roman-numerals-Encode/Intercal/roman-numerals-encode.ical Normal file
View file

@ -0,0 +1,3 @@
PLEASE WRITE IN .1
DO READ OUT .1
DO GIVE UP

18
Task/Roman-numerals-Encode/Io/roman-numerals-encode.io Normal file
View file

@ -0,0 +1,18 @@
Roman := Object clone do (
nums := list(1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1)
rum := list("M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I")
numeral := method(number,
result := ""
for(i, 0, nums size,
if(number == 0, break)
while(number >= nums at(i),
number = number - nums at(i)
result = result .. rum at(i)
)
)
return result
)
)
Roman numeral(1666) println

7
Task/Roman-numerals-Encode/J/roman-numerals-encode-1.j Normal file
View file

@ -0,0 +1,7 @@
R1000=. ;L:1 ,{ <@(<;._1);._2]0 :0
C CC CCC CD D DC DCC DCCC CM
X XX XXX XL L LX LXX LXXX XC
I II III IV V VI VII VIII IX
)
rfd=: ('M' $~ <.@%&1000) , R1000 {::~ 1000&|

6
Task/Roman-numerals-Encode/J/roman-numerals-encode-2.j Normal file
View file

@ -0,0 +1,6 @@
rfd 1234
MCCXXXIV
rfd 567
DLXVII
rfd 89
LXXXIX

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