{{draft task|Probability and statistics}}

;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:''' {{Template:Combinations and permutations}}

AppleScript

Strict evaluation of the whole set

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.

-- e.g. replicateM(3, {1, 2})) -> 
-- {{1, 1, 1}, {1, 1, 2}, {1, 2, 1}, {1, 2, 2}, {2, 1, 1}, 
--  {2, 1, 2}, {2, 2, 1}, {2, 2, 2}}

-- replicateM :: Int -> [a] -> [[a]]
on replicateM(n, xs)
    script go
        script cons
            on |λ|(a, bs)
                {a} & bs
            end |λ|
        end script
        on |λ|(x)
            if x ≤ 0 then
                {{}}
            else
                liftA2List(cons, xs, |λ|(x - 1))
            end if
        end |λ|
    end script
    
    go's |λ|(n)
end replicateM


-- TEST ------------------------------------------------------------
on run
    
    replicateM(2, {1, 2, 3})
    
    -- {{1, 1}, {1, 2}, {1, 3}, {2, 1}, {2, 2}, {2, 3}, {3, 1}, {3, 2}, {3, 3}}
end run


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

-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
    set lng to length of xs
    set acc to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set acc to acc & |λ|(item i of xs, i, xs)
        end repeat
    end tell
    return acc
end concatMap

-- liftA2List :: (a -> b -> c) -> [a] -> [b] -> [c]
on liftA2List(f, xs, ys)
    script
        property g : mReturn(f)'s |λ|
        on |λ|(x)
            script
                on |λ|(y)
                    {g(x, y)}
                end |λ|
            end script
            concatMap(result, ys)
        end |λ|
    end script
    concatMap(result, xs)
end liftA2List

-- Lift 2nd class handler function into 1st class script wrapper 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

{{Out}}

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

Lazy evaluation with a generator

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:

use AppleScript version "2.4"
use framework "Foundation"
use scripting additions

-- permutesWithRepns :: [a] -> Int -> Generator [[a]]
on permutesWithRepns(xs, n)
    script
        property f : curry3(my nthPermutationWithRepn)'s |λ|(xs)'s |λ|(n)
        property limit : (length of xs) ^ n
        property i : -1
        on |λ|()
            set i to 1 + i
            if i < limit then
                return f's |λ|(i)
            else
                missing value
            end if
        end |λ|
    end script
end permutesWithRepns


-- nthPermutationWithRepn :: [a] -> Int -> Int -> [a]
on nthPermutationWithRepn(xs, intGroup, intIndex)
    set intBase to length of xs
    if intIndex < (intBase ^ intGroup) then
        set ds to baseDigits(intBase, xs, intIndex)
        
        -- With any 'leading zeros' required by length
        replicate(intGroup - (length of ds), item 1 of xs) & ds
    else
        missing value
    end if
end nthPermutationWithRepn


-- baseDigits :: Int -> [a] -> [a]
on baseDigits(intBase, digits, n)
    script
        on |λ|(v)
            if 0 = v then
                Nothing()
            else
                Just(Tuple(item (1 + (v mod intBase)) of digits, ¬
                    v div intBase))
            end if
        end |λ|
    end script
    unfoldr(result, n)
end baseDigits


-- TEST ------------------------------------------------------------------
on run
    set cs to "ACKR"
    set wordLength to 5
    set gen to permutesWithRepns(cs, wordLength)
    
    set i to 0
    set v to gen's |λ|() -- First permutation drawn from series
    set alpha to v
    set psi to alpha
    
    repeat while missing value is not v
        set s to concat(v)
        if "crack" = toLower(s) then
            return ("Permutation " & (i as text) & " of " & ¬
                (((length of cs) ^ wordLength) as integer) as text) & ¬
                ": " & s & linefeed & ¬
                "Found after searching from " & alpha & " thru " & psi
        else
            set i to 1 + i
            set psi to v
        end if
        set v to gen's |λ|()
    end repeat
end run


-- GENERIC ----------------------------------------------------------

-- Just :: a -> Maybe a
on Just(x)
    {type:"Maybe", Nothing:false, Just:x}
end Just

-- Nothing :: Maybe a
on Nothing()
    {type:"Maybe", Nothing:true}
end Nothing

-- Tuple (,) :: a -> b -> (a, b)
on Tuple(a, b)
    {type:"Tuple", |1|:a, |2|:b, length:2}
end Tuple

-- concat :: [[a]] -> [a]
-- concat :: [String] -> String
on concat(xs)
    set lng to length of xs
    if 0 < lng and string is class of (item 1 of xs) then
        set acc to ""
    else
        set acc to {}
    end if
    repeat with i from 1 to lng
        set acc to acc & item i of xs
    end repeat
    acc
end concat

-- curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
on curry3(f)
    script
        on |λ|(a)
            script
                on |λ|(b)
                    script
                        on |λ|(c)
                            |λ|(a, b, c) of mReturn(f)
                        end |λ|
                    end script
                end |λ|
            end script
        end |λ|
    end script
end curry3

-- Lift 2nd class handler function into 1st class script wrapper 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary 
-- assembly of a target length
-- 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

-- toLower :: String -> String
on toLower(str)
    set ca to current application
    ((ca's NSString's stringWithString:(str))'s ¬
        lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text
end toLower

-- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
-- > [10,9,8,7,6,5,4,3,2,1] 
-- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
on unfoldr(f, v)
    set xr to Tuple(v, v) -- (value, remainder)
    set xs to {}
    tell mReturn(f)
        repeat -- Function applied to remainder.
            set mb to |λ|(|2| of xr)
            if Nothing of mb then
                exit repeat
            else -- New (value, remainder) tuple,
                set xr to Just of mb
                -- and value appended to output list.
                set end of xs to |1| of xr
            end if
        end repeat
    end tell
    return xs
end unfoldr

{{Out}}

Permutation 589 of 1024: CRACK
Found after searching from AAAAA thru ARACK

ALGOL 68

{{works with|ALGOL 68|Revision 1 - one minor extension to language used - PRAGMA READ, similar to C's #include directive.}} {{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-2.6 algol68g-2.6].}} {{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of '''format'''[ted] ''transput''.}} '''File: prelude_permutations_with_repetitions.a68'''

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

'''File: test_permutations_with_repetitions.a68'''

#!/usr/bin/a68g --script #
# -*- 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:(
# FOR PERMELEMELEM candidate in # perm gen elemlist(combination #) DO (#,
##   (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)
# OD #));
  done: SKIP
)

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

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
}

C

#include <stdlib.h>

int main(){	
	int temp;
	int numbers=3;
	int a[numbers+1], upto = 4, temp2;
	for( temp2 = 1 ; temp2 <= numbers; temp2++){
		a[temp2]=1;
	}
	a[numbers]=0;
	temp=numbers;
	while(1){
		if(a[temp]==upto){
			temp--;
			if(temp==0)
				break;
		}
		else{
			a[temp]++;
			while(temp<numbers){
				temp++;
				a[temp]=1;
			}
			
			printf("(");
			for( temp2 = 1 ; temp2 <= numbers; temp2++){
				printf("%d", a[temp2]);
			}
			printf(")");
		}
	}
	return 0;
}

{{out}}

(111)(112)(113)(114)(121)(122)(123)(124)(131)(132)(133)(134)(141)(142)(143)(144)(211)(212)(213)(214)(221)(222)(223)(224)(231)(232)(233)(234)(241)(242)(243)(244)(311)(312)(313)(314)(321)(322)(323)(324)(331)(332)(333)(334)(341)(342)(343)(344)(411)(412)(413)(414)(421)(422)(423)(424)(431)(432)(433)(434)(441)(442)(443)(444)

C++

#include <stdio.h>
#include <stdlib.h>

struct Generator
{
    public:
        Generator(int s, int v)
            : cSlots(s)
            , cValues(v)
        {
            a = new int[s];

            for (int i = 0; i < cSlots - 1; i++) {
                a[i] = 1;
            }
            a[cSlots - 1] = 0;

            nextInd = cSlots;
        }

        ~Generator()
        {
            delete a;
        }

        bool doNext()
        {
            for (;;)
            {
                if (a[nextInd - 1] == cValues) {
                    nextInd--;
                    if (nextInd == 0)
                        return false;
                }
                else {
                    a[nextInd - 1]++;
                    while (nextInd < cSlots) {
                        nextInd++;
                        a[nextInd - 1] = 1;
                    }

                    return true;
                }
            }
        }

        void doPrint()
        {
            printf("(");
            for (int i = 0; i < cSlots; i++) {
                printf("%d", a[i]);
            }
            printf(")");
        }

    private:
        int *a;
        int cSlots;
        int cValues;
        int nextInd;
};


int main() 
{
    Generator g(3, 4);

    while (g.doNext()) {
        g.doPrint();
    }

    return 0;
}

{{out}}

(111)(112)(113)(114)(121)(122)(123)(124)(131)(132)(133)(134)(141)(142)(143)(144)(211)(212)(213)(214)(221)(222)(223)(224)(231)(232)(233)(234)(241)(242)(243)(244)(311)(312)(313)(314)(321)(322)(323)(324)(331)(332)(333)(334)(341)(342)(343)(344)(411)(412)(413)(414)(421)(422)(423)(424)(431)(432)(433)(434)(441)(442)(443)(444)

D

opApply Version

{{trans|Scala}}

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

{{out}}

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

Generator Range Version

{{trans|Scala}}

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

The output is the same.

EchoLisp

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

Elixir

{{trans|Erlang}}

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)

{{out}}

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

-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)].

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

{{out}}

[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

import Control.Monad (replicateM)

main = mapM_ print (replicateM 2 [1,2,3])

{{out}}

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

   i.3^2
0 1 2 3 4 5 6 7 8

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

   (2#3)#:i.3^2
0 0
0 1
0 2
1 0
1 1
1 2
2 0
2 1
2 2

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:

   (2#3)#:3 4 5
1 0
1 1
1 2

We might express this as a verb

perm=: # #: i.@^~

with example use:

   2 perm 3
0 0
0 1
0 2
1 0
...

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

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

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.

(function () {
    'use strict';

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


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

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

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

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

{{Out}}

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

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:

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

{{Out}}

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

=Strict evaluation of the whole set=

Permutations with repetitions, using strict evaluation, generating the entire set. For partial or interruptible evaluation, see the second example below.

A (strict) analogue of the (lazy) replicateM in Haskell.

(() => {
    'use strict';

    // GENERIC FUNCTIONS

    // replicateM n act performs the action n times, gathering the results.
    // replicateM :: (Applicative m) => Int -> m a -> m [a]
    const replicateM = (n, f) => {
        const loop = x => x <= 0 ? [
            []
        ] : liftA2(cons, f, loop(x - 1));
        return loop(n);
    };

    // Lift a binary function to actions.
    // liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
    const liftA2 = (f, a, b) =>
        listApply(a.map(curry(f)), b);

    // <*>
    // listApply :: [(a -> b)] -> [a] -> [b]
    const listApply = (fs, xs) =>
        [].concat.apply([], fs.map(f =>
        [].concat.apply([], xs.map(x => [f(x)]))));

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

    // cons :: a -> [a] -> [a]
    const cons = (x, xs) => [x].concat(xs);

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

    // TEST
    return show(
        replicateM(2, [1, 2, 3])
    );
    // -> [[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]
})();

{{Out}}

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

=Lazy evaluation with a generator =

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. Wrapping this function in a generator allows us terminate a repeated generation on some condition, or explore a sub-set without needing to generate the whole set:

(() => {
    'use strict';

    const main = () => {

        // Generator object
        const gen = permsWithRepn('ACKR', 5);

        // Search without needing to generate whole set:
        let
            nxt = gen.next(),
            i = 0,
            alpha = nxt.value,
            psi = alpha;
        while (!nxt.done && 'crack' !== toLower(concat(nxt.value))) {
            psi = nxt.value;
            console.log(psi)
            nxt = gen.next()
            i++
        }
        console.log(nxt.value)
        return (
            'Generated ' + i + ' of ' + Math.pow(4, 5) +
            ' possible permutations,\n' +
            'searching from: ' + show(alpha) + ' thru: ' + show(psi) +
            '\nbefore finding: ' + show(nxt.value)
        );
    };

    // PERMUTATION GENERATOR ------------------------------

    // permsWithRepn :: [a] -> Int -> Generator [a]
    function* permsWithRepn(xs, intGroup) {
        const
            vs = Array.from(xs),
            intBase = vs.length,
            intSet = Math.pow(intBase, intGroup);
        if (0 < intBase) {
            let index = 0;
            while (index < intSet) {
                const
                    ds = unfoldr(
                        v => 0 < v ? (() => {
                            const rd = quotRem(v, intBase);
                            return Just(Tuple(vs[rd[1]], rd[0]))
                        })() : Nothing(),
                        index++
                    );
                yield replicate(
                    intGroup - ds.length,
                    vs[0]
                ).concat(ds);
            };
        }
    };

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

    // Just :: a -> Maybe a
    const Just = x => ({
        type: 'Maybe',
        Nothing: false,
        Just: x
    });

    // Nothing :: Maybe a
    const Nothing = () => ({
        type: 'Maybe',
        Nothing: true,
    });

    // Tuple (,) :: a -> b -> (a, b)
    const Tuple = (a, b) => ({
        type: 'Tuple',
        '0': a,
        '1': b,
        length: 2
    });

    // concat :: [[a]] -> [a]
    // concat :: [String] -> String
    const concat = xs =>
        0 < xs.length ? (() => {
            const unit = 'string' !== typeof xs[0] ? (
                []
            ) : '';
            return unit.concat.apply(unit, xs);
        })() : [];

    // index (!!) :: [a] -> Int -> a
    // index (!!) :: String -> Int -> Char
    const index = (xs, i) => xs[i];

    // quotRem :: Int -> Int -> (Int, Int)
    const quotRem = (m, n) =>
        Tuple(Math.floor(m / n), m % n);

        // replicate :: Int -> a -> [a]
    const replicate = (n, x) =>
        Array.from({
            length: n
        }, () => x);

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

    // toLower :: String -> String
    const toLower = s => s.toLocaleLowerCase();

    // unfoldr(x => 0 !== x ? Just([x, x - 1]) : Nothing(), 10);
    // --> [10,9,8,7,6,5,4,3,2,1]

    // unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
    const unfoldr = (f, v) => {
        let
            xr = [v, v],
            xs = [];
        while (true) {
            const mb = f(xr[1]);
            if (mb.Nothing) {
                return xs
            } else {
                xr = mb.Just;
                xs.push(xr[0])
            }
        }
    };

    // MAIN ---
    return main();
})();

{{Out}}

Generated 589 of 1024 possible permutations,
searching from: ["A","A","A","A","A"] thru: ["A","R","A","C","K"]
before finding: ["C","R","A","C","K"]

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:

# Input: an array, $in, of 0 or more arrays
# 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 ;

# Input: an array of the k values from which to choose.
# 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;

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

def count(stream): reduce stream as $i (0; .+1);

count([0,1,2] | permutations_with_replacements(4))
# output: 81

'''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"]?

# Input: the item to be matched
# Output: the index of the item in the stream (counting from 1);
# 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))

# output: 20

Julia

{{works with|Julia|0.6}}

Implements a simil-Combinatorics.jl API.

struct WithRepetitionsPermutations{T}
    a::T
    t::Int
end

with_repetitions_permutations(elements::T, len::Integer) where T =
    WithRepetitionsPermutations{T}(unique(elements), len)

Base.iteratorsize(::WithRepetitionsPermutations) = Base.HasLength()
Base.length(p::WithRepetitionsPermutations) = length(p.a) ^ p.t
Base.iteratoreltype(::WithRepetitionsPermutations) = Base.HasEltype()
Base.eltype(::WithRepetitionsPermutations{T}) where T = T
Base.start(p::WithRepetitionsPermutations) = ones(Int, p.t)
Base.done(p::WithRepetitionsPermutations, s::Vector{Int}) = s[end] > endof(p.a)
function Base.next(p::WithRepetitionsPermutations, s::Vector{Int})
    cur = p.a[s]
    s[1] += 1
    local i = 1
    while i < endof(s) && s[i] > length(p.a)
        s[i] = 1
        s[i+1] += 1
        i += 1
    end
    return cur, s
end

println("Permutations of [4, 5, 6] in 3:")
foreach(println, collect(with_repetitions_permutations([4, 5, 6], 3)))

{{out}}

Permutations of [4, 5, 6] in 3:
[4, 4, 4]
[5, 4, 4]
[6, 4, 4]
[4, 5, 4]
[5, 5, 4]
[6, 5, 4]
[4, 6, 4]
[5, 6, 4]
[6, 6, 4]
[4, 4, 5]
[5, 4, 5]
[6, 4, 5]
[4, 5, 5]
[5, 5, 5]
[6, 5, 5]
[4, 6, 5]
[5, 6, 5]
[6, 6, 5]
[4, 4, 6]
[5, 4, 6]
[6, 4, 6]
[4, 5, 6]
[5, 5, 6]
[6, 5, 6]
[4, 6, 6]
[5, 6, 6]
[6, 6, 6]

K

enlist each from x on the left and each from x on the right where x is range 10

 
,/x/:\:x:!10

Kotlin

{{trans|Go}}

// version 1.1.2

fun main(args: Array<String>) {
    val n  = 3
    val values = charArrayOf('A', 'B', 'C', 'D')
    val k = values.size
    // terminate when first two characters of the permutation are 'B' and 'C' respectively
    val decide = fun(pc: CharArray) = pc[0] == 'B' && pc[1] == 'C'
    val pn = IntArray(n)
    val pc = CharArray(n)
    while (true) {
        // generate permutation
        for ((i, x) in pn.withIndex()) pc[i] = values[x]
        // show progress
        println(pc.contentToString())
        // pass to deciding function
        if (decide(pc)) return  // terminate early
        // increment permutation number
        var i = 0
        while (true) {
            pn[i]++
            if (pn[i] < k) break
            pn[i++] = 0
            if (i == n) return  // all permutations generated
        }
    }
}

{{out}}

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

M2000 Interpreter

Module Checkit {
      a=("A","B","C","D")
      n=len(a)
      c1=lambda a, n, c (&f) ->{
            =(array(a, c),)
            c++
            if c=n then c=0: f=true
      }
      m=n-2
      While m >0 {
            c3=lambda c2=c1, a, n, c (&f) -> {
                  f=false
                  =Cons((array(a, c),), c2(&f))
                  if f then {
                         c++
                         f=false
                        if c=n then c=0: f=true    
                  }
            }
            c1=c3
            m--
      }
      k=false
      While not k {
           r=c3(&k)
           rr=each(r end to start)
           While rr {
                  Print array$(rr),
            }
            Print
            if array$(r, 2)="B" and array$(r,1)="C" then exit
      }
}
Checkit

{{out}}

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