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

46
Task/Order-disjoint-list-items/Aime/order-disjoint-list-items.aime Normal file
View file

@ -0,0 +1,46 @@
void
order(integer m, ...)
{
integer i, j;
record r;
text s;
ocall(o_, 0, 1, m, " ");
o_("| ");
i = (j = m) + 1;
while (i < count()) {
r[s = $i] += 1;
o_(s, " ");
i += 1;
}
o_("->");
i = 0;
do {
i += 1;
if ((r[s = $i] += -1) < 0) {
o_(" ", s);
} else {
o_(" ", $(j += 1));
}
} while (i < m);
o_newline();
}
integer
main(void)
{
order(6, "the", "cat", "sat", "on", "the", "mat", "mat", "cat");
order(6, "the", "cat", "sat", "on", "the", "mat", "cat", "mat");
order(9, "A", "B", "C", "A", "B", "C", "A", "B", "C", "C", "A", "C", "A");
order(9, "A", "B", "C", "A", "B", "D", "A", "B", "E", "E", "A", "D", "A");
order(2, "A", "B", "B");
order(2, "A", "B", "B", "A");
order(4, "A", "B", "B", "A", "B", "A");
return 0;
}

306
Task/Order-disjoint-list-items/AppleScript/order-disjoint-list-items.applescript
View file

@ -1,3 +1,5 @@
-- DISJOINT ORDER ------------------------------------------------------------
-- disjointOrder :: String -> String -> String
on disjointOrder(m, n)
set {ms, ns} to map(my |words|, {m, n})
@ -8,15 +10,17 @@ end disjointOrder
-- segments :: [String] -> [String] -> [String]
on segments(ms, ns)
script segmentation
on lambda(a, x)
on |λ|(a, x)
set wds to |words| of a
if wds contains x then
{parts:(parts of a) & [current of a], current:[], |words|:deleteFirst(x, wds)}
{parts:(parts of a) & ¬
[current of a], current:[], |words|:deleteFirst(x, wds)} ¬
else
{parts:(parts of a), current:(current of a) & x, |words|:wds}
end if
end lambda
end |λ|
end script
tell foldl(segmentation, {|words|:ns, parts:[], current:[]}, ms)
@ -25,14 +29,14 @@ on segments(ms, ns)
end segments
-- TEST --------------------------------------------------------------------------------------
-- TEST ----------------------------------------------------------------------
on run
script order
on lambda(rec)
on |λ|(rec)
tell rec
[its m, its n, my disjointOrder(its m, its n)]
end tell
end lambda
end |λ|
end script
arrowTable(map(order, [¬
@ -43,18 +47,18 @@ on run
{m:"A B", n:"B"}, {m:"A B", n:"B A"}, ¬
{m:"A B B A", n:"B A"}]))
-- the cat sat on the mat -> mat cat -> the mat sat on the cat
-- the cat sat on the mat -> cat mat -> the cat sat on the mat
-- A B C A B C A B C -> C A C A -> C B A C B A A B C
-- A B C A B D A B E -> E A D A -> E B C A B D A B A
-- A B -> B -> A B
-- A B -> B A -> B A
-- A B B A -> B A -> B A B A
-- the cat sat on the mat -> mat cat -> the mat sat on the cat
-- the cat sat on the mat -> cat mat -> the cat sat on the mat
-- A B C A B C A B C -> C A C A -> C B A C B A A B C
-- A B C A B D A B E -> E A D A -> E B C A B D A B A
-- A B -> B -> A B
-- A B -> B A -> B A
-- A B B A -> B A -> B A B A
end run
-- GENERIC FUNCTIONS ----------------------------------------------------------------------
-- GENERIC FUNCTIONS ---------------------------------------------------------
-- Formatting test results
@ -63,52 +67,99 @@ on arrowTable(rows)
script leftAligned
script width
on lambda(a, b)
on |λ|(a, b)
(length of a) - (length of b)
end lambda
end |λ|
end script
on lambda(col)
on |λ|(col)
set widest to length of maximumBy(width, col)
script padding
on lambda(s)
on |λ|(s)
justifyLeft(widest, space, s)
end lambda
end |λ|
end script
map(padding, col)
end lambda
end |λ|
end script
script arrows
on lambda(row)
on |λ|(row)
intercalate(" -> ", row)
end lambda
end |λ|
end script
intercalate(linefeed, ¬
map(arrows, ¬
transpose(map(leftAligned, transpose(rows)))))
end arrowTable
-- transpose :: [[a]] -> [[a]]
on transpose(xss)
script column
on lambda(_, iCol)
script row
on lambda(xs)
item iCol of xs
end lambda
end script
map(row, xss)
end lambda
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
script append
on |λ|(a, b)
a & b
end |λ|
end script
map(column, item 1 of xss)
end transpose
foldl(append, {}, map(f, xs))
end concatMap
-- deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
on deleteBy(fnEq, x, xs)
if length of xs > 0 then
set {h, t} to uncons(xs)
if |λ|(x, h) of mReturn(fnEq) then
t
else
{h} & deleteBy(fnEq, x, t)
end if
else
{}
end if
end deleteBy
-- deleteFirst :: a -> [a] -> [a]
on deleteFirst(x, xs)
script Eq
on |λ|(a, b)
a = b
end |λ|
end script
deleteBy(Eq, x, xs)
end deleteFirst
-- flatten :: Tree a -> [a]
on flatten(t)
if class of t is list then
concatMap(my flatten, t)
else
t
end if
end flatten
-- 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
-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
set {dlm, my text item delimiters} to {my text item delimiters, strText}
set strJoined to lstText as text
set my text item delimiters to dlm
return strJoined
end intercalate
-- justifyLeft :: Int -> Char -> Text -> Text
on justifyLeft(n, cFiller, strText)
@ -119,22 +170,61 @@ on justifyLeft(n, cFiller, strText)
end if
end justifyLeft
-- 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
-- maximumBy :: (a -> a -> Ordering) -> [a] -> a
on maximumBy(f, xs)
set cmp to mReturn(f)
script max
on lambda(a, b)
if a is missing value or cmp's lambda(a, b) < 0 then
on |λ|(a, b)
if a is missing value or cmp's |λ|(a, b) < 0 then
b
else
a
end if
end lambda
end |λ|
end script
foldl(max, missing value, xs)
end maximumBy
-- minimum :: [a] -> a
on minimum(xs)
script min
on |λ|(a, x)
if x < a or a is missing value then
x
else
a
end if
end |λ|
end script
foldl(min, missing value, xs)
end minimum
-- 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
-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length
@ -153,114 +243,22 @@ on replicate(n, a)
return out & dbl
end replicate
-- List functions
-- transpose :: [[a]] -> [[a]]
on transpose(xss)
script column
on |λ|(_, iCol)
script row
on |λ|(xs)
item iCol of xs
end |λ|
end script
-- 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 lambda(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- 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 lambda(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- zip :: [a] -> [b] -> [(a, b)]
on zip(xs, ys)
script pair
on lambda(x, i)
[x, item i of ys]
end lambda
map(row, xss)
end |λ|
end script
map(pair, items 1 thru minimum([length of xs, length of ys]) of xs)
end zip
-- flatten :: Tree a -> [a]
on flatten(t)
if class of t is list then
concatMap(my flatten, t)
else
t
end if
end flatten
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
script append
on lambda(a, b)
a & b
end lambda
end script
foldl(append, {}, map(f, xs))
end concatMap
-- 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 lambda : f
end script
end if
end mReturn
-- deleteFirst :: a -> [a] -> [a]
on deleteFirst(x, xs)
script Eq
on lambda(a, b)
a = b
end lambda
end script
deleteBy(Eq, x, xs)
end deleteFirst
-- minimum :: [a] -> a
on minimum(xs)
script min
on lambda(a, x)
if x < a or a is missing value then
x
else
a
end if
end lambda
end script
foldl(min, missing value, xs)
end minimum
-- deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
on deleteBy(fnEq, x, xs)
if length of xs > 0 then
set {h, t} to uncons(xs)
if lambda(x, h) of mReturn(fnEq) then
t
else
{h} & deleteBy(fnEq, x, t)
end if
else
{}
end if
end deleteBy
map(column, item 1 of xss)
end transpose
-- uncons :: [a] -> Maybe (a, [a])
on uncons(xs)
@ -276,15 +274,19 @@ on unwords(xs)
intercalate(space, xs)
end unwords
-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
set {dlm, my text item delimiters} to {my text item delimiters, strText}
set strJoined to lstText as text
set my text item delimiters to dlm
return strJoined
end intercalate
-- words :: String -> [String]
on |words|(s)
words of s
end |words|
-- zip :: [a] -> [b] -> [(a, b)]
on zip(xs, ys)
script pair
on |λ|(x, i)
[x, item i of ys]
end |λ|
end script
map(pair, items 1 thru minimum([length of xs, length of ys]) of xs)
end zip

41
Task/Order-disjoint-list-items/Haskell/order-disjoint-list-items-1.hs
View file

@ -1,16 +1,33 @@
import Data.List
import Data.List (mapAccumL, sort)
order::Ord a => [[a]] -> [a]
order [ms,ns] = snd.mapAccumL yu ls $ ks
order
:: Ord a
=> [[a]] -> [a]
order [ms, ns] = snd . mapAccumL yu ls $ ks
where
ks = zip ms [(0::Int)..]
ls = zip ns.sort.snd.foldl go (sort ns,[]).sort $ ks
yu ((u,v):us) (_,y) | v == y = (us,u)
yu ys (x,_) = (ys,x)
go ((u:us),ys) (x,y) | u == x = (us,y:ys)
go ts _ = ts
ks = zip ms [(0 :: Int) ..]
ls = zip ns . sort . snd . foldl go (sort ns, []) . sort $ ks
yu ((u, v):us) (_, y)
| v == y = (us, u)
yu ys (x, _) = (ys, x)
go (u:us, ys) (x, y)
| u == x = (us, y : ys)
go ts _ = ts
task ls@[ms,ns] = do
putStrLn $ "M: " ++ ms ++ " | N: " ++ ns ++ " |> " ++ (unwords.order.map words $ ls)
task :: [String] -> IO ()
task ls@[ms, ns] =
putStrLn $
"M: " ++ ms ++ " | N: " ++ ns ++ " |> " ++ (unwords . order . map words $ ls)
main = mapM_ task [["the cat sat on the mat","mat cat"],["the cat sat on the mat","cat mat"],["A B C A B C A B C","C A C A"],["A B C A B D A B E","E A D A"],["A B","B"],["A B","B A"],["A B B A","B A"]]
main :: IO ()
main =
mapM_
task
[ ["the cat sat on the mat", "mat cat"]
, ["the cat sat on the mat", "cat mat"]
, ["A B C A B C A B C", "C A C A"]
, ["A B C A B D A B E", "E A D A"]
, ["A B", "B"]
, ["A B", "B A"]
, ["A B B A", "B A"]
]

77
Task/Order-disjoint-list-items/Haskell/order-disjoint-list-items-2.hs
View file

@ -1,44 +1,55 @@
import Control.Arrow ((***))
import Prelude hiding (unlines, unwords, words, length)
import Data.List (delete, transpose)
import Data.Text hiding (concat, zipWith, foldl, transpose, maximum)
import Data.Text
hiding (concat, zipWith, foldl, transpose, maximum)
disjointOrder :: Eq a => [a] -> [a] -> [a]
disjointOrder
:: Eq a
=> [a] -> [a] -> [a]
disjointOrder m n = concat $ zipWith (++) ms ns
where
ms = segments m n
ns = ((:[]) <$> n) ++ [[]] -- as list of lists, lengthened by 1
segments :: Eq a => [a] -> [a] -> [[a]]
segments m n = _m ++ [_acc]
where
(_m, _, _acc) = foldl split ([], n, []) m
split :: Eq a => ([[a]],[a],[a]) -> a -> ([[a]],[a],[a])
split (ms, ns, acc) x
| elem x ns = (ms ++ [acc], delete x ns, [])
| otherwise = (ms, ns, acc ++ [x])
where
ms = segments m n
ns = ((: []) <$> n) ++ [[]] -- as list of lists, lengthened by 1
segments
:: Eq a
=> [a] -> [a] -> [[a]]
segments m n = _m ++ [_acc]
where
(_m, _, _acc) = foldl split ([], n, []) m
split
:: Eq a
=> ([[a]], [a], [a]) -> a -> ([[a]], [a], [a])
split (ms, ns, acc) x
| x `elem` ns = (ms ++ [acc], delete x ns, [])
| otherwise = (ms, ns, acc ++ [x])
-- TEST -----------------------------------------------------------
tests :: [(Text, Text)]
tests = (\(a, b) -> (pack a, pack b)) <$>
[("the cat sat on the mat","mat cat"),
("the cat sat on the mat","cat mat"),
("A B C A B C A B C","C A C A"),
("A B C A B D A B E","E A D A"),
("A B","B"),
("A B","B A"),
("A B B A","B A")]
tests =
(pack *** pack) <$>
[ ("the cat sat on the mat", "mat cat")
, ("the cat sat on the mat", "cat mat")
, ("A B C A B C A B C", "C A C A")
, ("A B C A B D A B E", "E A D A")
, ("A B", "B")
, ("A B", "B A")
, ("A B B A", "B A")
]
table :: Text -> [[Text]] -> Text
table delim rows = unlines $ (\r -> (intercalate delim r))
<$> (transpose $ (\col ->
let width = (length $ maximum col)
in (justifyLeft width ' ') <$> col) <$> transpose rows)
table delim rows =
unlines $
intercalate delim <$>
transpose
((\col ->
let width = (length $ maximum col)
in justifyLeft width ' ' <$> col) <$>
transpose rows)
main :: IO ()
main = putStr $ unpack $ table (pack " -> ") $
(\(m, n) -> [m, n, unwords (disjointOrder (words m) (words n))])
<$> tests
main =
putStr $
unpack $
table (pack " -> ") $
(\(m, n) -> [m, n, unwords (disjointOrder (words m) (words n))]) <$> tests

0
Task/Order-disjoint-list-items/jq/order-disjoint-list-items-1.jq → Task/Order-disjoint-list-items/Jq/order-disjoint-list-items-1.jq
View file

0
Task/Order-disjoint-list-items/jq/order-disjoint-list-items-2.jq → Task/Order-disjoint-list-items/Jq/order-disjoint-list-items-2.jq
View file

0
Task/Order-disjoint-list-items/jq/order-disjoint-list-items-3.jq → Task/Order-disjoint-list-items/Jq/order-disjoint-list-items-3.jq
View file

0
Task/Order-disjoint-list-items/jq/order-disjoint-list-items-4.jq → Task/Order-disjoint-list-items/Jq/order-disjoint-list-items-4.jq
View file

0
Task/Order-disjoint-list-items/jq/order-disjoint-list-items-5.jq → Task/Order-disjoint-list-items/Jq/order-disjoint-list-items-5.jq
View file

0
Task/Order-disjoint-list-items/jq/order-disjoint-list-items-6.jq → Task/Order-disjoint-list-items/Jq/order-disjoint-list-items-6.jq
View file

0
Task/Order-disjoint-list-items/jq/order-disjoint-list-items-7.jq → Task/Order-disjoint-list-items/Jq/order-disjoint-list-items-7.jq
View file

0
Task/Order-disjoint-list-items/jq/order-disjoint-list-items-8.jq → Task/Order-disjoint-list-items/Jq/order-disjoint-list-items-8.jq
View file

0
Task/Order-disjoint-list-items/jq/order-disjoint-list-items-9.jq → Task/Order-disjoint-list-items/Jq/order-disjoint-list-items-9.jq
View file

39
Task/Order-disjoint-list-items/Kotlin/order-disjoint-list-items.kotlin Normal file
View file

@ -0,0 +1,39 @@
// version 1.0.6
const val NULL = "\u0000"
fun orderDisjointList(m: String, n: String): String {
val nList = n.split(' ')
// first replace the first occurrence of items of 'n' in 'm' with the NULL character
// which we can safely assume won't occur in 'm' naturally
var p = m
for (item in nList) p = p.replaceFirst(item, NULL)
// now successively replace the NULLs with items from nList
val mList = p.split(NULL)
val sb = StringBuilder()
for (i in 0 until nList.size) sb.append(mList[i], nList[i])
return sb.append(mList.last()).toString()
}
fun main(args: Array<String>) {
val m = arrayOf(
"the cat sat on the mat",
"the cat sat on the mat",
"A B C A B C A B C",
"A B C A B D A B E",
"A B",
"A B",
"A B B A"
)
val n = arrayOf(
"mat cat",
"cat mat",
"C A C A",
"E A D A",
"B",
"B A",
"B A"
)
for (i in 0 until m.size)
println("${m[i].padEnd(22)} -> ${n[i].padEnd(7)} -> ${orderDisjointList(m[i], n[i])}")
}

20
Task/Order-disjoint-list-items/REXX/order-disjoint-list-items.rexx
View file

@ -1,4 +1,4 @@
/*REXX program orders a disjoint list of M items with a list of N items. */
/*REXX program orders a disjoint list of M items with a list of N items. */
used = '0'x /*indicates that a word has been parsed*/
@. = /*placeholder indicates end─of─array, */
@.1 = " the cat sat on the mat | mat cat " /*a string. */
@ -17,29 +17,29 @@ used = '0'x /*indicates that a word has bee
@.14 = " A B C C B A | A C A C " /*" " */
@.15 = " A B C C B A | C A C A " /*" " */
/* ════════════M═══════════ ════N════ */
/* [↓] process each input strings. */
do j=1 while @.j\==''; r.= /*nullify the replacement string [R.] */
do j=1 while @.j\=='' /* [↓] process each input string (@.).*/
parse var @.j m '|' n /*parse input string into M and N. */
#=words(m) /*#: number of words in the M list.*/
do i=# for # by -1 /*process list items in reverse order. */
_=word(m,i); !.i=_; $._=i /*construct the !. and $. arrays.*/
_=word(m, i); !.i=_; $._=i /*construct the !. and $. arrays.*/
end /*i*/
do k=1 for words(n)%2 by 2 /* [↓] process the N array. */
_=word(n,k); v=word(n,k+1) /*get an order word and the replacement*/
p1=wordpos(_,m); p2=wordpos(v,m) /*positions of " " " " */
r.= /*nullify the replacement string [R.] */
do k=1 by 2 for words(n) % 2 /* [↓] process the N array. */
_=word(n, k); v=word(n, k+1) /*get an order word and the replacement*/
p1=wordpos(_, m); p2=wordpos(v, m) /*positions of " " " " */
if p1==0 | p2==0 then iterate /*if either not found, then skip them. */
if $._>>$.v then do; r.p2=!.p1; r.p1=!.p2; end /*switch the words.*/
else do; r.p1=!.p1; r.p2=!.p2; end /*don't switch. */
!.p1=used; !.p2=used /*mark 'em as used.*/
m=
do i=1 for #; m=m !.i; _=word(m,i); !.i=_; $._=i; end /*i*/
do i=1 for #; m=m !.i; _=word(m, i); !.i=_; $._=i; end /*i*/
end /*k*/ /* [↑] rebuild the !. and $. arrays.*/
mp= /*the MP (aka M') string (so far). */
do q=1 for #; if !.q==used then mp=mp r.q /*use the original.*/
else mp=mp !.q /*use substitute. */
end /*q*/ /* [↑] re─build the (output) string. */
say @.j '───►' space(mp) /*display new re─ordered text ──► term.*/
say @.j ' ────► ' space(mp) /*display new re─ordered text ──► term.*/
end /*j*/ /* [↑] end of processing for N words*/
/*stick a fork in it, we're all done. */

10
Task/Order-disjoint-list-items/Zkl/order-disjoint-list-items-1.zkl Normal file
View file

@ -0,0 +1,10 @@
fcn disOrder(sm,sn){
M:=sm.split(" ");
N:=sn.split(" "); nc:=Walker.cycle(Utils.Helpers.listUnique(N));
dn:=Dictionary(); N.pump(Void,'wrap(w){ dn[w] = dn.find(w,0) + 1; });
M.pump(String,'wrap(w){
if (Void==(n:=dn.find(w))) return(w); // not replaced
if (n) { dn[w]=n-1; nc.next(); } // swaps left--
else { nc.next(); w } // exhausted
}, String.fp(" ") )[1,*] // remove leading blank
}

8
Task/Order-disjoint-list-items/Zkl/order-disjoint-list-items-2.zkl Normal file
View file

@ -0,0 +1,8 @@
sets:=T(T("the cat sat on the mat","mat cat"),
T("the cat sat on the mat","cat mat"),
T("A B C A B C A B C","C A C A"),
T("A B C A B D A B E","E A D A"),
T("A B","B"), T("A B","B A"), T("A B B A","B A") );
foreach m,n in (sets){
m.println(" / ",n," --> ",disOrder(m,n));
}