Source code in the lua programming language

  local pk,upk = table.pack, table.unpack
  local getn = function(t)return #t end
  local const = function(k)return function(e) return k end end
  local function attachIdx(f)-- one-time-off function modifier
    local idx = 0
    return function(e)idx=idx+1 ; return f(e,idx)end
  end  
  
  local function reduce(t,acc,f)
    for i=1,t.n or #t do acc=f(acc,t[i])end
    return acc
  end
  local function imap(t,f)
    local r = {n=t.n or #t, r=reduce, u=upk, m=imap}
    for i=1,r.n do r[i]=f(t[i])end
    return r
  end

  local function prod(...)
    local ts = pk(...)
    local limit = imap(ts,getn)
    local idx, cnt = imap(limit,const(1)),  0
    local max = reduce(limit,1,function(a,b)return a*b end)
    local function ret(t,i)return t[idx[i]] end
    return function()
      if cnt>=max then return end -- no more output
      if cnt==0 then -- skip for 1st
        cnt = cnt + 1 
      else
        cnt, idx[#idx] = cnt + 1, idx[#idx] + 1 
        for i=#idx,2,-1 do -- update index list
          if idx[i]<=limit[i] then 
            break -- no further update need
          else -- propagate limit overflow
            idx[i],idx[i-1] = 1, idx[i-1]+1
          end        
        end        
      end
      return cnt,imap(ts,attachIdx(ret)):u()
    end    
  end
--- test
  for i,a,b in prod({1,2},{3,4}) do
    print(i,a,b)
  end
  print()
  for i,a,b in prod({3,4},{1,2}) do
    print(i,a,b)
  end


local function cartesian_product(sets)
  local result = {}
  local set_count = #sets
--[[ I believe that this should make the below go very slightly faster, because it doesn't need to lookup yield in coroutine each time it
     yields, though perhaps the compiler optimises the lookup away? ]]
  local yield = coroutine.yield 
  local function descend(depth)
    if depth == set_count then
      for k,v in pairs(sets[depth]) do
        result[depth] = v
        yield(result)
      end
    else
      for k,v in pairs(sets[depth]) do
        result[depth] = v
        descend(depth + 1)
      end
    end
  end
  return coroutine.wrap(function() descend(1) end)
end

--- tests
local test_cases = {
  {{1, 2}, {3, 4}},
  {{3, 4}, {1, 2}},
  {{1776, 1789}, {7, 12}, {4, 14, 23}, {0,1}},
  {{1,2,3}, {30}, {500, 100}},
  {{1,2,3}, {}, {500, 100}}
}

local function format_nested_list(list)
  if list[1] and type(list[1]) == "table" then
    local formatted_items = {}
    for i, item in ipairs(list) do
      formatted_items[i] = format_nested_list(item)
    end
    return format_nested_list(formatted_items)
  else
    return "{" .. table.concat(list, ",") .. "}"
  end
end

for _,test_case in ipairs(test_cases) do
  print(format_nested_list(test_case))
  for product in cartesian_product(test_case) do
    print("  " .. format_nested_list(product))
  end
end


local function cartesian_product(sets)
  local item_counts = {}
  local indices = {}
  local results = {}
  local set_count = #sets
  local combination_count = 1
  
  for set_index=set_count, 1, -1 do
    local set = sets[set_index]
    local item_count = #set
    item_counts[set_index] = item_count
    indices[set_index] = 1
    results[set_index] = set[1]
    combination_count = combination_count * item_count
  end
  
  local combination_index = 0
  
  return function()
    if combination_index >= combination_count then return end -- no more output

    if combination_index == 0 then goto skip_update end -- skip first index update
    
    indices[set_count] = indices[set_count] + 1
    
    for set_index=set_count, 1, -1 do -- update index list
      local set = sets[set_index]
      local index = indices[set_index]
      if index <= item_counts[set_index] then
        results[set_index] = set[index]
        break -- no further update needed
      else -- propagate item_counts overflow
        results[set_index] = set[1]
        indices[set_index] = 1
        if set_index > 1 then
          indices[set_index - 1] = indices[set_index - 1] + 1
        end
      end
    end
    
    ::skip_update::
    
    combination_index = combination_index + 1
    
    return combination_index, results
  end
end
--- tests
local test_cases = {
  {{1, 2}, {3, 4}},
  {{3, 4}, {1, 2}},
  {{1776, 1789}, {7, 12}, {4, 14, 23}, {0,1}},
  {{1,2,3}, {30}, {500, 100}},
  {{1,2,3}, {}, {500, 100}}
}

local function format_nested_list(list)
  if list[1] and type(list[1]) == "table" then
    local formatted_items = {}
    for i, item in ipairs(list) do
      formatted_items[i] = format_nested_list(item)
    end
    return format_nested_list(formatted_items)
  else
    return "{" .. table.concat(list, ",") .. "}"
  end
end

for _,test_case in ipairs(test_cases) do
  print(format_nested_list(test_case))
  for i, product in cartesian_product(test_case) do
    print(i, format_nested_list(product))
  end
end


-- support:
function T(t) return setmetatable(t, {__index=table}) end
table.clone = function(t) local s=T{} for k,v in ipairs(t) do s[k]=v end return s end
table.reduce = function(t,f,acc) for i=1,#t do acc=f(t[i],acc) end return acc end

-- implementation:
local function cartprod(sets)
  local temp, prod = T{}, T{}
  local function descend(depth)
    for _,v in ipairs(sets[depth]) do
      temp[depth] = v
      if (depth==#sets) then prod[#prod+1]=temp:clone() else descend(depth+1) end
    end
  end
  descend(1)
  return prod
end

-- demonstration:
tests = {
  { {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} }
}
for _,test in ipairs(tests) do
  local cp = cartprod(test)
  print("{"..cp:reduce(function(t,a) return (a=="" and a or a..", ").."("..t:concat(", ")..")" end,"").."}")
end