Order disjoint list items
Given M
as a list of items and another list N
of items chosen from M
, create M'
as a list with the first occurrences of items from N sorted to be in one of the set of indices of their original occurrence in M
but in the order given by their order in N
.
You are encouraged to solve this task according to the task description, using any language you may know.
That is, items in N
are taken from M
without replacement, then the corresponding positions in M'
are filled by successive items from N
.
- For example
- if
M
is'the cat sat on the mat'
- And
N
is'mat cat'
- Then the result
M'
is'the mat sat on the cat'
.
The words not in N
are left in their original positions.
If there are duplications then only the first instances in M
up to as many as are mentioned in N
are potentially re-ordered.
- For example
M = 'A B C A B C A B C'
N = 'C A C A'
Is ordered as:
M' = 'C B A C B A A B C'
Show the output, here, for at least the following inputs:
Data M: 'the cat sat on the mat' Order N: 'mat cat' Data M: 'the cat sat on the mat' Order N: 'cat mat' Data M: 'A B C A B C A B C' Order N: 'C A C A' Data M: 'A B C A B D A B E' Order N: 'E A D A' Data M: 'A B' Order N: 'B' Data M: 'A B' Order N: 'B A' Data M: 'A B B A' Order N: 'B A'
- Cf
AppleScript
Accumulate a segmentation of M over a fold/reduce, and zip with N:
<lang AppleScript>-- disjointOrder :: String -> String -> String
on disjointOrder(m, n)
set {ms, ns} to map(my |words|, {m, n}) unwords(flatten(zip(segments(ms, ns), ns & "")))
end disjointOrder
-- segments :: [String] -> [String] -> [String] on segments(ms, ns)
script segmentation on lambda(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)} else {parts:(parts of a), current:(current of a) & x, |words|:wds} end if end lambda end script tell foldl(segmentation, {|words|:ns, parts:[], current:[]}, ms) (parts of it) & [current of it] end tell
end segments
-- TEST --------------------------------------------------------------------------------------
on run
script order on lambda(rec) tell rec [its m, its n, my disjointOrder(its m, its n)] end tell end lambda end script arrowTable(map(order, [¬ {m:"the cat sat on the mat", n:"mat cat"}, ¬ {m:"the cat sat on the mat", n:"cat mat"}, ¬ {m:"A B C A B C A B C", n:"C A C A"}, ¬ {m:"A B C A B D A B E", n:"E A D A"}, ¬ {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
end run
-- GENERIC FUNCTIONS ----------------------------------------------------------------------
-- Formatting test results
-- arrowTable :: String -> String on arrowTable(rows)
script leftAligned script width on lambda(a, b) (length of a) - (length of b) end lambda end script on lambda(col) set widest to length of maximumBy(width, col) script padding on lambda(s) justifyLeft(widest, space, s) end lambda end script map(padding, col) end lambda end script script arrows on lambda(row) intercalate(" -> ", row) end lambda 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 end script map(column, item 1 of xss)
end transpose
-- justifyLeft :: Int -> Char -> Text -> Text on justifyLeft(n, cFiller, strText)
if n > length of strText then text 1 thru n of (strText & replicate(n, cFiller)) else strText end if
end justifyLeft
-- 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 b else a end if end lambda end script foldl(max, missing value, xs)
end maximumBy
-- 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
-- List functions
-- 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 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
-- uncons :: [a] -> Maybe (a, [a]) on uncons(xs)
if length of xs > 0 then {item 1 of xs, rest of xs} else missing value end if
end uncons
-- unwords :: [String] -> String 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|</lang>
- Output:
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
AutoHotkey
<lang AutoHotkey>Data := [ {M: "the cat sat on the mat", N: "mat cat"} , {M: "the cat sat on the mat", N: "cat mat"} , {M: "A B C A B C A B C", N: "C A C A"} , {M: "A B C A B D A B E", N: "E A D A"} , {M: "A B", N: "B"} , {M: "A B", N: "B A"} , {M: "A B B A", N: "B A"} ]
for Key, Val in Data Output .= Val.M " :: " Val.N " -> " OrderDisjointList(Val.M, Val.N) "`n" MsgBox, % RTrim(Output, "`n")
OrderDisjointList(M, N) { ItemsN := [] Loop, Parse, N, % A_Space ItemsN[A_LoopField] := ItemsN[A_LoopField] ? ItemsN[A_LoopField] + 1 : 1 N := StrSplit(N, A_Space) Loop, Parse, M, % A_Space Result .= (ItemsN[A_LoopField]-- > 0 ? N.Remove(1) : A_LoopField) " " return RTrim(Result) }</lang>
- Output:
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
Bracmat
<lang bracmat>( ( odli
= M N NN item A Z R . !arg:(?M.?N) & :?NN & whl ' ( !N:%?item ?N & ( !M:?A !item ?Z & !A (.) !Z:?M & !NN !item:?NN | ) ) & :?R & whl ' ( !M:?A (.) ?M & !NN:%?item ?NN & !R !A !item:?R ) & !R !M )
& (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
& whl
' ( !tests:(?M.?N) ?tests & put$("Data M:" !M) & put$("\tOrder N:" !N) & out$(\t odli$(!M.!N)) )
);</lang> Output:
Data M: the cat sat on the mat Order N: mat cat the mat sat on the cat Data M: the cat sat on the mat Order N: cat mat the cat sat on the mat Data M: A B C A B C A B C Order N: C A C A C B A C B A A B C Data M: A B C A B D A B E Order N: E A D A E B C A B D A B A Data M: A B Order N: B A B Data M: A B Order N: B A B A Data M: A B B A Order N: B A B A B A
Common Lisp
<lang lisp>(defun order-disjoint (data order)
(let ((order-b (make-hash-table :test 'equal))) (loop :for n :in order :do (incf (gethash n order-b 0))) (loop :for m :in data :collect (cond ((< 0 (gethash m order-b 0)) (decf (gethash m order-b)) (pop order)) (t m)))))</lang>
- Output:
CL-USER> (order-disjoint '(the cat sat on the mat) '(mat cat)) (THE MAT SAT ON THE CAT) CL-USER> (order-disjoint '(the cat sat on the mat) '(cat mat)) (THE CAT SAT ON THE MAT) CL-USER> (order-disjoint '(a b c a b c a b c) '(c a c a)) (C B A C B A A B C) CL-USER> (order-disjoint '(a b c a b d a b e) '(e a d a)) (E B C A B D A B A) CL-USER> (order-disjoint '(a b) '(b)) (A B) CL-USER> (order-disjoint '(a b) '(b a)) (B A) CL-USER> (order-disjoint '(a b b a) '(b a)) (B A B A)
D
This version is not efficient. <lang d>import std.stdio, std.string, std.algorithm, std.array, std.range,
std.conv;
T[] orderDisjointArrayItems(T)(in T[] data, in T[] items) pure /*nothrow*/ @safe {
int[] itemIndices; foreach (item; items.dup.sort().uniq) { immutable int itemCount = items.count(item); assert(data.count(item) >= itemCount, text("More of ", item, " than in data")); auto lastIndex = [-1]; foreach (immutable _; 0 .. itemCount) { immutable start = lastIndex.back + 1; lastIndex ~= data[start .. $].countUntil(item) + start; } itemIndices ~= lastIndex.dropOne; }
itemIndices.sort(); auto result = data.dup; foreach (index, item; zip(itemIndices, items)) result[index] = item; return result;
}
void main() {
immutable problems = "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 | A | A A B | A B B A | A B A B A B | A B A B A B | B A B A A B C C B A | A C A C A B C C B A | C A C A" .splitLines.map!(r => r.split("|")).array;
foreach (immutable p; problems) { immutable a = p[0].split; immutable b = p[1].split; writefln("%s | %s -> %-(%s %)", p[0].strip, p[1].strip, orderDisjointArrayItems(a, b)); }
}</lang>
- Output:
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 | -> A | A -> A A B | -> A B A B B A | A B -> A B B A A B A B | A B -> A B A B A B A B | B A B A -> B A B A A B C C B A | A C A C -> A B C A B C A B C C B A | C A C A -> C B A C B A
EchoLisp
<lang scheme> (lib 'list) ;; for list-delete
(define dataM '((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)))
(define orderM '((mat cat) (cat mat) (C A C A) (E A D A) (B) (B A) (B A)))
(define (order-disjoint M N) (define R (append N null)) ;; tmp copy of N : delete w when used (for/list [(w M)] (if (not (member w R)) w ;; output as is (begin0 (first N) ;; replacer (set! N (rest N)) (set! R (list-delete R w))))))
</lang>
- Output:
(for [(m dataM) (n orderM)] (writeln 'M m 'Order n '→ (order-disjoint m n))) M (the cat sat on the mat) Order (mat cat) → (the mat sat on the cat) M (the cat sat on the mat) Order (cat mat) → (the cat sat on the mat) M (A B C A B C A B C) Order (C A C A) → (C B A C B A A B C) M (A B C A B D A B E) Order (E A D A) → (E B C A B D A B A) M (A B) Order (B) → (A B) M (A B) Order (B A) → (B A) M (A B B A) Order (B A) → (B A B A)
Elixir
<lang elixir>defmodule Order do
def disjoint(m,n) do IO.write "#{Enum.join(m," ")} | #{Enum.join(n," ")} -> " Enum.chunk(n,2) |> Enum.reduce({m,0}, fn [x,y],{m,from} -> md = Enum.drop(m, from) if x > y and x in md and y in md do if Enum.find_index(md,&(&1==x)) > Enum.find_index(md,&(&1==y)) do new_from = max(Enum.find_index(m,&(&1==x)), Enum.find_index(m,&(&1==y))) + 1 m = swap(m,from,x,y) from = new_from end end {m,from} end) |> elem(0) |> Enum.join(" ") |> IO.puts end defp swap(m,from,x,y) do ix = Enum.find_index(m,&(&1==x)) + from iy = Enum.find_index(m,&(&1==y)) + from vx = Enum.at(m,ix) vy = Enum.at(m,iy) m |> List.replace_at(ix,vy) |> List.replace_at(iy,vx) end
end
[ {"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"} ]
|> Enum.each(fn {m,n} ->
Order.disjoint(String.split(m),String.split(n)) end)</lang>
- Output:
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
Go
<lang go>package main
import ( "fmt" "sort" "strings" )
type indexSort struct { val sort.Interface ind []int }
func (s indexSort) Len() int { return len(s.ind) } func (s indexSort) Less(i, j int) bool { return s.ind[i] < s.ind[j] } func (s indexSort) Swap(i, j int) { s.val.Swap(s.ind[i], s.ind[j]) s.ind[i], s.ind[j] = s.ind[j], s.ind[i] }
func disjointSliceSort(m, n []string) []string { s := indexSort{sort.StringSlice(m), make([]int, 0, len(n))} used := make(map[int]bool) for _, nw := range n { for i, mw := range m { if used[i] || mw != nw { continue } used[i] = true s.ind = append(s.ind, i) break } } sort.Sort(s) return s.val.(sort.StringSlice) }
func disjointStringSort(m, n string) string { return strings.Join( disjointSliceSort(strings.Fields(m), strings.Fields(n)), " ") }
func main() { for _, data := range []struct{ m, n string }{ {"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"}, } { mp := disjointStringSort(data.m, data.n) fmt.Printf("%s → %s » %s\n", data.m, data.n, mp) }
}</lang>
- Output:
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 the cat sat on the mat → cat cat 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
Haskell
<lang Haskell>import Data.List
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
task ls@[ms,ns] = do
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"]]</lang>
- Output:
M: the cat sat on the mat | N: mat cat |> the mat sat on the cat M: the cat sat on the mat | N: cat mat |> the cat sat on the mat M: A B C A B C A B C | N: C A C A |> C B A C B A A B C M: A B C A B D A B E | N: E A D A |> E B C A B D A B A M: A B | N: B |> A B M: A B | N: B A |> B A M: A B B A | N: B A |> B A B A
Or, accumulating a segmentation of M over a fold, and zipping with N:
<lang Haskell>import Prelude hiding (unlines, unwords, words, length) import Data.List (delete, transpose) import Data.Text hiding (concat, zipWith, foldl, transpose, maximum)
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])
-- 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")]
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)
main :: IO () main = putStr $ unpack $ table (pack " -> ") $
(\(m, n) -> [m, n, unwords (disjointOrder (words m) (words n))]) <$> tests</lang>
- Output:
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
Icon and Unicon
Works in both languages. Assumes a single blank separates items:
<lang unicon>procedure main(A)
every write(" -> ",odli("the cat sat on the mat","mat cat")) every write(" -> ",odli("the cat sat on the mat","cat mat")) every write(" -> ",odli("A B C A B C A B C","C A C A")) every write(" -> ",odli("A B C A B D A B E","E A D A")) every write(" -> ",odli("A B","B")) every write(" -> ",odli("A B","B A")) every write(" -> ",odli("A B B A","B A"))
end
procedure odli(M,N)
writes(M," :: ",N) Mp := "" P := N ||:= " " (M||" ") ? while item := tab(upto(' '))||move(1) do { if find(item,P) then { P ?:= 1(tab(find(item)),move(*item))||tab(0) N ?:= (item := tab(upto(' '))||move(1), tab(0)) } Mp ||:= item } return Mp
end</lang>
Output:
->odli 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 ->
J
Implementation:
<lang J>disjorder=:3 :0&.;:
clusters=. (</. i.@#) x order=. x i.&~. y need=. #/.~ y from=. ;need (#{.)each (/:~order){clusters to=. ;need {.!._ each order{clusters (from{x) to} x
)</lang>
Task examples:
<lang J> 'the cat sat on the mat' disjorder 'mat cat' the mat sat on the cat
'the cat sat on the mat' disjorder 'cat mat'
the cat sat on the mat
'A B C A B C A B C' disjorder 'C A C A'
C B A C B A A B C
'A B C A B D A B E' disjorder 'E A D A'
D B C D B E A B A
'A B' disjorder 'B'
A B
'A B' disjorder 'B A'
B A
'A B B A' disjorder 'B A'
B A B A</lang>
Java
Doesn't handle the case when an item of N is not a member of M. <lang java>import java.util.Arrays; import java.util.BitSet; import org.apache.commons.lang3.ArrayUtils;
public class OrderDisjointItems {
public static void main(String[] args) { final String[][] MNs = {{"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"}, {"X X Y", "X"}};
for (String[] a : MNs) { String[] r = orderDisjointItems(a[0].split(" "), a[1].split(" ")); System.out.printf("%s | %s -> %s%n", a[0], a[1], Arrays.toString(r)); } }
// if input items cannot be null static String[] orderDisjointItems(String[] m, String[] n) { for (String e : n) { int idx = ArrayUtils.indexOf(m, e); if (idx != -1) m[idx] = null; } for (int i = 0, j = 0; i < m.length; i++) { if (m[i] == null) m[i] = n[j++]; } return m; }
// otherwise static String[] orderDisjointItems2(String[] m, String[] n) { BitSet bitSet = new BitSet(m.length); for (String e : n) { int idx = -1; do { idx = ArrayUtils.indexOf(m, e, idx + 1); } while (idx != -1 && bitSet.get(idx)); if (idx != -1) bitSet.set(idx); } for (int i = 0, j = 0; i < m.length; i++) { if (bitSet.get(i)) m[i] = n[j++]; } return m; }
}</lang>
Output:
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] X X Y | X -> [X, X, Y]
JavaScript
ES6
Accumulating a segmentation of M over a fold/reduce, and zipping with N:
<lang JavaScript>(() => {
'use strict';
// GENERIC FUNCTIONS
// concatMap :: (a -> [b]) -> [a] -> [b] const concatMap = (f, xs) => [].concat.apply([], xs.map(f));
// deleteFirst :: a -> [a] -> [a] const deleteFirst = (x, xs) => xs.length > 0 ? ( x === xs[0] ? ( xs.slice(1) ) : [xs[0]].concat(deleteFirst(x, xs.slice(1))) ) : [];
// flatten :: Tree a -> [a] const flatten = t => (t instanceof Array ? concatMap(flatten, t) : [t]);
// unwords :: [String] -> String const unwords = xs => xs.join(' ');
// words :: String -> [String] const words = s => s.split(/\s+/);
// zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] const zipWith = (f, xs, ys) => { const ny = ys.length; return (xs.length <= ny ? xs : xs.slice(0, ny)) .map((x, i) => f(x, ys[i])); };
//------------------------------------------------------------------------
// ORDER DISJOINT LIST ITEMS
// disjointOrder :: [String] -> [String] -> [String] const disjointOrder = (ms, ns) => flatten( zipWith( (a, b) => a.concat(b), segments(ms, ns), ns.concat() ) );
// segments :: [String] -> [String] -> [String] const segments = (ms, ns) => { const dct = ms.reduce((a, x) => { const wds = a.words, blnFound = wds.indexOf(x) !== -1;
return { parts: a.parts.concat(blnFound ? [a.current] : []), current: blnFound ? [] : a.current.concat(x), words: blnFound ? deleteFirst(x, wds) : wds, }; }, { words: ns, parts: [], current: [] });
return dct.parts.concat([dct.current]); };
// ----------------------------------------------------------------------- // FORMATTING TEST OUTPUT
// transpose :: a -> a const transpose = xs => xs[0].map((_, iCol) => xs.map((row) => row[iCol]));
// maximumBy :: (a -> a -> Ordering) -> [a] -> a const maximumBy = (f, xs) => xs.reduce((a, x) => a === undefined ? x : ( f(x, a) > 0 ? x : a ), undefined);
// 2 or more arguments // curry :: Function -> Function const curry = (f, ...args) => { const intArgs = f.length, go = xs => xs.length >= intArgs ? ( f.apply(null, xs) ) : function () { return go(xs.concat([].slice.apply(arguments))); }; return go([].slice.call(args, 1)); };
// justifyLeft :: Int -> Char -> Text -> Text const justifyLeft = (n, cFiller, strText) => n > strText.length ? ( (strText + replicateS(n, cFiller)) .substr(0, n) ) : strText;
// replicateS :: Int -> String -> String const replicateS = (n, s) => { let v = s, o = ; if (n < 1) return o; while (n > 1) { if (n & 1) o = o.concat(v); n >>= 1; v = v.concat(v); } return o.concat(v); };
// -----------------------------------------------------------------------
// TEST return transpose(transpose([{ M: 'the cat sat on the mat', N: 'mat cat' }, { M: 'the cat sat on the mat', N: 'cat mat' }, { M: 'A B C A B C A B C', N: 'C A C A' }, { M: 'A B C A B D A B E', N: 'E A D A' }, { M: 'A B', N: 'B' }, { M: 'A B', N: 'B A' }, { M: 'A B B A', N: 'B A' }].map(dct => [ dct.M, dct.N, unwords(disjointOrder(words(dct.M), words(dct.N))) ])) .map(col => { const width = maximumBy((a, b) => a.length > b.length, col) .length; return col.map(curry(justifyLeft)(width, ' ')); })) .map( ([a, b, c]) => a + ' -> ' + b + ' -> ' + c ) .join('\n');
})();</lang>
- Output:
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
jq
Usage: M | disjoint_order(N) <lang jq>def disjoint_order(N):
# The helper function, indices, ensures that successive occurrences # of a particular value in N are matched by successive occurrences # in the input on the assumption that null is not initially in the input. def indices: . as $in | reduce range(0; N|length) as $i # state: [ array, indices ] ( [$in, []]; (.[0] | index(N[$i])) as $ix | .[0][$ix] = null | .[1] += [$ix]) | .[1];
. as $in | (indices | sort) as $sorted | reduce range(0; N|length) as $i ($in; .[$sorted[$i]] = N[$i] ) ;</lang>
Examples:
(scrollable)
<lang jq>["the", "cat", "sat", "on", "the", "mat"] | indices( ["mat", "cat"] )
- => ["the","mat","sat","on","the","cat"]</lang>
<lang jq>["the", "cat", "sat", "on", "the", "mat"] | disjoint_order( ["cat", "mat"] )
- => ["the","cat","sat","on","the","mat"]</lang>
<lang jq>["A", "B", "C", "A", "B", "C", "A", "B", "C"] | disjoint_order( ["C", "A", "C", "A"] )
- => ["C","B","A","C","B","A","A","B","C"]</lang>
<lang jq>["A", "B", "C", "A", "B", "D", "A", "B", "E"] | disjoint_order( ["E", "A", "D", "A"] )
- => ["E","B","C","A","B","D","A","B","A"]</lang>
<lang jq>["A", "B"] | disjoint_order( ["B"] )
- => ["A","B"]</lang>
<lang jq>["A", "B"] | disjoint_order( ["B", "A"] )
- => ["B","A"]</lang>
<lang jq>["A", "B", "B", "A"] | disjoint_order( ["B", "A"] )
- => ["B","A","B","A"]</lang>
<lang jq>["X", "X", "Y"] | disjoint_order(["X"])
- => [X, X, Y]</lang>
Julia
order_disjoint works by finding the indices of n in m and replacing the elements in m with those in n according to the sorted indices. When n either contains elements not in m or more copies of an element than exist in m, the function throws a DomainError.
Function <lang Julia> function order_disjoint{T<:AbstractArray}(m::T, n::T)
rlen = length(n) rdis = zeros(Int, rlen) for (i, e) in enumerate(n) j = findfirst(m, e) while j in rdis && j != 0 j = findnext(m, e, j+1) end rdis[i] = j end if 0 in rdis throw(DomainError()) end sort!(rdis) p = copy(m) p[rdis] = n return p
end </lang> Main <lang Julia> testm = {["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"], }
testn = {["mat", "cat"],
["cat", "mat"], ["C", "A", "C", "A"], ["E", "A", "D", "A"], ["B"], ["B", "A"], ["B", "A"], }
for i in 1:length(testm)
m = join(testm[i], " ") n = join(testn[i], " ") p = join(order_disjoint(testm[i], testn[i]), " ") println(" (", m, ", ", n, ") => ", p)
end </lang>
- Output:
(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
Lua
<lang Lua>-- Split str on any space characters and return as a table function split (str)
local t = {} for word in str:gmatch("%S+") do table.insert(t, word) end return t
end
-- Order disjoint list items function orderList (dataStr, orderStr)
local data, order = split(dataStr), split(orderStr) for orderPos, orderWord in pairs(order) do for dataPos, dataWord in pairs(data) do if dataWord == orderWord then data[dataPos] = false break end end end local orderPos = 1 for dataPos, dataWord in pairs(data) do if not dataWord then data[dataPos] = order[orderPos] orderPos = orderPos + 1 if orderPos > #order then return data end end end return data
end
-- Main procedure local testCases = {
{'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'}
} for _, example in pairs(testCases) do
print(table.concat(orderList(unpack(example)), " "))
end</lang>
- Output:
the mat sat on the cat the cat sat on the mat C B A C B A A B C E B C A B D A B A A B B A B A B A
Mathematica
<lang Mathematica>order[m_, n_] :=
ReplacePart[m, MapThread[ Rule, {Position[m, Alternatives @@ n][[;; Length[n]]], n}]];
Print[StringRiffle[
order[{"the", "cat", "sat", "on", "the", "mat"}, {"mat", "cat"}]]];
Print[StringRiffle[
order[{"the", "cat", "sat", "on", "the", "mat"}, {"cat", "mat"}]]];
Print[StringRiffle[
order[{"A", "B", "C", "A", "B", "C", "A", "B", "C"}, {"C", "A", "C", "A"}]]];
Print[StringRiffle[
order[{"A", "B", "C", "A", "B", "D", "A", "B", "E"}, {"E", "A", "D", "A"}]]];
Print[StringRiffle[order[{"A", "B"}, {"B"}]]]; Print[StringRiffle[order[{"A", "B"}, {"B", "A"}]]]; Print[StringRiffle[order[{"A", "B", "B", "A"}, {"B", "A"}]]];</lang>
- Output:
the mat sat on the cat the cat sat on the mat C B A C B A A B C E B C A B D A B E A B B A B A B A
Perl
<lang perl>sub dsort {
my ($m, $n) = @_; my %h; $h{$_}++ for @$n; map $h{$_}-- > 0 ? shift @$n : $_, @$m;
}
for (split "\n", <<"IN")
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
IN {
my ($a, $b) = map([split], split '\|'); print "@$a | @$b -> @{[dsort($a, $b)]}\n";
}</lang>
- Output:
the cat sat on the mat | mat cat -> the mat sat on the cat 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
Perl 6
<lang perl6>sub order-disjoint-list-items(\M, \N) {
my \bag = N.BagHash; M.map: { bag{$_}-- ?? N.shift !! $_ }
}</lang>
Testing:
<lang perl6>for q:to/---/.comb(/ [\S+]+ % ' ' /).map({[.words]})
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 X X Y X A X Y A ---
-> $m, $n { say "\n$m ==> $n\n", order-disjoint-list-items($m, $n) }</lang>
- Output:
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 X X Y ==> X X X Y A X ==> Y A Y X
Phix
Modified to support/skip missing elements <lang Phix>function order_disjoint(sequence m, sequence n) integer rlen = length(n) sequence rdis = repeat(0,rlen)
for i=1 to rlen do object e = n[i] integer j = find(e,m) while j!=0 and find(j,rdis) do j = find(e,m,j+1) end while rdis[i] = j end for rdis = sort(rdis) while rlen and rdis[1]=0 do rdis = rdis[2..$] rlen -= 1 end while for i=1 to rlen do m[rdis[i]]=n[i] end for return join(m)
end function
sequence tests = {{"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"}, {"",""}, {"A","A"}, {"A B",""}, {"A B B A","A B"}, {"A B A B","A B"}, {"A B A B","B A B A"}, {"A B C C B A","A C A C"}, {"A B C C B A","C A C A"}, {"A X","Y A"}, {"A X","Y A X"}, {"A X","Y X A"}}
for i=1 to length(tests) do
string {m,n} = tests[i] printf(1,"\"%s\",\"%s\" => \"%s\"\n",{m,n,order_disjoint(split(m),split(n))})
end for </lang>
- Output:
"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" "","" => "" "A","A" => "A" "A B","" => "A B" "A B B A","A B" => "A B B A" "A B A B","A B" => "A B A B" "A B A B","B A B A" => "B A B A" "A B C C B A","A C A C" => "A B C A B C" "A B C C B A","C A C A" => "C B A C B A" "A X","Y A" => "Y X" "A X","Y A X" => "Y A" "A X","Y X A" => "Y X"
PicoLisp
<lang PicoLisp>(de orderDisjoint (M N)
(for S N (and (memq S M) (set @ NIL)) ) (mapcar '((S) (or S (pop 'N))) M ) )</lang>
Test: <lang PicoLisp>: (orderDisjoint '(the cat sat on the mat) '(mat cat)) -> (the mat sat on the cat)
- (orderDisjoint '(the cat sat on the mat) '(cat mat))
-> (the cat sat on the mat)
- (orderDisjoint '(A B C A B C A B C) '(C A C A))
-> (C B A C B A A B C)
- (orderDisjoint '(A B C A B D A B E) '(E A D A))
-> (E B C A B D A B A)
- (orderDisjoint '(A B) '(B))
-> (A B)
- (orderDisjoint '(A B) '(B A))
-> (B A)
- (orderDisjoint '(A B B A) '(B A))
-> (B A B A)</lang>
PowerShell
<lang PowerShell> function sublistsort($M, $N) {
$arr = $M.Split(' ') $array = $N.Split(' ') | group $Count = @($array |foreach {$_.Count}) $ip, $i = @(), 0 $arr | foreach{ $name = "$_" $j = $array.Name.IndexOf($name) if($j -gt -1){ $k = $Count[$j] - 1 if($k -ge 0) { $ip += @($i) $Count[$j] = $k } } $i++ } $i = 0 $N.Split(' ') | foreach{ $arr[$ip[$i++]] = "$_"} [pscustomobject]@{ "M" = "$M " "N" = "$N " "M'" = "$($arr)" }
} $M1 = 'the cat sat on the mat' $N1 = 'mat cat' $M2 = 'the cat sat on the mat' $N2 = 'cat mat' $M3 = 'A B C A B C A B C' $N3 = 'C A C A' $M4 = 'A B C A B D A B E' $N4 = 'E A D A' $M5 = 'A B' $N5 = 'B' $M6 = 'A B' $N6 = 'B A' $M7 = 'A B B A' $N7 = 'B A' sublistsort $M1 $N1 sublistsort $M2 $N2 sublistsort $M3 $N3 sublistsort $M4 $N4 sublistsort $M5 $N5 sublistsort $M6 $N6 sublistsort $M7 $N7 </lang> Output:
M N M' - - -- 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
Python
<lang python>from __future__ import print_function
def order_disjoint_list_items(data, items):
#Modifies data list in-place itemindices = [] for item in set(items): itemcount = items.count(item) #assert data.count(item) >= itemcount, 'More of %r than in data' % item lastindex = [-1] for i in range(itemcount): lastindex.append(data.index(item, lastindex[-1] + 1)) itemindices += lastindex[1:] itemindices.sort() for index, item in zip(itemindices, items): data[index] = item
if __name__ == '__main__':
tostring = ' '.join for data, items in [ (str.split('the cat sat on the mat'), str.split('mat cat')), (str.split('the cat sat on the mat'), str.split('cat mat')), (list('ABCABCABC'), list('CACA')), (list('ABCABDABE'), list('EADA')), (list('AB'), list('B')), (list('AB'), list('BA')), (list('ABBA'), list('BA')), (list(), list()), (list('A'), list('A')), (list('AB'), list()), (list('ABBA'), list('AB')), (list('ABAB'), list('AB')), (list('ABAB'), list('BABA')), (list('ABCCBA'), list('ACAC')), (list('ABCCBA'), list('CACA')), ]: print('Data M: %-24r Order N: %-9r' % (tostring(data), tostring(items)), end=' ') order_disjoint_list_items(data, items) print("-> M' %r" % tostring(data))</lang>
- Output:
Data M: 'the cat sat on the mat' Order N: 'mat cat' -> M' 'the mat sat on the cat' Data M: 'the cat sat on the mat' Order N: 'cat mat' -> M' 'the cat sat on the mat' Data M: 'A B C A B C A B C' Order N: 'C A C A' -> M' 'C B A C B A A B C' Data M: 'A B C A B D A B E' Order N: 'E A D A' -> M' 'E B C A B D A B A' Data M: 'A B' Order N: 'B' -> M' 'A B' Data M: 'A B' Order N: 'B A' -> M' 'B A' Data M: 'A B B A' Order N: 'B A' -> M' 'B A B A' Data M: '' Order N: '' -> M' '' Data M: 'A' Order N: 'A' -> M' 'A' Data M: 'A B' Order N: '' -> M' 'A B' Data M: 'A B B A' Order N: 'A B' -> M' 'A B B A' Data M: 'A B A B' Order N: 'A B' -> M' 'A B A B' Data M: 'A B A B' Order N: 'B A B A' -> M' 'B A B A' Data M: 'A B C C B A' Order N: 'A C A C' -> M' 'A B C A B C' Data M: 'A B C C B A' Order N: 'C A C A' -> M' 'C B A C B A'
Racket
<lang racket>#lang racket (define disjorder
(match-lambda** (((list) n) '()) ((m (list)) m) (((list h m-tail ...) (list h n-tail ...)) (list* h (disjorder m-tail n-tail))) ;; the (not g/h) below stop greedy matching of the list which ;; would pick out orderings from the right first. (((list h (and (not g) m-tail-left) ... g m-tail-right ...) (list g (and (not h) n-tail-left) ... h n-tail-right ...)) (disjorder `(,g ,@m-tail-left ,h ,@m-tail-right) `(,g ,@n-tail-left ,h ,@n-tail-right))) (((list h m-tail ...) n) (list* h (disjorder m-tail n)))))
(define (report-disjorder m n)
(printf "Data M: ~a Order N: ~a -> ~a~%" (~a #:min-width 25 m) (~a #:min-width 10 n) (disjorder m n)))
- Do the task tests
(report-disjorder '(the cat sat on the mat) '(mat cat)) (report-disjorder '(the cat sat on the mat) '(cat mat)) (report-disjorder '(A B C A B C A B C) '(C A C A)) (report-disjorder '(A B C A B D A B E) '(E A D A)) (report-disjorder '(A B) '(B)) (report-disjorder '(A B) '(B A)) (report-disjorder '(A B B A) '(B A))
- Do all of the other python tests
(report-disjorder '() '()) (report-disjorder '(A) '(A)) (report-disjorder '(A B) '()) (report-disjorder '(A B B A) '(A B)) (report-disjorder '(A B A B) '(A B)) (report-disjorder '(A B A B) '(B A B A)) (report-disjorder '(A B C C B A) '(A C A C)) (report-disjorder '(A B C C B A) '(C A C A))</lang>
- Output:
Data M: (the cat sat on the mat) Order N: (mat cat) -> (the mat sat on the cat) Data M: (the cat sat on the mat) Order N: (cat mat) -> (the cat sat on the mat) Data M: (A B C A B C A B C) Order N: (C A C A) -> (C B A C B A A B C) Data M: (A B C A B D A B E) Order N: (E A D A) -> (E B C A B D A B A) Data M: (A B) Order N: (B) -> (A B) Data M: (A B) Order N: (B A) -> (B A) Data M: (A B B A) Order N: (B A) -> (B A B A) Data M: () Order N: () -> () Data M: (A) Order N: (A) -> (A) Data M: (A B) Order N: () -> (A B) Data M: (A B B A) Order N: (A B) -> (A B B A) Data M: (A B A B) Order N: (A B) -> (A B A B) Data M: (A B A B) Order N: (B A B A) -> (B A B A) Data M: (A B C C B A) Order N: (A C A C) -> (A B C A B C) Data M: (A B C C B A) Order N: (C A C A) -> (C B A C B A)
REXX
Items in N needn't be in M. <lang rexx>/*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. */ @.2 = " the cat sat on the mat | cat mat " /*" " */ @.3 = " A B C A B C A B C | C A C A " /*" " */ @.4 = " A B C A B D A B E | E A D A " /*" " */ @.5 = " A B | B " /*" " */ @.6 = " A B | B A " /*" " */ @.7 = " A B B A | B A " /*" " */ @.8 = " | " /*" " */ @.9 = " A | A " /*" " */ @.10 = " A B | " /*" " */ @.11 = " A B B A | A B " /*" " */ @.12 = " A B A B | A B " /*" " */ @.13 = " A B A B | B A B A " /*" " */ @.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.] */ 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.*/ 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 " " " " */ 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*/ 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.*/ end /*j*/ /* [↑] end of processing for N words*/ /*stick a fork in it, we're all done. */</lang>
output using the internal (input) strings:
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 | ───► A | A ───► A A B | ───► A B A B B A | A B ───► A B B A A B A B | A B ───► A B A B A B A B | B A B A ───► B A B A A B C C B A | A C A C ───► A B C A B C A B C C B A | C A C A ───► C B A C B A
Ruby
<lang ruby>def order_disjoint(m,n)
print "#{m} | #{n} -> " m, n = m.split, n.split from = 0 n.each_slice(2) do |x,y| next unless y sd = m[from..-1] if x > y && (sd.include? x) && (sd.include? y) && (sd.index(x) > sd.index(y)) new_from = m.index(x)+1 m[m.index(x)+from], m[m.index(y)+from] = m[m.index(y)+from], m[m.index(x)+from] from = new_from end end puts m.join(' ')
end
[
['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' ]
].each {|m,n| order_disjoint(m,n)}</lang>
- Output:
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
Scala
<lang Scala>def order[T](input: Seq[T], using: Seq[T], used: Seq[T] = Seq()): Seq[T] =
if (input.isEmpty || used.size >= using.size) input else if (using diff used contains input.head) using(used.size) +: order(input.tail, using, used :+ input.head) else input.head +: order(input.tail, using, used)</lang>
Test: <lang Scala>val tests = List(
"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.foreach{case (input, using) =>
val done = order(input.split(" "), using.split(" ")) println(f"""Data M: $input%-24s Order N: $using%-9s -> Result M': ${done mkString " "}""")
}</lang>
- Output:
Data M: the cat sat on the mat Order N: mat cat -> Result M': the mat sat on the cat Data M: the cat sat on the mat Order N: cat mat -> Result M': the cat sat on the mat Data M: A B C A B C A B C Order N: C A C A -> Result M': C B A C B A A B C Data M: A B C A B D A B E Order N: E A D A -> Result M': E B C A B D A B A Data M: A B Order N: B -> Result M': A B Data M: A B Order N: B A -> Result M': B A Data M: A B B A Order N: B A -> Result M': B A B A
Sidef
<lang ruby>func dsort(m, n) {
var h = Hash() n.each {|item| h{item} := 0 ++ } m.map {|item| h{item} := 0 -- > 0 ? n.shift : item}
}
<<'EOT'.lines.each { |line|
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
EOT
var (a, b) = line.split('|').map{.words}... say "#{a.to_s} | #{b.to_s} -> #{dsort(a.clone, b.clone).to_s}"
}</lang>
- Output:
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
Tcl
This is a simple version that assumes that all items in the order list are present in the list to be arranged: <lang tcl>proc orderDisjoint {theList theOrderList} {
foreach item $theOrderList {incr n($item)} set is {} set i 0 foreach item $theList {
if {[info exist n($item)] && [incr n($item) -1] >= 0} { lappend is $i } incr i
} foreach item $theOrderList i $is {lset theList $i $item} return $theList
}</lang> This is a more sophisticated version that handles items in the order list not being present in the list to be arranged: <lang tcl>proc orderDisjoint {theList theOrderList} {
foreach item $theOrderList {incr n($item)} set is - set i 0 foreach item $theList {
if {[info exist n($item)] && [incr n($item) -1] >= 0} { lappend is $i } incr i
} set i 0 foreach item $theOrderList {
if {[incr n($item)] <= 1} { lset theList [lindex $is [incr i]] $item }
} return $theList
}</lang> Demonstration code (produces the same output from both implementations): <lang tcl>foreach {items order} {
"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"
} {
puts "'$items' with '$order' => '[orderDisjoint $items $order]'"
}</lang>
- Output:
'the cat sat on the mat' with 'mat cat' => 'the mat sat on the cat' 'the cat sat on the mat' with 'cat mat' => 'the cat sat on the mat' 'A B C A B C A B C' with 'C A C A' => 'C B A C B A A B C' 'A B C A B D A B E' with 'E A D A' => 'E B C A B D A B A' 'A B' with 'B' => 'A B' 'A B' with 'B A' => 'B A' 'A B B A' with 'B A' => 'B A B A'
zkl
<lang zkl>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
}</lang> A dictionary is used to hold count of the words in N, which is decremented as the words are used up. A cycle of the words is consumed to track the replacement values. It is assumed that there are no leading/trailing/consecutive spaces (easy to cover with a .filter()). <lang zkl>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));
}</lang>
- Output:
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