Permutations with repetitions

Permutations with repetitions 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

Generate a sequence of permutations of n elements drawn from choice of k values.

This sequence will have   $n^{k}$   elements, unless the program decides to terminate early.

Do not store all the intermediate values of the sequence, rather generate them as required, and pass the intermediate result to a deciding routine for combinations selection and/or early generator termination.

For example: When "cracking" a "combination" lock a sequence is required, but the sequence is terminated once a successful "combination" is found. This case is a good example of where it is not required to store all the intermediate permutations.

See Also:

The number of samples of size k from n objects.

With   combinations and permutations   generation tasks.

	Order Unimportant	Order Important
Without replacement	${\binom {n}{k}}=^{n}\operatorname {C} _{k}={\frac {n(n-1)\ldots (n-k+1)}{k(k-1)\dots 1}}$	$^{n}\operatorname {P} _{k}=n\cdot (n-1)\cdot (n-2)\cdots (n-k+1)$
	Task: Combinations	Task: Permutations
With replacement	${\binom {n+k-1}{k}}=^{n+k-1}\operatorname {C} _{k}={(n+k-1)! \over (n-1)!k!}$	$n^{k}$
	Task: Combinations with repetitions	Task: Permutations with repetitions

ALGOL 68

Works with: ALGOL 68 version Revision 1 - one minor extension to language used - PRAGMA READ, similar to C's #include directive.

Works with: ALGOL 68G version Any - tested with release algol68g-2.6.

File: prelude_permutations_with_repetitions.a68<lang algol68># -*- coding: utf-8 -*- #

MODE PERMELEMLIST = FLEX[0]PERMELEM; MODE PERMELEMLISTYIELD = PROC(PERMELEMLIST)VOID;

PROC perm gen elemlist = (FLEX[]PERMELEMLIST master, PERMELEMLISTYIELD yield)VOID:(

 [LWB master:UPB master]INT counter;
 [LWB master:UPB master]PERMELEM out;
 FOR i FROM LWB counter TO UPB counter DO
   INT c = counter[i] := LWB master[i];
   out[i] := master[i][c]
 OD;
 yield(out);
 WHILE TRUE DO
   INT next i := LWB counter;
   counter[next i] +:= 1;
   FOR i FROM LWB counter TO UPB counter WHILE counter[i]>UPB master[i] DO
     INT c = counter[i] := LWB master[i];
     out[i] := master[i][c];
     next i := i + 1;
     IF next i > UPB counter THEN done FI;
     counter[next i] +:= 1
   OD;
   INT c = counter[next i];
   out[next i] := master[next i][c];
   yield(out)
 OD;
 done: SKIP

);

SKIP</lang>File: test_permutations_with_repetitions.a68<lang algol68>#!/usr/bin/a68g --script #

1. -*- coding: utf-8 -*- #

MODE PERMELEM = STRING; PR READ "prelude_permutations_with_repetitions.a68" PR;

INT lead actor = 1, co star = 2; PERMELEMLIST actors list = ("Chris Ciaffa", "Keith Urban","Tom Cruise",

                           "Katie Holmes","Mimi Rogers","Nicole Kidman");

FLEX[0]PERMELEMLIST combination := (actors list, actors list, actors list, actors list);

FORMAT partner fmt = $g"; "$; test:(

1. FOR PERMELEMELEM candidate in # perm gen elemlist(combination #) DO (#,
   1. (PERMELEMLIST candidate)VOID: (

   printf((partner fmt,candidate));
   IF candidate[lead actor] = "Keith Urban" AND candidate[co star]="Nicole Kidman" OR
      candidate[co star] = "Keith Urban" AND candidate[lead actor]="Nicole Kidman" THEN
     print((" => Sunday + Faith as extras", new line)); # children #
     done
   FI;
   print(new line)

1. OD #));

 done: SKIP

)</lang>Output:

Chris Ciaffa; Chris Ciaffa; Chris Ciaffa; Chris Ciaffa; 
Keith Urban; Chris Ciaffa; Chris Ciaffa; Chris Ciaffa; 
Tom Cruise; Chris Ciaffa; Chris Ciaffa; Chris Ciaffa; 
Katie Holmes; Chris Ciaffa; Chris Ciaffa; Chris Ciaffa; 
Mimi Rogers; Chris Ciaffa; Chris Ciaffa; Chris Ciaffa; 
Nicole Kidman; Chris Ciaffa; Chris Ciaffa; Chris Ciaffa; 
Chris Ciaffa; Keith Urban; Chris Ciaffa; Chris Ciaffa; 
Keith Urban; Keith Urban; Chris Ciaffa; Chris Ciaffa; 
Tom Cruise; Keith Urban; Chris Ciaffa; Chris Ciaffa; 
Katie Holmes; Keith Urban; Chris Ciaffa; Chris Ciaffa; 
Mimi Rogers; Keith Urban; Chris Ciaffa; Chris Ciaffa; 
Nicole Kidman; Keith Urban; Chris Ciaffa; Chris Ciaffa;  => Sunday + Faith as extras

AutoHotkey

Use the function from http://rosettacode.org/wiki/Permutations#Alternate_Version with opt=1 <lang ahk>P(n,k="",opt=0,delim="",str="") { ; generate all n choose k permutations lexicographically ;1..n = range, or delimited list, or string to parse ; to process with a different min index, pass a delimited list, e.g. "0`n1`n2" ;k = length of result ;opt 0 = no repetitions ;opt 1 = with repetitions ;opt 2 = run for 1..k ;opt 3 = run for 1..k with repetitions ;str = string to prepend (used internally) ;returns delimited string, error message, or (if k > n) a blank string i:=0 If !InStr(n,"`n") If n in 2,3,4,5,6,7,8,9 Loop, %n% n := A_Index = 1 ? A_Index : n "`n" A_Index Else Loop, Parse, n, %delim% n := A_Index = 1 ? A_LoopField : n "`n" A_LoopField If (k = "") RegExReplace(n,"`n","",k), k++ If k is not Digit Return "k must be a digit." If opt not in 0,1,2,3 Return "opt invalid." If k = 0 Return str Else Loop, Parse, n, `n If (!InStr(str,A_LoopField) || opt & 1) s .= (!i++ ? (opt & 2 ? str "`n" : "") : "`n" ) . P(n,k-1,opt,delim,str . A_LoopField . delim) Return s }</lang>

D

opApply Version

Translation of: Scala

<lang d>import std.array;

struct PermutationsWithRepetitions(T) {

   const T[] data;
   const int n;

   int opApply(int delegate(ref T[]) dg) {
       int result;
       T[] aux;

       if (n == 1) {
           foreach (el; data) {
               aux = [el];
               result = dg(aux);
               if (result) goto END;
           }
       } else {
           foreach (el; data) {
               foreach (p; PermutationsWithRepetitions(data, n - 1)) {
                   aux = el ~ p;
                   result = dg(aux);
                   if (result) goto END;
               }
           }
       }

       END:
       return result;
   }

}

auto permutationsWithRepetitions(T)(T[] data, in int n) pure nothrow in {

   assert(!data.empty && n > 0);

} body {

   return PermutationsWithRepetitions!T(data, n);

}

void main() {

   import std.stdio, std.array;
   [1, 2, 3].permutationsWithRepetitions(2).array.writeln;

}</lang>

Output:

[[1, 1], [1, 2], [1, 3], [2, 1], [2, 2], [2, 3], [3, 1], [3, 2], [3, 3]]

Generator Range Version

Translation of: Scala

<lang d>import std.stdio, std.array, std.concurrency;

Generator!(T[]) permutationsWithRepetitions(T)(T[] data, in uint n) in {

   assert(!data.empty && n > 0);

} body {

   return new typeof(return)({
       if (n == 1) {
           foreach (el; data)
               yield([el]);
       } else {
           foreach (el; data)
               foreach (perm; permutationsWithRepetitions(data, n - 1))
                   yield(el ~ perm);
       }
   });

}

void main() {

   [1, 2, 3].permutationsWithRepetitions(2).writeln;

}</lang> The output is the same.

EchoLisp

<lang scheme> (lib 'sequences) ;; (indices ..) (lib 'list) ;; (list-permute ..)

(indices range_1 ..range_k) returns a procrastinator (lazy sequence)

which gives all combinations of indices_i in range_i.

If all k ranges are equal to (0 ...n-1)

(indices (make-vector k n))

will give the n^k permutations with repetitions of the integers (0 ... n-1).

(define perms (indices (make-vector 2 3))) (take perms #:all)

   → (#(0 0) #(0 1) #(0 2) #(1 0) #(1 1) #(1 2) #(2 0) #(2 1) #(2 2))

(length perms) → 9

6-permute the numbers (0 ....9)

(define perms (indices (make-vector 6 10))) (length perms) → 1000000

passing the procrastinator to a routine

which stops when sum = 22

(for ((p perms))

   #:break (= (apply + (vector->list p)) 22) => p )
    →  #( 0 0 0 4 9 9)
    

to permute any objects, use (list-permute list permutation-vector/list)

(list-permute '(a b c d e) '(1 0 1 0 3 2 1))

   → (b a b a d c b)

(list-permute '(a b c d e) #(1 0 1 0 3 2 1))

   → (b a b a d c b)

</lang>

Elixir

Translation of: Erlang

<lang elixir>defmodule RC do

 def perm_rep(list), do: perm_rep(list, length(list))
 
 def perm_rep([], _), do: [[]]
 def perm_rep(_,  0), do: [[]]
 def perm_rep(list, i) do
   for x <- list, y <- perm_rep(list, i-1), do: [x|y]
 end

end

list = [1, 2, 3] Enum.each(1..3, fn n ->

 IO.inspect RC.perm_rep(list,n)

end)</lang>

Output:

[[1], [2], [3]]
[[1, 1], [1, 2], [1, 3], [2, 1], [2, 2], [2, 3], [3, 1], [3, 2], [3, 3]]
[[1, 1, 1], [1, 1, 2], [1, 1, 3], [1, 2, 1], [1, 2, 2], [1, 2, 3], [1, 3, 1],
 [1, 3, 2], [1, 3, 3], [2, 1, 1], [2, 1, 2], [2, 1, 3], [2, 2, 1], [2, 2, 2],
 [2, 2, 3], [2, 3, 1], [2, 3, 2], [2, 3, 3], [3, 1, 1], [3, 1, 2], [3, 1, 3],
 [3, 2, 1], [3, 2, 2], [3, 2, 3], [3, 3, 1], [3, 3, 2], [3, 3, 3]]

Erlang

<lang Erlang>-module(permute). -export([permute/1]).

permute(L) -> permute(L,length(L)). permute([],_) -> [[]]; permute(_,0) -> [[]]; permute(L,I) -> [[X|Y] || X<-L, Y<-permute(L,I-1)].</lang>

Go

<lang go>package main

import "fmt"

var (

   n      = 3
   values = []string{"A", "B", "C", "D"}
   k      = len(values)
   decide = func(p []string) bool {
       return p[0] == "B" && p[1] == "C"
   }

)

func main() {

   pn := make([]int, n)
   p := make([]string, n)
   for {
       // generate permutaton
       for i, x := range pn {
           p[i] = values[x]
       }
       // show progress
       fmt.Println(p)
       // pass to deciding function
       if decide(p) {
           return // terminate early
       }
       // increment permutation number
       for i := 0; ; {
           pn[i]++
           if pn[i] < k {
               break
           }
           pn[i] = 0
           i++
           if i == n {
               return // all permutations generated
           }
       }
   }

}</lang>

Output:

[A A A]
[B A A]
[C A A]
[D A A]
[A B A]
[B B A]
[C B A]
[D B A]
[A C A]
[B C A]

Haskell

<lang haskell>import Control.Monad (replicateM)

main = mapM_ print (replicateM 2 [1,2,3])</lang>

Output:

[1,1]
[1,2]
[1,3]
[2,1]
[2,2]
[2,3]
[3,1]
[3,2]
[3,3]

J

Position in the sequence is an integer from i.n^k, for example:

<lang j> i.3^2 0 1 2 3 4 5 6 7 8</lang>

The sequence itself is expressed using (k#n)#: position, for example:

<lang j> (2#3)#:i.3^2 0 0 0 1 0 2 1 0 1 1 1 2 2 0 2 1 2 2</lang>

Partial sequences belong in a context where they are relevant and the sheer number of such possibilities make it inadvisable to generalize outside of those contexts. But anything that can generate integers will do. For example:

<lang j> (2#3)#:3 4 5 1 0 1 1 1 2</lang>

We might express this as a verb

<lang j>perm=: # #: i.@^~</lang>

with example use:

<lang j> 2 perm 3 0 0 0 1 0 2 1 0 ...</lang>

but the structural requirements of this task (passing intermediate results "when needed") mean that we are not looking for a word that does it all, but are instead looking for components that we can assemble in other contexts. This means that the language primitives are what's needed here.

Java

Works with: Java version 8

<lang java>import java.util.function.Predicate;

public class PermutationsWithRepetitions {

   public static void main(String[] args) {
       char[] chars = {'a', 'b', 'c', 'd'};
       // looking for bba
       permute(chars, 3, i -> i[0] == 1 && i[1] == 1 && i[2] == 0);
   }

   static void permute(char[] a, int k, Predicate<int[]> decider) {
       int n = a.length;
       if (k < 1 || k > n)
           throw new IllegalArgumentException("Illegal number of positions.");

       int[] indexes = new int[n];
       int total = (int) Math.pow(n, k);

       while (total-- > 0) {
           for (int i = 0; i < n - (n - k); i++)
               System.out.print(a[indexes[i]]);
           System.out.println();

           if (decider.test(indexes))
               break;

           for (int i = 0; i < n; i++) {
               if (indexes[i] >= n - 1) {
                   indexes[i] = 0;
               } else {
                   indexes[i]++;
                   break;
               }
           }
       }
   }

}</lang>

Output:

aaa
baa
caa
daa
aba
bba

JavaScript

ES5

Permutations with repetitions, using strict evaluation, generating the entire set (where system constraints permit) with some degree of efficiency. For lazy or interruptible evaluation, see the second example below.

<lang JavaScript>(function () {

   'use strict';

   // permutationsWithRepetition :: Int -> [a] -> a

   var permutationsWithRepetition = function (n, as) {
       return as.length > 0 ? (
           foldl1(curry(cartesianProduct)(as), replicate(n, as))
       ) : [];
   };

   // cartesianProduct :: [a] -> [b] -> a, b
   var cartesianProduct = function (xs, ys) {
       return [].concat.apply([], xs.map(function (x) {
           return [].concat.apply([], ys.map(function (y) {
               return [
                   [x].concat(y)
               ];
           }));
       }));
   };

   // GENERIC FUNCTIONS

   // foldl1 :: (a -> a -> a) -> [a] -> a
   var foldl1 = function (f, xs) {
       return xs.length > 0 ? xs.slice(1)
           .reduce(f, xs[0]) : [];
   };

   // replicate :: Int -> a -> [a]
   var replicate = function (n, a) {
       var v = [a],
           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);
   };

   // curry :: ((a, b) -> c) -> a -> b -> c
   var curry = function (f) {
       return function (a) {
           return function (b) {
               return f(a, b);
           };
       };
   };

   // concatMap :: (a -> [b]) -> [a] -> [b]
   var concatMap = function (f, xs) {
       return [].concat.apply([], xs.map(f));
   };

   // TEST
   // show :: a -> String
   var show = function (x) {
       return JSON.stringify(x);
   }; //, null, 2);

   return show(permutationsWithRepetition(2, [1, 2, 3]));

   //--> [[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]

})();</lang>

Output:

<lang JavaScript>[[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]</lang>

Permutations with repetition by treating the $n^{k}$ elements as an ordered set, and writing a function from a zero-based index to the nth permutation. This allows us terminate a repeated generation on some condition, or explore a sub-set without needing to generate the whole set:

<lang JavaScript>(function () {

   'use strict';

   // nthPermutationWithRepn :: [a] -> Int -> Int -> [a]
   var nthPermutationWithRepn = function (xs, groupSize, index) {
       var intBase = xs.length,
           intSetSize = Math.pow(intBase, groupSize),
           lastIndex = intSetSize - 1; // zero-based

       if (intBase < 1 || index > lastIndex) return undefined;

       var baseElements = unfoldr(function (m) {
               var v = m.new,
                   d = Math.floor(v / intBase);
               return {
                   valid: d > 0,
                   value: xs[v % intBase],
                   new: d
               };
           }, index),
           intZeros = groupSize - baseElements.length;

       return intZeros > 0 ? replicate(intZeros, xs[0])
           .concat(baseElements) : baseElements;
   };

   // GENERIC FUNCTIONS

   // unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
   var unfoldr = function (mf, v) {
       var xs = [];
       return [until(function (m) {
               return !m.valid;
           }, function (m) {
               var m2 = mf(m);
               return m2.valid && (xs = [m2.value].concat(xs)), m2;
           }, {
               valid: true,
               value: v,
               new: v
           })
           .value
       ].concat(xs);
   };

   // until :: (a -> Bool) -> (a -> a) -> a -> a
   var until = function (p, f, x) {
       var v = x;
       while (!p(v)) {
           v = f(v);
       }
       return v;
   };

   // replicate :: Int -> a -> [a]
   var replicate = function (n, a) {
       var v = [a],
           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);
   };

   // show :: a -> String
   var show = function (x) {
       return JSON.stringify(x);
   }; //, null, 2);

   // curry :: Function -> Function
   var curry = function (f) {
       for (var lng = arguments.length,
               args = Array(lng > 1 ? lng - 1 : 0),
               iArg = 1; iArg < lng; iArg++) {
           args[iArg - 1] = arguments[iArg];
       }

       var intArgs = f.length,
           go = function (xs) {
               return xs.length >= intArgs ? f.apply(null, xs) : function () {
                   return go(xs.concat([].slice.apply(arguments)));
               };
           };
       return go([].slice.call(args, 1));
   };

   // range :: Int -> Int -> [Int]
   var range = function (m, n) {
       return Array.from({
           length: Math.floor(n - m) + 1
       }, function (_, i) {
           return m + i;
       });
   };

   // TEST
   // Just items 30 to 35 in the (zero-indexed) series:
   return show(range(30, 35)
       .map(curry(nthPermutationWithRepn)(['X', 'Y', 'Z'], 4)));

})();</lang>

Output:

["Y","X","Y","X"], ["Y","X","Y","Y"], ["Y","X","Y","Z"], ["Y","X","Z","X"], ["Y","X","Z","Y"], ["Y","X","Z","Z"]

ES6

Permutations with repetitions, using strict evaluation, generating the entire set (where system constraints permit) with some degree of efficiency. For lazy or interruptible evaluation, see the second example below.

<lang JavaScript>(() => {

   'use strict';

   // permutationsWithRepetition :: Int -> [a] -> a
   const permutationsWithRepetition = (n, as) =>
       as.length > 0 ? (
           foldl1(curry(cartesianProduct)(as), replicate(n, as))
       ) : [];

   // cartesianProduct :: [a] -> [b] -> a, b
   const cartesianProduct = (xs, ys) => {
       return [].concat.apply([], xs.map(x =>
       [].concat.apply([], ys.map(y => [[x].concat(y)]))))
   };

   // GENERIC FUNCTIONS

   // foldl1 :: (a -> a -> a) -> [a] -> a
   const foldl1 = (f, xs) =>
       xs.length > 0 ? xs.slice(1)
       .reduce(f, xs[0]) : [];

   // replicate :: Int -> a -> [a]
   const replicate = (n, a) => {
       let v = [a],
           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);
   };

   // curry :: ((a, b) -> c) -> a -> b -> c
   const curry = f => a => b => f(a, b);

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

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

   return show(permutationsWithRepetition(2, [1, 2, 3]));

   //--> [[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]

})();</lang>

Output:

<lang JavaScript>[[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]</lang>

Permutations with repetition by treating the $n^{k}$ elements as an ordered set, and writing a function from a zero-based index to the nth permutation. This allows us terminate a repeated generation on some condition, or explore a sub-set without needing to generate the whole set:

<lang JavaScript>(() => {

   'use strict';

   // nthPermutationWithRepn :: [a] -> Int -> Int -> [a]
   const nthPermutationWithRepn = (xs, groupSize, index) => {
       const
           intBase = xs.length,
           intSetSize = Math.pow(intBase, groupSize),
           lastIndex = intSetSize - 1; // zero-based

       if (intBase < 1 || index > lastIndex) return undefined;

       const
           baseElements = unfoldr(m => {
               const
                   v = m.new,
                   [d, r] = quotRem(v, intBase);
               return {
                   valid: d > 0,
                   value: xs[r],
                   new: d
               };
           }, index),
           intZeros = groupSize - baseElements.length;

       return intZeros > 0 ? (
           (replicate(intZeros, xs[0]))
           .concat(baseElements)
       ) : baseElements;
   };

   // GENERIC FUNCTIONS

   // unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
   const unfoldr = (mf, v) => {
       var xs = [];
       return [until(
               m => !m.valid,
               m => {
                   const m2 = mf(m);
                   return (
                       m2.valid && (xs = [m2.value].concat(xs)),
                       m2
                   );
               }, {
                   valid: true,
                   value: v,
                   new: v,
               }
           )
           .value
       ].concat(xs);
   };

   // until :: (a -> Bool) -> (a -> a) -> a -> a
   const until = (p, f, x) => {
       let v = x;
       while (!p(v)) v = f(v);
       return v;
   }

   // replicate :: Int -> a -> [a]
   const replicate = (n, a) => {
       let v = [a],
           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);
   };

   // quotRem :: Integral a => a -> a -> (a, a)
   const quotRem = (m, n) => [Math.floor(m / n), m % n];

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

   // 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));
   };

   // range :: Int -> Int -> [Int]
   const range = (m, n) =>
       Array.from({
           length: Math.floor(n - m) + 1
       }, (_, i) => m + i);

   // TEST
   // Just items 30 to 35 in the (zero-indexed) series:
   return show(
       range(30, 35)
       .map(
           curry(nthPermutationWithRepn)(['X', 'Y', 'Z'], 4)
       )
   );

})();</lang>

Output:

["Y","X","Y","X"], ["Y","X","Y","Y"], ["Y","X","Y","Z"], ["Y","X","Z","X"], ["Y","X","Z","Y"], ["Y","X","Z","Z"]

jq

We first present a definition of permutations_with_replacement(n) that is compatible with jq 1.4. To interrupt the stream that it produces, however, requires a version of jq with break, which was introduced after the release of jq 1.4.

Definitions

We shall define permutations_with_replacements(n) in terms of a more general filter, combinations/0, defined as follows:

<lang jq># Input: an array, $in, of 0 or more arrays

1. Output: a stream of arrays, c, with c[i] drawn from $in[i].

def combinations:

 if length == 0 then []
 else
 .[0][] as $x
 | (.[1:] | combinations) as $y
 | [$x] +  $y
 end ;

1. Input: an array of the k values from which to choose.
2. Output: a stream of arrays of length n with elements drawn from the input array.

def permutations_with_replacements(n):

 . as $in | [range(0; n) | $in] | combinations;</lang>
 

Example 1: Enumeration:

Count the number of 4-combinations of [0,1,2] by enumerating them, i.e., without creating a data structure to store them all. <lang jq>def count(stream): reduce stream as $i (0; .+1);

count([0,1,2] | permutations_with_replacements(4))

1. output: 81</lang>

Example 2: Early termination of the generator:

Counting from 1, and terminating the generator when the item is found, what is the sequence number of ["c", "a", "b"] in the stream of 3-combinations of ["a","b","c"]? <lang jq># Input: the item to be matched

1. Output: the index of the item in the stream (counting from 1);
2. emit null if the item is not found

def sequence_number(stream):

 . as $in
 | (label $top
    | foreach stream as $i (0; .+1; if $in == $i then ., break $top else empty end))
   // null;  # NOTE: "//" here is an operator

["c", "a", "b"] | sequence_number( ["a","b","c"] | permutations_with_replacements(3))

1. output: 20</lang>

Mathematica

<lang mathematica>Tuples[{1, 2, 3}, 2]</lang>

Output:

{{1, 1}, {1, 2}, {1, 3}, {2, 1}, {2, 2}, {2, 3}, {3, 1}, {3, 2}, {3, 3}}

Perl

<lang perl>use Algorithm::Combinatorics qw/tuples_with_repetition/; print join(" ", map { "[@$_]" } tuples_with_repetition([qw/A B C/],2)), "\n";</lang>

Output:

[A A] [A B] [A C] [B A] [B B] [B C] [C A] [C B] [C C]

Solving the crack problem: <lang perl>use Algorithm::Combinatorics qw/tuples_with_repetition/; my $iter = tuples_with_repetition([qw/A C K R/], 5); my $tries = 0; while (my $p = $iter->next) {

 $tries++;
 die "Found the combination after $tries tries!\n" if join("",@$p) eq "CRACK";

}</lang>

Output:

Found the combination after 455 tries!

Perl 6

We can use the X operator ("cartesian product") to cross the list with itself.
For $n=2$:

Works with: rakudo version 2016.07

<lang perl6>my @k = <a b c>;

.say for @k X @k;</lang>

For arbitrary $n$:

Works with: rakudo version 2016.07

<lang perl6>my @k = <a b c>; my $n = 2;

.say for [X] @k xx $n;</lang>

Output:

a a
a b
a c
b a
b b
b c
c a
c b
c c

Here is an other approach, counting all $k^{n}$ possibilities in base $k$:

Works with: rakudo version 2016.07

<lang perl6>my @k = <a b c>; my $n = 2;

say @k[.polymod: +@k xx $n-1] for ^@k**$n</lang>

Output:

a a
b a
c a
a b
b b
c b
a c
b c
c c

Pascal

Works with: Free Pascal

Create a list of indices into what ever you want, one by one. Doing it by addig one to a number with k-positions to base n. <lang pascal>program PermuWithRep; //permutations with repetitions //http://rosettacode.org/wiki/Permutations_with_repetitions {$IFDEF FPC}

 {$Mode Delphi}{$Optimization ON}{$Align 16}{$Codealign proc=16,loop=4}

{$ELSE}

 {$APPTYPE CONSOLE}// for Delphi

{$ENDIF} uses

 sysutils;

type

 tPermData =  record
              mdTup_n,           //number of positions
              mdTup_k:NativeInt; //number of different elements
              mdTup :array of integer;
            end;

function InitTuple(k,n:nativeInt):tPermData; begin

 with result do
 Begin
   IF k> 0 then
   Begin
     mdTup_k:= k;
     setlength(mdTup,k);
     IF (n<0) then
       mdTup_n := 0
     else
       mdTup_n := n;
   end
   else
   Begin
     mdTup_k := 1;
     mdTup_n := k;
   end;
 end;

end;

procedure PermOut(const p:tPermData); var

 i : nativeInt;

Begin

 with p do
 Begin
   For i := 0 to mdTup_k-1 do
     write(mdTup[i]:4);
 end;
 writeln;

end;

function NextPermWithRep(var perm:tPermData): boolean; // create next permutation by adding 1 and correct "carry" // returns false if finished var

 pDg :^Integer;
 dg,le :nativeInt;

begin

 WIth perm do
 Begin
   pDg := @mdTup[0];
   le := mdTup_k;
   repeat
     dg := pDg^+1;
     IF (dg<mdTup_n) then
     Begin
       pDg^ := dg;
       BREAK;
     end
     else
       pDg^  := 0;
    dec(le);
    inc(pDg);
   until  le<=0;
   result := (dg<mdTup_n);
 end;

end;

var

 p: tPermData;
 cnt,k,n: nativeInt;

Begin

 cnt := 0;
 //k := 2;n := 3;
 k := 10;n := 8;
 p:= InitTuple(k,n);
 IF (n<= 6) then
   repeat
     inc(cnt);
     PermOut(p);
   until Not(NextPermWithRep(p))
 else
   repeat
     inc(cnt);
   until Not(NextPermWithRep(p));
 writeln('k: ',k,' n: ',n,'  count ',cnt);

end.</lang>

Output:

   0   0
   1   0
   2   0
   0   1
   1   1
   2   1
   0   2
   1   2
   2   2
k: 2 n: 3  count 9
..
//speedtest Compiler /fpc/3.1.1/ppc386 "%f" -al -Xs -XX -O3
// i4330 3.5 Ghz
k: 10 n: 8  count 1073741824 => 8^10

real  0m2.556s // without inc(cnt); real  0m2.288s-> 7,5 cycles per call
//"old" compiler-version
//real  0m3.465s  /fpc/2.6.4/ppc386 "%f" -al -Xs -XX -O3

PHP

<lang PHP><?php function permutate($values, $size, $offset) {

   $count = count($values);
   $array = array();
   for ($i = 0; $i < $size; $i++) {
       $selector = ($offset / pow($count,$i)) % $count;
       $array[$i] = $values[$selector];
   }
   return $array;

}

function permutations($values, $size) {

   $a = array();
   $c = pow(count($values), $size);
   for ($i = 0; $i<$c; $i++) {
       $a[$i] = permutate($values, $size, $i);        
   }
   return $a;

}

$permutations = permutations(['bat','fox','cow'], 2); foreach ($permutations as $permutation) {

   echo join(',', $permutation)."\n";

} </lang>

Output:

bat,bat
fox,bat
cow,bat
bat,fox
fox,fox
cow,fox
bat,cow
fox,cow
cow,cow

PicoLisp

<lang PicoLisp>(de permrep (N Lst)

  (if (=0 N)
     (cons NIL)
     (mapcan
        '((X)
           (mapcar '((Y) (cons Y X)) Lst) )
        (permrep (dec N) Lst) ) ) )</lang>

Python

<lang python>from itertools import product

1. check permutations until we find the word 'crack'

for x in product('ACRK', repeat=5):

   w = .join(x)
   print w
   if w.lower() == 'crack': break</lang>

Racket

As a sequence

First we define a procedure that defines the sequence of the permutations. <lang Racket>#lang racket (define (permutations-with-repetitions/proc size items)

 (define items-vector (list->vector items))
 (define num (length items))
 (define (pos->element pos)
   (reverse
    (for/list ([p (in-vector pos)])
     (vector-ref items-vector p))))
 (define (next-pos pos) 
   (let ([ret (make-vector size #f)])
     (for/fold ([carry 1]) ((i (in-range size)))
       (let ([tmp (+ (vector-ref pos i) carry)])
         (if (= tmp num)
           (begin 
             (vector-set! ret i 0)
             #;carry 1)
           (begin 
             (vector-set! ret i tmp)
             #;carry 0))))
     ret))
 (define initial-pos (vector->immutable-vector (make-vector size 0)))
 (define last-pos (vector->immutable-vector (make-vector size (sub1 num))))
 (define (continue-after-pos+val? pos val)
   (not (equal? pos last-pos)))
 
 (make-do-sequence (lambda () 
                     (values pos->element
                             next-pos
                             initial-pos
                             #f
                             #f
                             continue-after-pos+val?))))
                             

(sequence->list (permutations-with-repetitions/proc 2 '(1 2 3)))</lang>

Output:

'((1 1) (1 2) (1 3) (2 1) (2 2) (2 3) (3 1) (3 2) (3 3))

As a sequence with for clause support

Now we define a more general version that can be used efficiently in as a for clause. In other uses it falls back to the sequence implementation. <lang Racket>(require (for-syntax racket))

(define-sequence-syntax in-permutations-with-repetitions

 (lambda () #'permutations-with-repetitions/proc) 
 (lambda (stx) 
   (syntax-case stx () 
     [[(element) (_  size/ex items/ex)] 
      #'[(element) 
         (:do-in ([(size) size/ex]
                  [(items) items/ex]
                  [(items-vector) (list->vector items/ex)]
                  [(num) (length items/ex)]
                  [(last-pos) (make-vector size/ex (sub1 (length items/ex)))]) 
                 (void)
                 ([pos (make-vector size 0)]) 
                 #t
                 ([(element) (reverse
                              (for/list ([p (in-vector pos)])
                               (vector-ref items-vector p)))]) 
                 #t
                 (not (equal? pos last-pos)) 
                 [(let ([ret (make-vector size #f)])
                    (for/fold ([carry 1]) ((i (in-range size)))
                      (let ([tmp (+ (vector-ref pos i) carry)])
                        (if (= tmp num)
                          (begin 
                            (vector-set! ret i 0)
                            #;carry 1)
                          (begin 
                            (vector-set! ret i tmp)
                            #;carry 0))))
                    ret)])]])))

(for/list ([element (in-permutations-with-repetitions 2 '(1 2 3))])

 element)

(sequence->list (in-permutations-with-repetitions 2 '(1 2 3)))</lang>

Output:

'((1 1) (1 2) (1 3) (2 1) (2 2) (2 3) (3 1) (3 2) (3 3))
'((1 1) (1 2) (1 3) (2 1) (2 2) (2 3) (3 1) (3 2) (3 3))

REXX

version 1

<lang rexx>/*REXX program generates all permutations with repeats of N objects.*/ parse arg things bunch inbetweenChars names

     /* inbetweenChars  (optional)   defaults to a  [null].            */
     /*          names  (optional)   defaults to digits (and letters). */

call permRsets things,bunch,inbetweenChars,names exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────.PERMRSET subroutine────────────────*/ .permRset: procedure expose (list); parse arg ? if ?>y then do; _=@.1; do j=2 to y; _=_||between||@.j; end; say _; end

      else do q=1  for x              /*build permutation recursively. */
           @.?=$.q;      call .permRset ?+1
           end    /*q*/

return /*──────────────────────────────────PERMRSETS subroutine────────────────*/ permRsets: procedure; parse arg x,y,between,uSyms /*X things Y at a time*/ @.=; sep= /*X can't be > length(@0abcs). */ @abc = 'abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU @abcS = @abcU || @abc; @0abcS=123456789 || @abcS

 do k=1  for x                        /*build a list of (perm) symbols.*/
 _=p(word(uSyms,k)  p(substr(@0abcS,k,1) k))   /*get|generate a symbol.*/
 if length(_)\==1  then sep='_'       /*if not 1st char, then use sep. */
 $.k=_                                /*append it to the symbol list.  */
 end   /*k*/

if between== then between=sep /*use the appropriate separator. */ list='$. @. between x y' call .permRset 1 return /*──────────────────────────────────P subroutine (Pick one)─────────────*/ p: return word(arg(1),1)</lang> output when using the input of: 3 2

11
12
13
21
22
23
31
32
33

output when using the input of: 3 2 , bat fox cow

bat,bat
bat,fox
bat,cow
fox,bat
fox,fox
fox,cow
cow,bat
cow,fox
cow,cow

version 2 (using Interpret)

Note: this REXX version will cause Regina REXX to fail (crash) if the expression to be INTERPRETed is too large (byte-wise).
PC/REXX and Personal REXX also fail, but for a smaller expression.
Please specify limitations. One could add: If length(a)>implementation_dependent_limit Then
  Say 'too large for this Rexx version'
Also note that the output isn't the same as REXX version 1 when the 1st argument is two digits or more, i.e.:   11   2 <lang rexx>/* REXX ***************************************************************

• Arguments and output as in REXX version 1 (for the samples shown there)
• For other elements (such as 11 2), please specify a separator
• Translating 10, 11, etc. to A, B etc. is left to the reader
• 12.05.2013 Walter Pachl
• 12-05-2013 Walter Pachl take care of bunch<=0 and other oddities
  • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • • /

Parse Arg things bunch sep names If datatype(things,'W') & datatype(bunch,'W') Then

 Nop

Else

 Call exit 'First two arguments must be integers >0'

If things= Then n=3; Else n=things If bunch= Then m=2; Else m=bunch If things<=0 Then Call exit 'specify a positive number of things' If bunch<=0 Then Call exit 'no permutations with' bunch 'elements!'

Select

 When sep= Then ss='
 When datatype(sep)='NUM' Then ss='copies(' ',sep)'
 Otherwise ss='sep'
 End

Do i=1 To n

 If names<> Then
   Parse Var names e.i names
 Else
   e.i=i
 End

a='p=0;'; Do i=1 To m; a=a||'Do p'i'=1 To n;'; End a=a||'ol=e.p1'

         Do i=2 To m; a=a||'||'ss'||e.p'i; End

a=a||'; say ol; p=p+1;'

         Do i=1 To m; a=a||'end;'; End

a=a||'Say' p 'permutations' /* Say a */ Interpret a</lang>

version 3

This is a very simplistic version that is limited to nine things.
It essentially just executes a DO loop and ignores any permutation out of range,
this is very wasteful of CPU processing time when using larger bunches.
This version isn't ready for prime time. <lang rexx>/*REXX pgm generates all permutations with repeats of N objects (< 10).*/ parse arg things bunch .; z=things**bunch; good=left(1234567890,things) t=0

         do j=copies(1, bunch)  until t==z
         if verify(j,good)\==0  then iterate
         t=t+1
         say j
         end   /*j*/
                                      /*stick a fork in it, we're done.*/</lang>

output when the input is: 3 2

11
12
13
21
22
23
31
32
33

Ruby

This is built in　(Array#repeated_permutation): <lang ruby>rp = [1,2,3].repeated_permutation(2) # an enumerator (generator) p rp.to_a #=>[[1, 1], [1, 2], [1, 3], [2, 1], [2, 2], [2, 3], [3, 1], [3, 2], [3, 3]]

1. yield permutations until their sum happens to exceed 4, then quit:

p rp.take_while{|(a, b)| a + b < 5} #=>[[1, 1], [1, 2], [1, 3], [2, 1], [2, 2]]</lang>

Scala

<lang scala>package permutationsRep

object PermutationsRepTest extends Application {

 /**
  * Calculates all permutations taking n elements of the input List, 
  * with repetitions. 
  * Precondition: input.length > 0 && n > 0
  */
 def permutationsWithRepetitions[T](input : List[T], n : Int) : List[List[T]] = {
   require(input.length > 0 && n > 0)
   n match {
     case 1 => for (el <- input) yield List(el)
     case _ => for (el <- input; perm <- permutationsWithRepetitions(input, n - 1)) yield el :: perm
   }
 }   
 println(permutationsWithRepetitions(List(1, 2, 3), 2))

}</lang>

Output:

List(List(1, 1), List(1, 2), List(1, 3), List(2, 1), List(2, 2), List(2, 3), List(3, 1), List(3, 2), List(3, 3))

Tcl

Iterative version

Translation of: PHP

<lang tcl> proc permutate {values size offset} {

   set count [llength $values]
   set arr [list]
   for {set i 0} {$i < $size} {incr i} {
       set selector [expr [round [expr $offset / [pow $count $i]]] % $count];
       lappend arr [lindex $values $selector]
       
   }
   return $arr

}

proc permutations {values size} {

   set a [list]
   set c [pow [llength $values] $size]
   for {set i 0} {$i < $c} {incr i} {
       set permutation [permutate $values $size $i]
       lappend a $permutation
   }
   return $a

}

1. Usage

permutations [list 1 2 3 4] 3 </lang>

Version without additional libraries

Works with: Tcl version 8.6

Translation of: Scala

<lang tcl>package require Tcl 8.6

1. Utility function to make procedures that define generators

proc generator {name arguments body} {

   set body [list try $body on ok {} {return -code break}]
   set lambda [list $arguments "yield \[info coroutine\];$body"]
   proc $name args "tailcall \

coroutine gen_\[incr ::generate_ctr\] apply [list $lambda] {*}\$args" }

1. How to generate permutations with repetitions

generator permutationsWithRepetitions {input n} {

   if {[llength $input] == 0 || $n < 1} {error "bad arguments"}
   if {![incr n -1]} {

foreach el $input { yield [list $el] }

   } else {

foreach el $input { set g [permutationsWithRepetitions $input $n] while 1 { yield [list $el {*}[$g]] } }

   }

}

1. Demonstrate usage

set g [permutationsWithRepetitions {1 2 3} 2] while 1 {puts [$g]}</lang>

Alternate version with extra library package

Library: Tcllib (Package: generator)

Works with: Tcl version 8.6

<lang tcl>package require Tcl 8.6 package require generator

1. How to generate permutations with repetitions

generator define permutationsWithRepetitions {input n} {

   if {[llength $input] == 0 || $n < 1} {error "bad arguments"}
   if {![incr n -1]} {

foreach el $input { generator yield [list $el] }

   } else {

foreach el $input { set g [permutationsWithRepetitions $input $n] while 1 { generator yield [list $el {*}[$g]] } }

   }

}

1. Demonstrate usage

generator foreach val [permutationsWithRepetitions {1 2 3} 2] {

   puts $val

}</lang>