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

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

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

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

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

@ -4,7 +4,6 @@ defmodule Roman_numeral do
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} -> v1 + v1 + decode(rest)
{v1, _} -> v1 + decode([h2 | rest])
end
end
@ -18,6 +17,6 @@ defmodule Roman_numeral do
defp to_value(?I), do: 1
end
Enum.each(['MCMXC', 'MMVIII', 'MDCLXVI'], fn clist ->
Enum.each(['MCMXC', 'MMVIII', 'MDCLXVI', 'IIIID'], fn clist ->
IO.puts "#{clist}\t: #{Roman_numeral.decode(clist)}"
end)

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

@ -1,44 +1,48 @@
Alternative Forth methodology
\ decode roman numerals using Forth methodology
\ create words to describe and solve the problem
\ ANS/ISO Forth
HEX
: toUpper ( char -- char ) 05F and ;
: TOUPPER ( char -- char ) 05F AND ;
DECIMAL
\ status holders
variable oldndx
variable curndx
variable negcnt
VARIABLE OLDNDX
VARIABLE CURNDX
VARIABLE NEGFLAG
\ word to compile a quote delimtited string into memory
: ," ( -- ) [char] " word C@ 1+ allot ;
: NUMERALS ( -- addr len) S" IVXLCDM" ; ( 1st char is a blank)
CREATE VALUES ( -- addr) 0 , 1 , 5 , 10 , 50 , 100 , 500 , 1000 ,
\ look-up tables place into memory
create numerals ," IVXLCDM"
create values 0 , 1 , 5 , 10 , 50 , 100 , 500 , 1000 ,
: [] ( n addr -- addr[n]) SWAP CELLS + ; \ array address calc.
\ define words to describe/solve the problem
: init ( -- ) curndx off oldndx off negcnt off ;
: toindex ( char -- indx) toUpper numerals count rot SCAN dup 0= abort" invalid numeral" ;
: tovalue ( ndx -- n ) cells values + @ ;
: remember ( ndx -- ndx ) curndx @ oldndx ! dup curndx ! ;
: memory@ ( -- n1 n2 ) curndx @ oldndx @ ;
: numval ( char -- n ) toindex remember tovalue ;
: ?illegal ( ndx -- ) memory@ = negcnt @ and abort" illegal format" ;
: INIT ( -- ) CURNDX OFF OLDNDX OFF NEGFLAG OFF ;
\ logic
: negate? ( n -- +/- n )
memory@ <
if negcnt on
negate
else
?illegal
negcnt off
then ;
: >INDEX ( char -- ndx) TOUPPER >R NUMERALS TUCK R> SCAN NIP -
DUP 7 > ABORT" Invalid Roman numeral" ;
: REMEMBER ( ndx -- ndx ) CURNDX @ OLDNDX ! DUP CURNDX ! ;
: ]VALUE@ ( ndx -- n ) REMEMBER VALUES [] @ ;
: >VALUE ( char -- n ) >INDEX ]VALUE@ ;
: ?ILLEGAL ( ndx -- ) CURNDX @ OLDNDX @ = NEGFLAG @ AND ABORT" Illegal format" ;
\ LOGIC
: ?NEGATE ( n -- +n | -n)
CURNDX @ OLDNDX @ <
IF NEGFLAG ON
NEGATE
ELSE
?ILLEGAL
NEGFLAG OFF
THEN ;
\ solution
: decode ( c-addr -- n )
init
: >ARABIC ( addr len -- n )
INIT
0 \ accumulator on the stack
swap
count 1- bounds swap
do i c@ numval negate? + -1 +loop ;.
-ROT 1- BOUNDS SWAP
DO I C@ >VALUE ?NEGATE + -1 +LOOP ;

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

@ -1,21 +1,19 @@
function parseroman(r::ASCIIString)
const RD = ["I" => 1, "V" => 5, "X" => 10, "L" => 50,
"C" => 100, "D" => 500, "M" => 1000]
maxval = 0
accum = 0
for d in reverse(split(uppercase(r), ""))
if !(d in keys(RD))
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
val = RD[d]
if val > maxval
maxval = val
end
if val < maxval
accum -= val
if val > mval maxval = val end
if val < mval
accm -= val
else
accum += val
accm += val
end
end
return accum
return accm
end

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

@ -1,14 +1,6 @@
testcases = ASCIIString["I", "III", "IX", "IVI", "IIM",
"CMMDXL", "icv", "cDxLiV", "MCMLD", "ccccccd",
"iiiiiv", "MMXV", "MCMLXXXIV", "ivxmm", "SPQR"]
println("Test parseroman, roman => arabic:")
for r in testcases
print(r, " => ")
i = try
parseroman(r)
catch
"Invalid"
end
println(i)
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

35
Task/Roman-numerals-Decode/UNIX-Shell/roman-numerals-decode.sh Normal file
View file

@ -0,0 +1,35 @@
#!/bin/bash
roman_to_dec() {
local rnum=$1
local n=0
local prev=0
for ((i=${#rnum}-1;i>=0;i--))
do
case "${rnum:$i:1}" in
M) a=1000 ;;
D) a=500 ;;
C) a=100 ;;
L) a=50 ;;
X) a=10 ;;
V) a=5 ;;
I) a=1 ;;
esac
if [[ $a -lt $prev ]]
then
let n-=a
else
let n+=a
fi
prev=$a
done
echo "$rnum = $n"
}
roman_to_dec MCMXC
roman_to_dec MMVIII
roman_to_dec MDCLXVI

34
Task/Roman-numerals-Decode/VBA/roman-numerals-decode.vba Normal file
View file

@ -0,0 +1,34 @@
Option Explicit
Sub Main_Romans_Decode()
Dim Arr(), i&
Arr = Array("III", "XXX", "CCC", "MMM", "VII", "LXVI", "CL", "MCC", "IV", "IX", "XC", "ICM", "DCCCXCIX", "CMI", "CIM", "MDCLXVI", "MCMXC", "MMXVII")
For i = 0 To UBound(Arr)
Debug.Print Arr(i) & " >>> " & lngConvert(CStr(Arr(i)))
Next
End Sub
Function Convert(Letter As String) As Long
Dim Romans(), DecInt(), Pos As Integer
Romans = Array("M", "D", "C", "L", "X", "V", "I")
DecInt = Array(1000, 500, 100, 50, 10, 5, 1)
Pos = -1
On Error Resume Next
Pos = Application.Match(Letter, Romans, 0) - 1
On Error GoTo 0
If Pos <> -1 Then Convert = DecInt(Pos)
End Function
Function lngConvert(strRom As String) 'recursive function
Dim i As Long, iVal As Integer
If Len(strRom) = 1 Then
lngConvert = Convert(strRom)
Else
iVal = Convert(Mid(strRom, 1, 1))
If iVal < Convert(Mid(strRom, 2, 1)) Then iVal = iVal * (-1)
lngConvert = iVal + lngConvert(Mid(strRom, 2, Len(strRom) - 1))
End If
End Function