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

September 2017 Update

Browse source
This commit is contained in:
Ingy döt Net 2017-09-23 10:01:46 +02:00
parent bba7bfd280
commit ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,37 +1,51 @@
-- ROMAN INTEGER STRINGS ------------------------------------------------------
-- roman :: Int -> String
on roman(n)
script romanDigits
on lambda(a, lstPair)
set n to remainder of a
set v to item 1 of lstPair
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]}
if v > n then
a
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
{remainder:n mod v, roman:(roman of a) & ¬
replicate(n div v, item 2 of lstPair)}
{r, ""}
end if
end lambda
end |λ|
end script
roman of foldl(romanDigits, {remainder:n, 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"]])
concat(snd(mapAccumL(stringAddedValueDeducted, n, kvs)))
end roman
-- TEST
-- TEST -----------------------------------------------------------------------
on run
map(roman, [2016, 1990, 2008, 2000, 1666])
--> {"MMXVI", "MCMXC", "MMVIII", "MM", "MDCLXVI"}
end run
-- GENERIC LIBRARY FUNCTIONS --------------------------------------------------
-- 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)
@ -39,7 +53,7 @@ on foldl(f, startValue, xs)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to lambda(v, item i of xs, i, xs)
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
@ -51,25 +65,55 @@ on map(f, xs)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to lambda(item i of xs, i, xs)
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)
if class of a is list then
set out to {}
else
set out to ""
end if
set out to {}
if n < 1 then return out
set dbl to a
set dbl to {a}
repeat while (n > 1)
if (n mod 2) > 0 then set out to out & dbl
@ -79,14 +123,11 @@ on replicate(n, a)
return out & dbl
end replicate
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
-- snd :: (a, b) -> b
on snd(xs)
if class of xs is list and length of xs = 2 then
item 2 of xs
else
script
property lambda : f
end script
missing value
end if
end mReturn
end snd

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

@ -1,13 +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]] !!
[[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
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]

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

@ -1,15 +1,28 @@
import Data.List (mapAccumL)
roman :: Int -> String
roman n = concatMap concat . snd $ mapAccumL tr n
[(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")]
where
tr a (m, s) = (r, replicate q s)
where
(q, r) = quotRem a m
roman n =
concat
(snd
(mapAccumL
(\a (m, s) ->
let (q, r) = quotRem a m
in (r, [1 .. q] >> s))
n
[ (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")
]))
main :: IO ()
main = mapM_ (putStrLn . roman) [1666, 1990, 2008, 2016, 2017]

110
Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-4.js
View file

@ -1,55 +1,71 @@
(() => {
'use strict';
// ROMAN INTEGER STRINGS ----------------------------------------------------
// roman :: Int -> String
const roman = n => [
[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"]
]
.reduce((a, lstPair) => {
const m = a.remainder,
v = lstPair[0];
return (v > m ? a : {
remainder: m % v,
roman: a.roman + Array(
Math.floor(m / v) + 1
)
.join(lstPair[1])
});
}, {
remainder: n,
roman: ''
})
.roman;
const roman = n =>
concat(snd(mapAccumL((balance, [k, v]) => {
const [q, r] = quotRem(balance, v);
return [r, q > 0 ? concat(replicate(q, k)) : ''];
}, n, [
['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]
])));
// TEST
// GENERIC FUNCTIONS -------------------------------------------------------
// If the input is a decimal string, pass any delimiters through
// romanTranscription :: (Int | String) -> String
const romanTranscription = a => {
if (typeof a === 'string') {
const ps = a.split(/\d+/),
dlm = ps.length > 1 ? ps[1] : undefined;
// concat :: [[a]] -> [a] | [String] -> String
const concat = xs =>
xs.length > 0 ? (() => {
const unit = typeof xs[0] === 'string' ? '' : [];
return unit.concat.apply(unit, xs);
})() : [];
return (dlm ? a.split(dlm)
.map(Number) : [a])
.map(roman)
.join(dlm);
} else return roman(a);
}
// map :: (a -> b) -> [a] -> [b]
const map = (f, xs) => xs.map(f);
// TEST
return [2016, 1990, 2008, "14.09.2015", 2000, 1666]
.map(romanTranscription);
// '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])
const mapAccumL = (f, acc, xs) =>
xs.reduce((a, x) => {
const pair = f(a[0], x);
return [pair[0], a[1].concat([pair[1]])];
}, [acc, []]);
// quotRem :: Integral a => a -> a -> (a, a)
const quotRem = (m, n) => [Math.floor(m / n), m % n];
// replicate :: Int -> a -> [a]
const replicate = (n, x) =>
Array.from({
length: n
}, () => x);
// show :: a -> String
const show = (...x) =>
JSON.stringify.apply(
null, x.length > 1 ? [x[0], null, x[1]] : x
);
// snd :: (a, b) -> b
const snd = tpl => Array.isArray(tpl) ? tpl[1] : undefined;
// TEST -------------------------------------------------------------------
return show(
map(roman, [2016, 1990, 2008, 2000, 1666])
);
})();

9
Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-5.js
View file

@ -1,8 +1 @@
[
"MMXVI",
"MCMXC",
"MMVIII",
"XIV.IX.MMXV",
"MM",
"MDCLXVI"
]
["MMXVI","MCMXC","MMVIII","MM","MDCLXVI"]

8
Task/Roman-numerals-Encode/Kotlin/roman-numerals-encode.kotlin
View file

@ -19,14 +19,14 @@ fun encode(number: Int): String? {
return null
}
var num = number
val buffer = StringBuffer()
for ((multiple, numeral) in romanNumerals) {
var result = ""
for ((multiple, numeral) in romanNumerals.entries) {
while (num >= multiple) {
num -= multiple
buffer.append(numeral)
result += numeral
}
}
return buffer.toString()
return result
}
fun main(args: Array<String>) {

48
Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-5.math
View file

@ -1,48 +0,0 @@
:- module roman2.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module char, int, list, string.
main(!IO) :-
command_line_arguments(Args, !IO),
filter_map(to_int, Args, CleanArgs),
foldl((pred(Arg::in, !.IO::di, !:IO::uo) is det :-
( Roman = to_roman(Arg) ->
format("%i => %s",
[i(Arg), s(from_char_list(Roman))], !IO),
nl(!IO)
; format("%i cannot be converted.", [i(Arg)], !IO), nl(!IO) )
), CleanArgs, !IO).
:- func to_roman(int) = list(char).
:- mode to_roman(in) = out is semidet.
to_roman(N) = ( N >= 1000 ->
['M'] ++ to_roman(N - 1000)
;( N >= 100 ->
digit(N / 100, 'C', 'D', 'M') ++ to_roman(N rem 100)
;( N >= 10 ->
digit(N / 10, 'X', 'L', 'C') ++ to_roman(N rem 10)
;( N >= 1 ->
digit(N, 'I', 'V', 'X')
; [] ) ) ) ).
:- func digit(int, char, char, char) = list(char).
:- mode digit(in, in, in, in) = out is semidet.
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].
:- end_module roman2.

3
Task/Roman-numerals-Encode/PlainTeX/roman-numerals-encode.tex Normal file
View file

@ -0,0 +1,3 @@
\def\upperroman#1{\uppercase\expandafter{\romannumeral#1}}
Anno Domini \upperroman{\year}
\bye

5
Task/Roman-numerals-Encode/Protium/roman-numerals-encode-1.protium
View file

@ -1,5 +0,0 @@
<@ DEFUDOLITLIT>_RO|__Transformer|<@ DEFKEYPAR>__NationalNumericID|2</@><@ LETRESCS%NNMPAR>...|1</@></@>
<@ ENU$$DLSTLITLIT>1990,2008,1,2,64,124,1666,10001|,|
<@ SAYELTLST>...</@> is <@ SAY_ROELTLSTLIT>...|RomanLowerUnicode</@> <@ SAY_ROELTLSTLIT>...|RomanUpperUnicode</@> <@ SAY_ROELTLSTLIT>...|RomanASCII</@>
</@>

5
Task/Roman-numerals-Encode/Protium/roman-numerals-encode-2.protium
View file

@ -1,5 +0,0 @@
<# DEFINE USERDEFINEDOPCODE LITERAL LITERAL>_RO|__Transformer|<# DEFINE KEYWORD PARAMETER>__NationalNumericID|2</#><# LET RESULT CAST NATIONALNUMBER PARAMETER>...|1</#></#>
<# ENUMERATION LAMBDASPECIFIEDDELMITER LIST LITERAL LITERAL>1990,2008,1,2,64,124,1666,10001|,|
<# SAY ELEMENT LIST>...</#> is <# SAY _RO ELEMENT LIST LITERAL>...|RomanLowerUnicode</#> <# SAY _RO ELEMENT LIST LITERAL>...|RomanUpperUnicode</#> <# SAY _RO ELEMENT LIST LITERAL>...|RomanASCII</#>
</#>

16
Task/Roman-numerals-Encode/SPL/roman-numerals-encode.spl Normal file
View file

@ -0,0 +1,16 @@
a2r(a)=
r = ""
n = [["M","CM","D","CD","C","XC","L","XL","X","IX","V","IV","I"],[1000,900,500,400,100,90,50,40,10,9,5,4,1]]
> i, 1..13
> a!<n[i,2]
r += n[i,1]
a -= n[i,2]
<
<
<= r
.
t = [1990,2008,1666]
> i, 1..#.size(t,1)
#.output(t[i]," = ",a2r(t[i]))
<

40
Task/Roman-numerals-Encode/Simula/roman-numerals-encode.simula Normal file
View file

@ -0,0 +1,40 @@
BEGIN
TEXT PROCEDURE TOROMAN(N); INTEGER N;
BEGIN
PROCEDURE P(WEIGHT,LIT); INTEGER WEIGHT; TEXT LIT;
BEGIN
WHILE N >= WEIGHT DO
BEGIN
T :- T & LIT;
N := N - WEIGHT;
END WHILE;
END P;
TEXT T; T :- NOTEXT;
P( 1000, "M" );
P( 900, "CM" );
P( 500, "D" );
P( 400, "CD" );
P( 100, "C" );
P( 90, "XC" );
P( 50, "L" );
P( 40, "XL" );
P( 10, "X" );
P( 9, "IX" );
P( 5, "V" );
P( 4, "IV" );
P( 1, "I" );
TOROMAN :- T;
END TOROMAN;
INTEGER Y;
FOR Y := 1990, 2008, 1666 DO
BEGIN
OUTTEXT("YEAR ");
OUTINT(Y, 4);
OUTTEXT(" => ");
OUTTEXT(TOROMAN(Y));
OUTIMAGE;
END FOR;
END PROGRAM;

9
Task/Roman-numerals-Encode/Zkl/roman-numerals-encode.zkl Normal file
View file

@ -0,0 +1,9 @@
var [const] romans = L(
L("M", 1000), L("CM", 900), L("D", 500), L("CD", 400), L("C", 100),
L("XC", 90), L("L", 50), L("XL", 40), L("X", 10), L("IX", 9),
L("V", 5), L("IV", 4), L("I", 1));
fcn toRoman(i){ // convert int to a roman number
reg text = "";
foreach R,N in (romans){ text += R*(i/N); i = i%N; }
return(text);
}