Cartesian product of two or more lists

From Rosetta Code
Revision as of 17:07, 29 May 2017 by Hout (talk | contribs) (→‎{{header|AppleScript}}: Added an Applescript example for base & n-ary case)
Cartesian product of two or more lists is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
Task

Show one or more idiomatic ways of generating the Cartesian product of two arbitrary lists in your language.

Demonstrate that your function/method correctly returns:

{1, 2} × {3, 4} = {(1, 3), (1, 4), (2, 3), (2, 4)}

and, in contrast:

{3, 4} × {1, 2} = {(3, 1), (3, 2), (4, 1), (4, 2)}

Also demonstrate, using your function/method, that the product of an empty list with any other list is empty.

{1, 2} × {} = {}
{} × {1, 2} = {}

For extra credit, show or write a function returning the n-ary product of an arbitrary number of lists, each of arbitrary length. Your function might, for example, accept a single argument which is itself a list of lists, and return the n-ary product of those lists.

Use your n-ary Cartesian product function to show the following products:

{1776, 1789} × {7, 12} × {4, 14, 23} × {0, 1}}
{1, 2, 3} × {30} × {500, 100}
{1, 2, 3} × {} × {500, 100}

AppleScript

<lang AppleScript>-- CARTESIAN PRODUCTS ---------------------------------------------------------

-- Two lists:

-- cartProd :: [a] -> [b] -> [(a, b)] on cartProd(xs, ys) 

   script
       on |λ|(x)
           script
               on |λ|(y)
                   x, y
               end |λ|
           end script
           concatMap(result, ys)
       end |λ|
   end script
   concatMap(result, xs)

end cartProd

-- N-ary – a function over a list of lists:

-- cartProdNary :: a -> a on cartProdNary(xss) 

   script
       on |λ|(xs, accs)
           script
               on |λ|(x)
                   script
                       on |λ|(a)
                           {x & a}
                       end |λ|
                   end script
                   concatMap(result, accs)
               end |λ|
           end script
           concatMap(result, xs)
       end |λ|
   end script
   foldr(result, {{}}, xss)

end cartProdNary

-- TESTS ---------------------------------------------------------------------- on run 

   set baseExamples to unlines(map(show, ¬
       [cartProd({1, 2}, {3, 4}), ¬
           cartProd({3, 4}, {1, 2}), ¬
           cartProd({1, 2}, {}), ¬
           cartProd({}, {1, 2})]))
   
   set naryA to unlines(map(show, ¬
       cartProdNary([{1776, 1789}, {7, 12}, {4, 14, 23}, {0, 1}])))
   
   set naryB to show(cartProdNary([{1, 2, 3}, {30}, {500, 100}]))
   
   set naryC to show(cartProdNary([{1, 2, 3}, {}, {500, 100}]))
   
   intercalate(linefeed & linefeed, {baseExamples, naryA, naryB, naryC})

end run


-- GENERIC FUNCTIONS ----------------------------------------------------------

-- concatMap :: (a -> [b]) -> [a] -> [b] on concatMap(f, xs) 

   set lst to {}
   set lng to length of xs
   tell mReturn(f)
       repeat with i from 1 to lng
           set lst to (lst & |λ|(item i of xs, i, xs))
       end repeat
   end tell
   return lst

end concatMap

-- foldr :: (a -> b -> a) -> a -> [b] -> a on foldr(f, startValue, xs) 

   tell mReturn(f)
       set v to startValue
       set lng to length of xs
       repeat with i from lng to 1 by -1
           set v to |λ|(v, item i of xs, i, xs)
       end repeat
       return v
   end tell

end foldr

-- 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

-- 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

-- 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

-- show :: a -> String on show(e) 

   set c to class of e
   if c = list then
       script serialized
           on |λ|(v)
               show(v)
           end |λ|
       end script
       
       "[" & intercalate(", ", map(serialized, e)) & "]"
   else if c = record then
       script showField
           on |λ|(kv)
               set {k, ev} to kv
               "\"" & k & "\":" & show(ev)
           end |λ|
       end script
       
       "{" & intercalate(", ", ¬
           map(showField, zip(allKeys(e), allValues(e)))) & "}"
   else if c = date then
       "\"" & iso8601Z(e) & "\""
   else if c = text then
       "\"" & e & "\""
   else if (c = integer or c = real) then
       e as text
   else if c = class then
       "null"
   else
       try
           e as text
       on error
           ("«" & c as text) & "»"
       end try
   end if

end show

-- unlines :: [String] -> String on unlines(xs) 

   intercalate(linefeed, xs)

end unlines</lang>

Output:
[[1, 3], [1, 4], [2, 3], [2, 4]]
[[3, 1], [3, 2], [4, 1], [4, 2]]
[]
[]

[0, 4, 7, 1776]
[0, 4, 7, 1789]
[0, 4, 12, 1776]
[0, 4, 12, 1789]
[0, 14, 7, 1776]
[0, 14, 7, 1789]
[0, 14, 12, 1776]
[0, 14, 12, 1789]
[0, 23, 7, 1776]
[0, 23, 7, 1789]
[0, 23, 12, 1776]
[0, 23, 12, 1789]
[1, 4, 7, 1776]
[1, 4, 7, 1789]
[1, 4, 12, 1776]
[1, 4, 12, 1789]
[1, 14, 7, 1776]
[1, 14, 7, 1789]
[1, 14, 12, 1776]
[1, 14, 12, 1789]
[1, 23, 7, 1776]
[1, 23, 7, 1789]
[1, 23, 12, 1776]
[1, 23, 12, 1789]

[[500, 30, 1], [500, 30, 2], [500, 30, 3], [100, 30, 1], [100, 30, 2], [100, 30, 3]]

[]

Haskell

Various routes can be taken to Cartesian products in Haskell. For the product of two lists we could write: <lang Haskell>cartProd :: [a] -> [a] -> [(a, a)] cartProd xs ys = 

 [ (x, y)
 | x <- xs 
 , y <- ys ]</lang>

Or, more directly: <lang Haskell>cartProd :: [a] -> [a] -> [(a, a)] cartProd xs ys = xs >>= \x -> ys >>= \y -> [(x, y)]</lang>

We might test either of these with: <lang haskell>main :: IO () main = 

 mapM_ print $
 uncurry cartProd <$>
 [([1, 2], [3, 4]), ([3, 4], [1, 2]), ([1, 2], []), ([], [1, 2])]</lang>
Output:
[(1,3),(1,4),(2,3),(2,4)]
[(3,1),(3,2),(4,1),(4,2)]
[]
[]


For the n-ary Cartesian product of an arbitrary number of lists, we could apply the Prelude's standard sequence function to a list of lists, or we could define ourselves an equivalent function over a list of lists in terms of a fold:

For example as: <lang haskell>foldr (\xs as -> xs >>= \x -> as >>= \a -> [x : a]) [[]]</lang> or, equivalently, as: <lang haskell>foldr 

   (\xs as ->
       [ x : a
       | x <- xs
       , a <- as ])
   [[]]</lang>

<lang haskell>main :: IO () main = do 

 mapM_ print $ 
   sequence [[1776, 1789], [7,12], [4, 14, 23], [0,1]]
 putStrLn ""
 print $ sequence [[1,2,3], [30], [500, 100]]
 putStrLn ""
 print $ sequence [[1,2,3], [], [500, 100]]</lang>
Output:
[1776,7,4,0]
[1776,7,4,1]
[1776,7,14,0]
[1776,7,14,1]
[1776,7,23,0]
[1776,7,23,1]
[1776,12,4,0]
[1776,12,4,1]
[1776,12,14,0]
[1776,12,14,1]
[1776,12,23,0]
[1776,12,23,1]
[1789,7,4,0]
[1789,7,4,1]
[1789,7,14,0]
[1789,7,14,1]
[1789,7,23,0]
[1789,7,23,1]
[1789,12,4,0]
[1789,12,4,1]
[1789,12,14,0]
[1789,12,14,1]
[1789,12,23,0]
[1789,12,23,1]

[[1,30,500],[1,30,100],[2,30,500],[2,30,100],[3,30,500],[3,30,100]]

[]

JavaScript

ES6

For the Cartesian product of just two lists: <lang JavaScript>(() => { 

   // CARTESIAN PRODUCT OF TWO LISTS -----------------------------------------

   // cartProd :: [a] -> [b] -> a, b
   const cartProd = (xs, ys) =>
       concatMap((x => concatMap(y => [
           [x, y]
       ], ys)), xs);



   // GENERIC FUNCTIONS ------------------------------------------------------

   // concatMap :: (a -> [b]) -> [a] -> [b]
   const concatMap = (f, xs) => [].concat.apply([], xs.map(f));

   // map :: (a -> b) -> [a] -> [b]
   const map = (f, xs) => xs.map(f);

   // show :: a -> String
   const show = x => JSON.stringify(x); //, null, 2);

   // unlines :: [String] -> String
   const unlines = xs => xs.join('\n');

   // TEST -------------------------------------------------------------------
   return unlines(map(show, [
       cartProd([1, 2], [3, 4]),
       cartProd([3, 4], [1, 2]),
       cartProd([1, 2], []),
       cartProd([], [1, 2]),
   ]));

})();</lang>

Output:
[[1,3],[1,4],[2,3],[2,4]]
[[3,1],[3,2],[4,1],[4,2]]
[]
[]

For the n-ary Cartesian product over a list of lists: <lang JavaScript>(() => { 

   // n-ary Cartesian product of a list of lists

   // cartProdN :: a -> a
   const cartProdN = lists =>
       foldr((xs, as) =>
           bind(xs, x => bind(as, a => [x.concat(a)])), [
               []
           ], lists);

   // GENERIC FUNCTIONS ------------------------------------------------------

   // concatMap ::  [a] -> (a -> [b]) -> [b]
   const bind = (xs, f) => [].concat.apply([], xs.map(f));

   // foldr (a -> b -> b) -> b -> [a] -> b
   const foldr = (f, a, xs) => xs.reduceRight(f, a);

   // intercalate :: String -> [a] -> String
   const intercalate = (s, xs) => xs.join(s);

   // map :: (a -> b) -> [a] -> [b]
   const map = (f, xs) => xs.map(f);

   // show :: a -> String
   const show = x => JSON.stringify(x);

   // unlines :: [String] -> String
   const unlines = xs => xs.join('\n');

   // TEST -------------------------------------------------------------------
   return intercalate('\n\n', [unlines(map(show, cartProdN([
           [1776, 1789],
           [7, 12],
           [4, 14, 23],
           [0, 1]
       ]))),
       show(cartProdN([
           [1, 2, 3],
           [30],
           [50, 100]
       ])),
       show(cartProdN([
           [1, 2, 3],
           [],
           [50, 100]
       ]))
   ])

})();</lang>

Output:
[0,4,7,1776]
[0,4,7,1789]
[0,4,12,1776]
[0,4,12,1789]
[0,14,7,1776]
[0,14,7,1789]
[0,14,12,1776]
[0,14,12,1789]
[0,23,7,1776]
[0,23,7,1789]
[0,23,12,1776]
[0,23,12,1789]
[1,4,7,1776]
[1,4,7,1789]
[1,4,12,1776]
[1,4,12,1789]
[1,14,7,1776]
[1,14,7,1789]
[1,14,12,1776]
[1,14,12,1789]
[1,23,7,1776]
[1,23,7,1789]
[1,23,12,1776]
[1,23,12,1789]

[[50,30,1],[50,30,2],[50,30,3],[100,30,1],[100,30,2],[100,30,3]]

[]

Perl 6

Works with: Rakudo version 2017.05

Nominally the cross meta operator X does this, but doesn't gracefully handle the case of an empty list. We can easily wrap it in a subroutine with appropriate filtering however.

<lang perl6>sub cartesian-product (**@list) { ( so none(@list».elems) == 0 ) ?? [X] @list !! () }

  1. Testing various Cartesian products

for 

 ( (1, 2), (3, 4) ),
 ( (3, 4), (1, 2) ),
 ( (1, 2), ( ) ),
 ( ( ), ( 1, 2 ) ),
 ( (1776, 1789), (7, 12), (4, 14, 23), (0, 1) ),
 ( (1, 2, 3), (30), (500, 100) ),
 ( (1, 2, 3), (), (500, 100) )
 -> $list {
     say "\nLists: { $list.perl }\nCartesian Product:";
     say cartesian-product( |$list ).List.perl;
 }</lang>
Output:
Lists: $((1, 2), (3, 4))
Cartesian Product:
((1, 3), (1, 4), (2, 3), (2, 4))

Lists: $((3, 4), (1, 2))
Cartesian Product:
((3, 1), (3, 2), (4, 1), (4, 2))

Lists: $((1, 2), ())
Cartesian Product:
()

Lists: $((), (1, 2))
Cartesian Product:
()

Lists: $((1776, 1789), (7, 12), (4, 14, 23), (0, 1))
Cartesian Product:
((1776, 7, 4, 0), (1776, 7, 4, 1), (1776, 7, 14, 0), (1776, 7, 14, 1), (1776, 7, 23, 0), (1776, 7, 23, 1), (1776, 12, 4, 0), (1776, 12, 4, 1), (1776, 12, 14, 0), (1776, 12, 14, 1), (1776, 12, 23, 0), (1776, 12, 23, 1), (1789, 7, 4, 0), (1789, 7, 4, 1), (1789, 7, 14, 0), (1789, 7, 14, 1), (1789, 7, 23, 0), (1789, 7, 23, 1), (1789, 12, 4, 0), (1789, 12, 4, 1), (1789, 12, 14, 0), (1789, 12, 14, 1), (1789, 12, 23, 0), (1789, 12, 23, 1))

Lists: $((1, 2, 3), 30, (500, 100))
Cartesian Product:
((1, 30, 500), (1, 30, 100), (2, 30, 500), (2, 30, 100), (3, 30, 500), (3, 30, 100))

Lists: $((1, 2, 3), (), (500, 100))
Cartesian Product:
()
Retrieved from "https://rosettacode.org/wiki/Cartesian_product_of_two_or_more_lists?oldid=275822"