Rosetta Code

Permutations with repetitions: Difference between revisions

Page Discussion

Permutations with repetitions (view source)

Revision as of 22:37, 17 March 2024

45,148 bytes added ,  2 months ago
Add SML
(Added Kotlin)
(Add SML)
(51 intermediate revisions by 22 users not shown)
Line 14:
<br>
 
=={{header|AppleScript11l}}==
{{trans|Kotlin}}
===Strict evaluation===
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.
 
<syntaxhighlight lang="11l">V n = 3
<lang AppleScript>-- permutationsWithRepetition :: Int -> [a] -> [[a]]
V values = [‘A’, ‘B’, ‘C’, ‘D’]
on permutationsWithRepetition(n, xs)
V k = values.len
if length of xs > 0 then
V decide = pc -> pc[0] == ‘B’ & pc[1] == ‘C’
foldl1(curry(my cartesianProduct)'s lambda(xs), replicate(n, xs))
V pn = [0] else* n
V pc = ["\0"] * {}n
L
end if
L(x) pn
end permutationsWithRepetition
pc[L.index] = values[x]
print(pc)
 
I decide(pc)
L.break
 
V i = 0
-- TEST ------------------------------------------------------------------------
L
on run
pn[i]++
I pn[i] < k
permutationsWithRepetition(2, {1, 2, 3})
L.break
pn[i] = 0
--> {{1, 1}, {1, 2}, {1, 3}, {2, 1}, {2, 2}, {2, 3}, {3, 1}, {3, 2}, {3, 3}}
i++
end run
I i == n
^L.break</syntaxhighlight>
 
{{out}}
 
<pre>
-- GENERIC FUNCTIONS ----------------------------------------------------------
[A, A, A]
 
[B, A, A]
-- replicate :: Int -> a -> [a]
[C, A, A]
on replicate(n, a)
[D, A, A]
set out to {}
[A, B, A]
if n < 1 then return out
[B, B, A]
set dbl to {a}
[C, B, A]
[D, B, A]
repeat while (n > 1)
[A, C, A]
if (n mod 2) > 0 then set out to out & dbl
[B, C, A]
set n to (n div 2)
</pre>
set dbl to (dbl & dbl)
end repeat
return out & dbl
end replicate
 
-- cartesianProduct :: [a] -> [b] -> [[a, b]]
on cartesianProduct(xs, ys)
script
on lambda(x)
script
on lambda(y)
{{x} & y}
end lambda
end script
concatMap(result, ys)
end lambda
end script
concatMap(result, xs)
end cartesianProduct
 
-- curry :: (Script|Handler) -> Script
on curry(f)
script
on lambda(a)
script
on lambda(b)
lambda(a, b) of mReturn(f)
end lambda
end script
end lambda
end script
end curry
 
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
script append
on lambda(a, b)
a & b
end lambda
end script
foldl(append, {}, map(f, xs))
end concatMap
 
-- foldl1 :: (a -> a -> a) -> [a] -> a
on foldl1(f, xs)
if length of xs > 0 then
foldl(f, item 1 of xs, tail(xs))
else
{}
end if
end foldl1
 
-- tail :: [a] -> [a]
on tail(xs)
if length of xs > 1 then
items 2 thru -1 of xs
else
{}
end if
end tail
 
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to lambda(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
 
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to lambda(item i of xs, i, xs)
end repeat
return lst
end tell
end map
 
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property lambda : f
end script
end if
end mReturn</lang>
 
{{Out}}
<lang AppleScript>{{1, 1}, {1, 2}, {1, 3}, {2, 1}, {2, 2}, {2, 3}, {3, 1}, {3, 2}, {3, 3}}</lang>
 
===Partial evaluation===
Permutations with repetition by treating the <math>n^k</math> 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 AppleScript>-- nthPermutationWithRepn :: [a] -> Int -> Int -> [a]
on nthPermutationWithRepn(xs, groupSize, iIndex)
set intBase to length of xs
set intSetSize to intBase ^ groupSize
if intBase < 1 or iIndex > intSetSize then
{}
else
set baseElems to inBaseElements(xs, iIndex)
set intZeros to groupSize - (length of baseElems)
if intZeros > 0 then
replicate(intZeros, item 1 of xs) & baseElems
else
baseElems
end if
end if
end nthPermutationWithRepn
 
-- inBaseElements :: [a] -> Int -> [String]
on inBaseElements(xs, n)
set intBase to length of xs
script nextDigit
on lambda(residue)
set {divided, remainder} to quotRem(residue, intBase)
{valid:divided > 0, value:(item (remainder + 1) of xs), new:divided}
end lambda
end script
reverse of unfoldr(nextDigit, n)
end inBaseElements
 
 
-- TEST ----------------------------------------------------------------------
on run
script
on lambda(x)
nthPermutationWithRepn({"X", "Y", "Z"}, 4, x)
end lambda
end script
map(result, range(30, 35))
end run
 
 
-- GENERIC FUNCTIONS ---------------------------------------------------------
 
-- quotRem :: Integral a => a -> a -> (a, a)
on quotRem(m, n)
{m div n, m mod n}
end quotRem
 
-- 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
 
 
-- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
on unfoldr(f, v)
set mf to mReturn(f)
set lst to {}
set recM to mf's lambda(v)
repeat while (valid of recM) is true
set end of lst to value of recM
set recM to mf's lambda(new of recM)
end repeat
lst & value of recM
end unfoldr
 
-- until :: (a -> Bool) -> (a -> a) -> a -> a
on |until|(p, f, x)
set mp to mReturn(p)
set v to x
tell mReturn(f)
repeat until mp's lambda(v)
set v to lambda(v)
end repeat
end tell
return v
end |until|
 
-- range :: Int -> Int -> [Int]
on range(m, n)
if n < m then
set d to -1
else
set d to 1
end if
set lst to {}
repeat with i from m to n by d
set end of lst to i
end repeat
return lst
end range
 
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to lambda(item i of xs, i, xs)
end repeat
return lst
end tell
end map
 
 
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property lambda : f
end script
end if
end mReturn</lang>
 
{{Out}}
<lang AppleScript>{{"Y", "X", "Y", "X"}, {"Y", "X", "Y", "Y"}, {"Y", "X", "Y", "Z"},
{"Y", "X", "Z", "X"}, {"Y", "X", "Z", "Y"}, {"Y", "X", "Z", "Z"}}</lang>
 
=={{header|ALGOL 68}}==
Line 294 ⟶ 59:
{{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'''<langsyntaxhighlight lang="algol68"># -*- coding: utf-8 -*- #
 
MODE PERMELEMLIST = FLEX[0]PERMELEM;
Line 324 ⟶ 89:
);
 
SKIP</langsyntaxhighlight>'''File: test_permutations_with_repetitions.a68'''<langsyntaxhighlight lang="algol68">#!/usr/bin/a68g --script #
# -*- coding: utf-8 -*- #
 
Line 349 ⟶ 114:
# OD #));
done: SKIP
)</langsyntaxhighlight>'''Output:'''
<pre>
Chris Ciaffa; Chris Ciaffa; Chris Ciaffa; Chris Ciaffa;
Line 364 ⟶ 129:
Nicole Kidman; Keith Urban; Chris Ciaffa; Chris Ciaffa; => Sunday + Faith as extras
</pre>
 
=={{header|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.
 
<syntaxhighlight lang="applescript">-- 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</syntaxhighlight>
{{Out}}
<syntaxhighlight lang="applescript">{{1, 1}, {1, 2}, {1, 3}, {2, 1}, {2, 2}, {2, 3}, {3, 1}, {3, 2}, {3, 3}}</syntaxhighlight>
 
===Lazy evaluation with a generator===
Permutations with repetition by treating the <math>n^k</math> 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:
<syntaxhighlight lang="applescript">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</syntaxhighlight>
{{Out}}
<pre>Permutation 589 of 1024: CRACK
Found after searching from AAAAA thru ARACK</pre>
 
=={{header|Arturo}}==
<syntaxhighlight lang="arturo">decide: function [pc]->
and? pc\0 = `B`
pc\1 = `C`
 
permutation: function [vals, n][
k: size vals
pn: array.of:n 0
p: array.of:n `0`
 
while [true][
loop.with:'i pn 'x -> p\[i]: vals\[x]
print p
if decide p -> return ø
i: 0
while [true][
pn\[i]: pn\[i] + 1
if pn\[i] < k -> break
pn\[i]: 0
i: i + 1
if i = n -> return ø
]
]
]
 
permutation "ABCD" 3</syntaxhighlight>
 
{{out}}
 
<pre>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</pre>
 
=={{header|AutoHotkey}}==
Use the function from http://rosettacode.org/wiki/Permutations#Alternate_Version with opt=1
<langsyntaxhighlight 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"
Line 399 ⟶ 476:
. P(n,k-1,opt,delim,str . A_LoopField . delim)
Return s
}</langsyntaxhighlight>
 
=={{header|AWK}}==
<syntaxhighlight lang="awk">
# syntax: GAWK -f PERMUTATIONS_WITH_REPETITIONS.AWK
# converted from C
BEGIN {
numbers = 3
upto = 4
for (tmp2=1; tmp2<=numbers; tmp2++) {
arr[tmp2] = 1
}
arr[numbers] = 0
tmp1 = numbers
while (1) {
if (arr[tmp1] == upto) {
if (--tmp1 == 0) {
break
}
}
else {
arr[tmp1]++
while (tmp1 < numbers) {
arr[++tmp1] = 1
}
printf("(")
for (tmp2=1; tmp2<=numbers; tmp2++) {
printf("%d",arr[tmp2])
}
printf(")")
}
}
printf("\n")
exit(0)
}
</syntaxhighlight>
{{out}}
<pre>
(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)
</pre>
 
=={{header|BASIC}}==
==={{header|QBasic}}===
{{works with|QBasic|1.1}}
{{works with|QuickBasic|4.5}}
{{trans|FreeBASIC}}
<syntaxhighlight lang="qbasic">DIM list1$(1 TO 2, 1 TO 3) '= {{"a", "b", "c"}, {"a", "b", "c"}}
DIM list2$(1 TO 2, 1 TO 3) '= {{"1", "2", "3"}, {"1", "2", "3"}}
 
permutation$(list1$())
PRINT
permutation$(list2$())
END
 
SUB permutation$(list1$())
FOR n = 1 TO UBOUND(list1$,1)
FOR m = 1 TO UBOUND(list1$,2)
PRINT list1$(1, n); " "; list1$(2, m)
NEXT m
NEXT n
PRINT
END SUB</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
==={{header|BASIC256}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="basic256">arraybase 1
dim list1 = {{"a", "b", "c"}, {"a", "b", "c"}}
dim list2 = {{"1", "2", "3"}, {"1", "2", "3"}}
 
call permutation(list1)
print
call permutation(list2)
end
 
subroutine permutation(list1)
for n = 1 to list1[][?]
for m = 1 to list1[][?]
print list1[1, n]; " "; list1[2, m]
next m
next n
print
end subroutine</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
==={{header|FreeBASIC}}===
<syntaxhighlight lang="freebasic">Dim As String list1(1 To 2, 1 To 3) = {{"a", "b", "c"}, {"a", "b", "c"}}
Dim As String list2(1 To 2, 1 To 3) = {{"1", "2", "3"}, {"1", "2", "3"}}
 
Sub permutation(list() As String)
Dim As Integer n, m
For n = Lbound(list,2) To Ubound(list,2)
For m = Lbound(list,2) To Ubound(list,2)
Print list(1, n); " "; list(2, m)
Next m
Next n
Print
End Sub
 
permutation(list1())
Print
permutation(list2())
Sleep</syntaxhighlight>
{{out}}
<pre>a a
a b
a c
b a
b b
b c
c a
c b
c c
 
1 1
1 2
1 3
2 1
2 2
2 3
3 1
3 2
3 3</pre>
 
 
=={{header|C}}==
<langsyntaxhighlight lang="d">#include <stdio.h>
#include <stdlib.h>
 
Line 408 ⟶ 611:
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, temp2;
while(1){
if(a[temp]==upto){
Line 435 ⟶ 638:
}
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>(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)</pre>
 
=={{header|C++}}==
<syntaxhighlight lang="d">
#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;
}
 
</syntaxhighlight>
{{out}}
<pre>
(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)
</pre>
 
=={{header|D}}==
===opApply Version===
{{trans|Scala}}
<langsyntaxhighlight lang="d">import std.array;
 
struct PermutationsWithRepetitions(T) {
Line 483 ⟶ 768:
import std.stdio, std.array;
[1, 2, 3].permutationsWithRepetitions(2).array.writeln;
}</langsyntaxhighlight>
{{out}}
<pre>[[1, 1], [1, 2], [1, 3], [2, 1], [2, 2], [2, 3], [3, 1], [3, 2], [3, 3]]</pre>
Line 489 ⟶ 774:
===Generator Range Version===
{{trans|Scala}}
<langsyntaxhighlight lang="d">import std.stdio, std.array, std.concurrency;
 
Generator!(T[]) permutationsWithRepetitions(T)(T[] data, in uint n)
Line 509 ⟶ 794:
void main() {
[1, 2, 3].permutationsWithRepetitions(2).writeln;
}</langsyntaxhighlight>
The output is the same.
 
=={{header|EchoLisp}}==
<langsyntaxhighlight lang="scheme">
(lib 'sequences) ;; (indices ..)
(lib 'list) ;; (list-permute ..)
Line 545 ⟶ 830:
(list-permute '(a b c d e) #(1 0 1 0 3 2 1))
→ (b a b a d c b)
</syntaxhighlight>
</lang>
 
=={{header|Elixir}}==
{{trans|Erlang}}
<langsyntaxhighlight lang="elixir">defmodule RC do
def perm_rep(list), do: perm_rep(list, length(list))
Line 562 ⟶ 847:
Enum.each(1..3, fn n ->
IO.inspect RC.perm_rep(list,n)
end)</langsyntaxhighlight>
 
{{out}}
Line 575 ⟶ 860:
 
=={{header|Erlang}}==
<langsyntaxhighlight Erlanglang="erlang">-module(permute).
-export([permute/1]).
 
Line 581 ⟶ 866:
permute([],_) -> [[]];
permute(_,0) -> [[]];
permute(L,I) -> [[X|Y] || X<-L, Y<-permute(L,I-1)].</langsyntaxhighlight>
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 624 ⟶ 909:
}
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 640 ⟶ 925:
 
=={{header|Haskell}}==
<langsyntaxhighlight lang="haskell">import Control.Monad (replicateM)
 
main = mapM_ print (replicateM 2 [1,2,3])</langsyntaxhighlight>
{{out}}
<pre>
Line 660 ⟶ 945:
Position in the sequence is an integer from <code>i.n^k</code>, for example:
 
<langsyntaxhighlight lang="j"> i.3^2
0 1 2 3 4 5 6 7 8</langsyntaxhighlight>
 
The sequence itself is expressed using <code>(k#n)#: position</code>, for example:
 
<langsyntaxhighlight lang="j"> (2#3)#:i.3^2
0 0
0 1
Line 674 ⟶ 959:
2 0
2 1
2 2</langsyntaxhighlight>
 
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:
 
<langsyntaxhighlight lang="j"> (2#3)#:3 4 5
1 0
1 1
1 2</langsyntaxhighlight>
 
We might express this as a verb
 
<langsyntaxhighlight lang="j">perm=: # #: i.@^~</langsyntaxhighlight>
 
with example use:
 
<langsyntaxhighlight lang="j"> 2 perm 3
0 0
0 1
0 2
1 0
...</langsyntaxhighlight>
 
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.
Line 700 ⟶ 985:
=={{header|Java}}==
{{works with|Java|8}}
<langsyntaxhighlight lang="java">import java.util.function.Predicate;
 
public class PermutationsWithRepetitions {
Line 736 ⟶ 1,021:
}
}
}</langsyntaxhighlight>
 
Output:
Line 752 ⟶ 1,037:
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.
 
<langsyntaxhighlight JavaScriptlang="javascript">(function () {
'use strict';
 
Line 813 ⟶ 1,098:
 
//--> [[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]
})();</langsyntaxhighlight>
 
{{Out}}
<langsyntaxhighlight JavaScriptlang="javascript">[[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]</langsyntaxhighlight>
 
Permutations with repetition by treating the <math>n^k</math> 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:
 
<langsyntaxhighlight JavaScriptlang="javascript">(function () {
'use strict';
 
Line 922 ⟶ 1,207:
return show(range(30, 35)
.map(curry(nthPermutationWithRepn)(['X', 'Y', 'Z'], 4)));
})();</langsyntaxhighlight>
 
{{Out}}
Line 928 ⟶ 1,213:
 
===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.
Line 934 ⟶ 1,219:
A (strict) analogue of the (lazy) replicateM in Haskell.
 
<langsyntaxhighlight JavaScriptlang="javascript">(() => {
'use strict';
 
Line 973 ⟶ 1,258:
);
// -> [[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]
})();</langsyntaxhighlight>
{{Out}}
<langsyntaxhighlight JavaScriptlang="javascript">[[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]</langsyntaxhighlight>
 
Permutations with repetition by treating the <math>n^k</math> 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:
 
====Lazy evaluation with a generator ====
<lang JavaScript>(() => {
Permutations with repetition by treating the <math>n^k</math> 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:
 
<syntaxhighlight lang="javascript">(() => {
'use strict';
 
const main = () => {
// nthPermutationWithRepn :: [a] -> Int -> Int -> [a]
const nthPermutationWithRepn = (xs, groupSize, index) => {
const
intBase = xs.length,
intSetSize = Math.pow(intBase, groupSize),
lastIndex = intSetSize - 1; // zero-based
 
// Generator object
if (intBase < 1 || index > lastIndex) return undefined;
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
baseElementsvs = unfoldrArray.from(m => {xs),
intBase = vs.length,
intSet = Math.pow(intBase, intGroup);
if (0 < intBase) {
let index = 0;
while (index < intSet) {
const
vds = m.new,unfoldr(
[d, r] v => 0 < quotRem(v, intBase? ((); => {
return { const rd = quotRem(v, intBase);
valid: d > 0 return Just(Tuple(vs[rd[1]], rd[0]))
value })() : xs[r]Nothing(),
new: d index++
} );
}, index), yield replicate(
intZeros = groupSize intGroup - baseElementsds.length;,
vs[0]
 
return intZeros > 0 ? ).concat(ds);
(replicate(intZeros, xs[0]))};
.concat(baseElements)}
) : baseElements;
};
 
// GENERIC FUNCTIONS ----------------------------------
 
// GENERICJust FUNCTIONS:: a -> Maybe a
const Just = x => ({
type: 'Maybe',
Nothing: false,
Just: x
});
 
// unfoldrNothing :: (b -> Maybe (a, b)) -> b -> [a]
const unfoldrNothing = (mf, v) => ({
vartype: xs = [];'Maybe',
returnNothing: [until(true,
});
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);
};
 
// untilTuple (,) :: (a -> Bool)b -> (a, -> ab) -> a -> a
const untilTuple = (pa, f, xb) => ({
lettype: v = x;'Tuple',
while'0': (!p(v)) v = f(v);a,
return'1': v;b,
} length: 2
});
 
// replicateconcat :: Int -> [[a]] -> [a]
const// replicateconcat =:: (n,[String] a) =-> {String
const concat = let vxs = [a],>
0 < xs.length ? o(() => [];{
if (n < 1) returnconst o;unit = 'string' !== typeof xs[0] ? (
while (n > 1) { []
if (n & 1) o: = o.concat(v)'';
nreturn >>=unit.concat.apply(unit, 1xs);
})() : v = v.concat(v)[];
}
return o.concat(v);
};
 
// quotRemindex (!!) :: Integral a => [a] -> aInt -> (a, a)
const// quotRem =index (m, n!!) =>:: [Math.floor(mString /-> n),Int m %-> n];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); //, null, 2);
 
// currytoLower :: FunctionString -> FunctionString
const currytoLower = (f, ...args)s => {s.toLocaleLowerCase();
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));
};
 
// rangeunfoldr(x ::=> Int0 ->!== Intx ->? Just([Intx, x - 1]) : Nothing(), 10);
// --> [10,9,8,7,6,5,4,3,2,1]
const range = (m, n) =>
Array.from({
length: Math.floor(n - m) + 1
}, (_, i) => m + i);
 
// 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])
}
}
};
 
// TESTMAIN ---
return main();
// Just items 30 to 35 in the (zero-indexed) series:
})();</syntaxhighlight>
return show(
range(30, 35)
.map(
curry(nthPermutationWithRepn)(['X', 'Y', 'Z'], 4)
)
);
})();</lang>
 
{{Out}}
<pre>Generated 589 of 1024 possible permutations,
<pre>["Y","X","Y","X"], ["Y","X","Y","Y"], ["Y","X","Y","Z"], ["Y","X","Z","X"], ["Y","X","Z","Y"], ["Y","X","Z","Z"]</pre>
searching from: ["A","A","A","A","A"] thru: ["A","R","A","C","K"]
before finding: ["C","R","A","C","K"]</pre>
 
=={{header|jq}}==
Line 1,100 ⟶ 1,410:
We shall define permutations_with_replacements(n) in terms of a more general filter, combinations/0, defined as follows:
 
<langsyntaxhighlight lang="jq"># Input: an array, $in, of 0 or more arrays
# Output: a stream of arrays, c, with c[i] drawn from $in[i].
def combinations:
Line 1,113 ⟶ 1,423:
# 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;</langsyntaxhighlight>
'''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.
<langsyntaxhighlight lang="jq">def count(stream): reduce stream as $i (0; .+1);
 
count([0,1,2] | permutations_with_replacements(4))
# output: 81</langsyntaxhighlight>
 
 
Line 1,128 ⟶ 1,438:
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"]?
<langsyntaxhighlight lang="jq"># 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
Line 1,139 ⟶ 1,449:
["c", "a", "b"] | sequence_number( ["a","b","c"] | permutations_with_replacements(3))
 
# output: 20</langsyntaxhighlight>
 
=={{header|Julia}}==
{{works with|Julia|0.6}}
 
Implements a simil-Combinatorics.jl API.
 
<syntaxhighlight lang="julia">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)))</syntaxhighlight>
 
{{out}}
<pre>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]</pre>
 
=={{header|K}}==
enlist each from x on the left and each from x on the right where x is range 10
<syntaxhighlight lang="k">
,/x/:\:x:!10
</syntaxhighlight>
 
=={{header|Kotlin}}==
{{trans|Go}}
<syntaxhighlight lang ="scala">// version 1.1.12
 
fun main(args: Array<String>) {
Line 1,149 ⟶ 1,529:
val values = charArrayOf('A', 'B', 'C', 'D')
val k = values.size
// terminate when first two characters of the permuationpermutation are 'B' and 'C' respectively
val decide = fun(pc: CharArray) = pc[0] == 'B' && pc[1] == 'C'
val pn = IntArray(n)
Line 1,166 ⟶ 1,546:
if (pn[i] < k) break
pn[i++] = 0
if (i == n) return // all permuationspermutations generated
}
}
}</langsyntaxhighlight>
 
{{out}}
Line 1,185 ⟶ 1,565:
</pre>
 
=={{header|MathematicaM2000 Interpreter}}==
<syntaxhighlight lang="m2000 interpreter">
<lang mathematica>Tuples[{1, 2, 3}, 2]</lang>
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
</syntaxhighlight>
{{out}}
<pre style="height:30ex;overflow:scroll">
<pre>{{1, 1}, {1, 2}, {1, 3}, {2, 1}, {2, 2}, {2, 3}, {3, 1}, {3, 2}, {3, 3}}</pre>
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
</pre >
 
=={{header|PerlMathematica}}/{{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica">Tuples[{1, 2, 3}, 2]</syntaxhighlight>
<lang perl>use Algorithm::Combinatorics qw/tuples_with_repetition/;
print join(" ", map { "[@$_]" } tuples_with_repetition([qw/A B C/],2)), "\n";</lang>
{{out}}
<pre>[A{{1, A]1}, [A{1, B]2}, [A{1, C]3}, [B{2, A]1}, [B{2, B]2}, [B{2, C]3}, [C{3, A]1}, [C{3, B]2}, [C{3, C]3}}</pre>
 
=={{header|Maxima}}==
Solving the crack problem:
<syntaxhighlight lang="maxima">apply(cartesian_product,makelist({1,2,3}, 2));</syntaxhighlight>
<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>
{{out}}
<pre>{[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]}</pre>
<pre>Found the combination after 455 tries!</pre>
 
=={{header|Perl 6Nim}}==
{{trans|Go}}
<syntaxhighlight lang="nim">import strutils
 
We can use the <tt>X</tt> operator ("cartesian product") to cross the list with itself.<br>
For <math>n=2</math>:
 
func decide(pc: openArray[char]): bool =
{{works with|rakudo|2016.07}}
## Terminate when first two characters of the
<lang perl6>my @k = <a b c>;
## permutation are 'B' and 'C' respectively.
pc[0] == 'B' and pc[1] == 'C'
 
.say for @k X @k;</lang>
 
proc permute(values: openArray[char]; n: Positive) =
For arbitrary <math>n</math>:
 
let k = values.len
{{works with|rakudo|2016.07}}
var
<lang perl6>my @k = <a b c>;
pn = newSeq[int](n)
my $n = 2;
p = newSeq[char](n)
 
while true:
.say for [X] @k xx $n;</lang>
# Generate permutation
for i, x in pn: p[i] = values[x]
# Show progress.
echo p.join(" ")
# Pass to deciding function.
if decide(p): return # Terminate early.
# Increment permutation number.
var i = 0
while true:
inc pn[i]
if pn[i] < k: break
pn[i] = 0
inc i
if i == n: return # All permutations generated.
 
{{out}}
<pre>a a
a b
a c
b a
b b
b c
c a
c b
c c</pre>
 
permute("ABCD", 3)</syntaxhighlight>
Here is an other approach, counting all <math>k^n</math> possibilities in base <math>k</math>:
 
{{out}}
{{works with|rakudo|2016.07}}
<pre>A A A
<lang perl6>my @k = <a b c>;
B A A
my $n = 2;
C A A
D A A
A B A
B B A
C B A
D B A
A C A
B C A</pre>
 
say @k[.polymod: +@k xx $n-1] for ^@k**$n</lang>
 
{{out}}
<pre>a a
b a
c a
a b
b b
c b
a c
b c
c c</pre>
=={{header|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.
<langsyntaxhighlight lang="pascal">program PermuWithRep;
//permutations with repetitions
//http://rosettacode.org/wiki/Permutations_with_repetitions
Line 1,353 ⟶ 1,774:
until Not(NextPermWithRep(p));
writeln('k: ',k,' n: ',n,' count ',cnt);
end.</langsyntaxhighlight>
{{Out}}
<pre>
Line 1,374 ⟶ 1,795:
//"old" compiler-version
//real 0m3.465s /fpc/2.6.4/ppc386 "%f" -al -Xs -XX -O3</pre>
 
=={{header|Perl}}==
<syntaxhighlight lang="perl">use Algorithm::Combinatorics qw/tuples_with_repetition/;
print join(" ", map { "[@$_]" } tuples_with_repetition([qw/A B C/],2)), "\n";</syntaxhighlight>
{{out}}
<pre>[A A] [A B] [A C] [B A] [B B] [B C] [C A] [C B] [C C]</pre>
 
Solving the crack problem:
<syntaxhighlight 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";
}</syntaxhighlight>
{{out}}
<pre>Found the combination after 455 tries!</pre>
 
=={{header|Phix}}==
The task is equivalent to simply counting in base=length(set), from 1 to power(base,n).<br>
Asking for the 0th permutation just returns the total number of permutations (ie "").<br>
Results can be generated in any order, hence early termination is quite simply a non-issue.
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">permrep</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">set</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">base</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set</span><span style="color: #0000FF;">),</span>
<span style="color: #000000;">nperm</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">power</span><span style="color: #0000FF;">(</span><span style="color: #000000;">base</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000080;font-style:italic;">-- return the number of permutations</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">nperm</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000080;font-style:italic;">-- return the idx'th [1-based] permutation</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;"><</span><span style="color: #000000;">1</span> <span style="color: #008080;">or</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">></span><span style="color: #000000;">nperm</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">idx</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span> <span style="color: #000080;font-style:italic;">-- make it 0-based</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">""</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">prepend</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">set</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">mod</span><span style="color: #0000FF;">(</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">,</span><span style="color: #000000;">base</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">idx</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">/</span><span style="color: #000000;">base</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">idx</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> <span style="color: #000080;font-style:italic;">-- sanity check</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #000080;font-style:italic;">-- Some slightly excessive testing:</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">show_all</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">set</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">lo</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">hi</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">l</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">permrep</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">hi</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #000000;">hi</span><span style="color: #0000FF;">=</span><span style="color: #000000;">l</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">l</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">l</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">permrep</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">mx</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">hi</span><span style="color: #0000FF;">=</span><span style="color: #000000;">l</span><span style="color: #0000FF;">?</span><span style="color: #008000;">""</span><span style="color: #0000FF;">:</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"/%d"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">l</span><span style="color: #0000FF;">)),</span>
<span style="color: #000000;">pof</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"perms[%d..%d%s] of %v"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">lo</span><span style="color: #0000FF;">,</span><span style="color: #000000;">hi</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mx</span><span style="color: #0000FF;">,</span><span style="color: #000000;">set</span><span style="color: #0000FF;">})</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Len %d %-35s: %v\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">pof</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">shorten</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">lo</span><span style="color: #0000FF;">..</span><span style="color: #000000;">hi</span><span style="color: #0000FF;">],</span><span style="color: #008000;">""</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">show_all</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"123"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">show_all</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"123"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">show_all</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"123"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">show_all</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"456"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">show_all</span><span style="color: #0000FF;">({</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">},</span><span style="color: #000000;">3</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">show_all</span><span style="color: #0000FF;">({</span><span style="color: #008000;">"bat"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"fox"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"cow"</span><span style="color: #0000FF;">},</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">show_all</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"XYZ"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">,</span><span style="color: #000000;">31</span><span style="color: #0000FF;">,</span><span style="color: #000000;">36</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">l</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">permrep</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"ACKR"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">5</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">l</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">permrep</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"ACKR"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">5</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i</span><span style="color: #0000FF;">)=</span><span style="color: #008000;">"CRACK"</span> <span style="color: #008080;">then</span> <span style="color: #000080;font-style:italic;">-- 455</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Len 5 perm %d/%d of \"ACKR\" : CRACK\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">l</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">exit</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000080;font-style:italic;">--The 590th (one-based) permrep is KCARC, ie reverse(CRACK), matching the 589 result of 0-based idx solutions</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"reverse(permrep(\"ACKR\",5,589+1):%s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #7060A8;">reverse</span><span style="color: #0000FF;">(</span><span style="color: #000000;">permrep</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"ACKR"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">5</span><span style="color: #0000FF;">,</span><span style="color: #000000;">590</span><span style="color: #0000FF;">))})</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Len 1 perms[1..3] of "123" : {"1","2","3"}
Len 2 perms[1..9] of "123" : {"11","12","13","...","31","32","33"}
Len 3 perms[1..27] of "123" : {"111","112","113","...","331","332","333"}
Len 3 perms[1..27] of "456" : {"444","445","446","...","664","665","666"}
Len 3 perms[1..27] of {1,2,3} : {{1,1,1},{1,1,2},{1,1,3},"...",{3,3,1},{3,3,2},{3,3,3}}
Len 2 perms[1..9] of {"bat","fox","cow"} : {{"bat","bat"},{"bat","fox"},{"bat","cow"},"...",{"cow","bat"},{"cow","fox"},{"cow","cow"}}
Len 4 perms[31..36/81] of "XYZ" : {"YXYX","YXYY","YXYZ","YXZX","YXZY","YXZZ"}
Len 5 perm 455/1024 of "ACKR" : CRACK
reverse(permrep("ACKR",5,589+1):CRACK
</pre>
 
=={{header|PHP}}==
<langsyntaxhighlight PHPlang="php"><?php
function permutate($values, $size, $offset) {
$count = count($values);
Line 1,400 ⟶ 1,908:
echo join(',', $permutation)."\n";
}
</syntaxhighlight>
</lang>
 
{{out}}
Line 1,415 ⟶ 1,923:
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(de permrep (N Lst)
(if (=0 N)
(cons NIL)
Line 1,421 ⟶ 1,929:
'((X)
(mapcar '((Y) (cons Y X)) Lst) )
(permrep (dec N) Lst) ) ) )</langsyntaxhighlight>
 
=={{header|Python}}==
 
<lang python>from itertools import product
===Strict evaluation of the whole set===
 
To evaluate the whole set of permutations, without the option to make complete evaluation conditional, we can reach for a generic replicateM function for lists:
{{Works with|Python|3.7}}
<syntaxhighlight lang="python">'''Permutations of n elements drawn from k values'''
 
from itertools import product
 
 
# replicateM :: Applicative m => Int -> m a -> m [a]
def replicateM(n):
'''A functor collecting values accumulated by
n repetitions of m. (List instance only here).
'''
def rep(m):
def go(x):
return [[]] if 1 > x else (
liftA2List(lambda a, b: [a] + b)(m)(go(x - 1))
)
return go(n)
return lambda m: rep(m)
 
 
# TEST ----------------------------------------------------
# main :: IO ()
def main():
'''Permutations of two elements, drawn from three values'''
print(
fTable(main.__doc__ + ':\n')(repr)(showList)(
 
replicateM(2)
 
)([[1, 2, 3], 'abc'])
)
 
 
# GENERIC FUNCTIONS ---------------------------------------
 
# liftA2List :: (a -> b -> c) -> [a] -> [b] -> [c]
def liftA2List(f):
'''The binary operator f lifted to a function over two
lists. f applied to each pair of arguments in the
cartesian product of xs and ys.
'''
return lambda xs: lambda ys: [
f(*xy) for xy in product(xs, ys)
]
 
 
# DISPLAY -------------------------------------------------
 
# fTable :: String -> (a -> String) ->
# (b -> String) -> (a -> b) -> [a] -> String
def fTable(s):
'''Heading -> x display function -> fx display function ->
f -> xs -> tabular string.
'''
def go(xShow, fxShow, f, xs):
ys = [xShow(x) for x in xs]
w = max(map(len, ys))
return s + '\n' + '\n'.join(map(
lambda x, y: y.rjust(w, ' ') + ' -> ' + fxShow(f(x)),
xs, ys
))
return lambda xShow: lambda fxShow: lambda f: lambda xs: go(
xShow, fxShow, f, xs
)
 
 
# showList :: [a] -> String
def showList(xs):
'''Stringification of a list.'''
return '[' + ','.join(
showList(x) if isinstance(x, list) else repr(x) for x in xs
) + ']'
 
 
# MAIN ---
if __name__ == '__main__':
main()</syntaxhighlight>
{{Out}}
<pre>Permutations of two elements, drawn from three values:
 
[1, 2, 3] -> [[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]
'abc' -> [['a','a'],['a','b'],['a','c'],['b','a'],['b','b'],['b','c'],['c','a'],['c','b'],['c','c']]</pre>
 
===Lazy evaluation with a generator===
====Applying itertools.product====
 
<syntaxhighlight lang="python">from itertools import product
 
# check permutations until we find the word 'crack'
Line 1,430 ⟶ 2,028:
w = ''.join(x)
print w
if w.lower() == 'crack': break</langsyntaxhighlight>
 
====Writing a generator====
 
Or, composing our own generator, by wrapping a function '''from''' an index in the range ''0 .. ((distinct items to the power of groupSize) - 1)'' '''to''' a unique permutation. (Each permutation is equivalent to a 'number' in the base of the size of the set of distinct items, in which each distinct item functions as a 'digit'):
{{Works with|Python|3.7}}
<syntaxhighlight lang="python">'''Generator-based permutations with repetition'''
 
from itertools import (chain, repeat)
 
 
# permsWithRepns :: [a] -> Int -> Generator [[a]]
def permsWithRepns(xs):
'''Generator of permutations of length n, with
elements drawn from the values in xs.
'''
def groupsOfSize(n):
f = nthPermWithRepn(xs)(n)
limit = len(xs)**n
i = 0
while i < limit:
yield f(i)
i = 1 + i
return lambda n: groupsOfSize(n)
 
 
# Index as a 'number' in the base of the
# size of the set (of distinct values to be permuted),
# using each value as a 'digit'
# (leftmost value used as the 'zero')
 
# nthPermWithRepn :: [a] -> Int -> Int -> [a]
def nthPermWithRepn(xs):
'''Indexed permutation of n values drawn from xs'''
def go(intGroup, index):
vs = list(xs)
intBase = len(vs)
intSet = intBase ** intGroup
return (
lambda ds=unfoldr(
lambda v: (
lambda qr=divmod(v, intBase): Just(
(qr[0], vs[qr[1]])
)
)() if 0 < v else Nothing()
)(index): (
list(repeat(vs[0], intGroup - len(ds))) + ds
)
)() if 0 < intBase and index < intSet else None
return lambda intGroup: lambda index: go(
intGroup, index
)
 
 
# MAIN ----------------------------------------------------
# main :: IO ()
def main():
'''Search for a 5 char permutation drawn from 'ACKR' matching "crack"'''
 
cs = 'ACKR'
wordLength = 5
target = 'crack'
 
gen = permsWithRepns(cs)(wordLength)
mb = Nothing()
for idx, xs in enumerate(gen):
s = ''.join(xs)
if target == s.lower():
mb = Just((s, idx))
break
 
print(main.__doc__ + ':\n')
print(
maybe('No match found for "{k}"'.format(k=target))(
lambda m: 'Permutation {idx} of {total}: {pm}'.format(
idx=m[1], total=len(cs)**wordLength, pm=s
)
)(mb)
)
 
 
# GENERIC FUNCTIONS -------------------------------------
 
# Just :: a -> Maybe a
def Just(x):
'''Constructor for an inhabited Maybe(option type) value.'''
return {'type': 'Maybe', 'Nothing': False, 'Just': x}
 
 
# Nothing :: Maybe a
def Nothing():
'''Constructor for an empty Maybe(option type) value.'''
return {'type': 'Maybe', 'Nothing': True}
 
 
# concat :: [[a]] -> [a]
# concat :: [String] -> String
def concat(xs):
'''The concatenation of all the elements
in a list or iterable.'''
 
def f(ys):
zs = list(chain(*ys))
return ''.join(zs) if isinstance(ys[0], str) else zs
 
return (
f(xs) if isinstance(xs, list) else (
chain.from_iterable(xs)
)
) if xs else []
 
 
# fst :: (a, b) -> a
def fst(tpl):
'''First member of a pair.'''
return tpl[0]
 
 
# maybe :: b -> (a -> b) -> Maybe a -> b
def maybe(v):
'''Either the default value v, if m is Nothing,
or the application of f to x,
where m is Just(x).
'''
return lambda f: lambda m: v if None is m or m.get('Nothing') else (
f(m.get('Just'))
)
 
 
# snd :: (a, b) -> b
def snd(tpl):
'''Second member of a pair.'''
return tpl[1]
 
 
# unfoldr(lambda x: Just((x, x - 1)) if 0 != x else Nothing())(10)
# -> [10, 9, 8, 7, 6, 5, 4, 3, 2, 1]
# unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
def unfoldr(f):
'''Dual to reduce or foldr.
Where catamorphism reduces a list to a summary value,
the anamorphic unfoldr builds a list from a seed value.
As long as f returns Just(a, b), a is prepended to the list,
and the residual b is used as the argument for the next
application of f.
When f returns Nothing, the completed list is returned.
'''
def go(v):
xr = v, v
xs = []
while True:
mb = f(xr[0])
if mb.get('Nothing'):
return xs
else:
xr = mb.get('Just')
xs.append(xr[1])
return xs
return lambda x: go(x)
 
 
# MAIN ---
if __name__ == '__main__':
main()</syntaxhighlight>
{{Out}}
<pre>Search for a 5 char permutation drawn from 'ACKR' matching "crack":
 
Permutation 589 of 1024: CRACK</pre>
 
=={{header|Quackery}}==
 
A scenario for the task: An executive has forgotten the "combination" to unlock one of the clasps on their executive briefcase. It is 222 but they can't remember that. Unlikely as it may seem, they do remember that it does not have any zeros, or any numbers greater than 6. Also, the combination, when written as English words, "two two two" requires an odd number of letters. You'd think that, remembering details like that, they'd be able to recall the number itself, but such is the nature of programming tasks. <shrug>
 
Stepping through all the possibilities from 000 to 999 would take 3^10 steps, and is just a matter of counting from 0 to 999 inclusive, left padding the small numbers with zeros as required. As we know that some numbers are precluded we can reduce this to stepping from 000 to 444 in base 4, mapping the digits 0 to 4 onto the words "one" to "five", and printing only the resultant strings which have an odd number of characters.
 
Generators are not defined in Quackery, but are easy enough to create, requiring a single line of code.
 
<syntaxhighlight lang="quackery"> [ ]this[ take ]'[ do ]this[ put ]done[ ] is generator ( --> )</syntaxhighlight>
 
An explanation of how this works is beyond the scope of this task, but the use of "meta-words" (i.e. those wrapped in ]reverse-brackets[) is explored in [https://github.com/GordonCharlton/Quackery The Book of Quackery]. How <code>generator</code> can be used is illustrated in the somewhat trivial instance used in this task, <code>counter</code>, which returns 0 the first time is is called, and one more in every subsequent call. As a convenience we also define <code>resetgen</code>, which can be used to reset a generator word to a specified state.
 
<syntaxhighlight lang="quackery"> [ ]'[ replace ] is resetgen ( x --> )</syntaxhighlight>
 
As a microscopically less trivial example of words defined using <code>generator</code> and <code>resetgen</code>, the word <code>fibonacci</code> will return subsequent numbers on the Fibonacci sequence - 0, 1, 1, 2, 3, 5, 8… on each invocation, and can be restarted by calling <code>resetfib</code>.
 
<syntaxhighlight lang="quackery"> [ generator [ do 2dup + join ] [ 0 1 ] ] is fibonacci ( --> n )
 
[ ' [ 0 1 ] resetgen fibonacci ] is resetfib ( --> )</syntaxhighlight>
 
And so to the task:
 
<syntaxhighlight lang="quackery"> [ 1 & ] is odd ( n --> b )
 
[ ]this[ take ]'[ do ]this[ put ]done[ ] is generator ( --> )
 
[ ]'[ replace ] is resetgen ( x --> )
 
[ generator [ dup 1+ ] 0 ] is counter ( --> n )
[ 0 resetgen counter ] is resetcounter ( --> n )
 
[ [] unrot times
[ base share /mod rot join swap ]
drop ] is ndigits ( n n --> [ )
 
[ [] unrot
over size base put
counter swap ndigits
witheach
[ dip dup peek
rot swap join
space join swap ]
drop
-1 split drop
base release ] is nextperm ( [ n --> [ )
 
[ [ $ "one two three four five"
nest$ ] constant
3 nextperm ] is task ( --> [ )
 
resetcounter
[ task
dup size odd if
[ dup echo$ cr ]
$ "two two two" = until ]</syntaxhighlight>
 
{{out}}
 
<pre>one one one
one one two
one one three
one two one
one two two
one two three
one three one
one three two
one three three
one four four
one four five
one five four
one five five
two one one
two one two
two one three
two two one
two two two</pre>
 
=={{header|Racket}}==
===As a sequence===
First we define a procedure that defines the sequence of the permutations.
<langsyntaxhighlight Racketlang="racket">#lang racket
(define (permutations-with-repetitions/proc size items)
(define items-vector (list->vector items))
Line 1,468 ⟶ 2,311:
continue-after-pos+val?))))
(sequence->list (permutations-with-repetitions/proc 2 '(1 2 3)))</langsyntaxhighlight>
{{out}}
<pre>'((1 1) (1 2) (1 3) (2 1) (2 2) (2 3) (3 1) (3 2) (3 3))</pre>
Line 1,474 ⟶ 2,317:
===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.
<langsyntaxhighlight Racketlang="racket">(require (for-syntax racket))
(define-sequence-syntax in-permutations-with-repetitions
Line 1,510 ⟶ 2,353:
(for/list ([element (in-permutations-with-repetitions 2 '(1 2 3))])
element)
(sequence->list (in-permutations-with-repetitions 2 '(1 2 3)))</langsyntaxhighlight>
{{out}}
<pre>'((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))</pre>
 
=={{header|Raku}}==
(formerly Perl 6)
 
We can use the <tt>X</tt> operator ("cartesian product") to cross the list with itself.<br>
For <math>n=2</math>:
 
{{works with|rakudo|2016.07}}
<syntaxhighlight lang="raku" line>my @k = <a b c>;
 
.say for @k X @k;</syntaxhighlight>
 
For arbitrary <math>n</math>:
 
{{works with|rakudo|2016.07}}
<syntaxhighlight lang="raku" line>my @k = <a b c>;
my $n = 2;
 
.say for [X] @k xx $n;</syntaxhighlight>
 
{{out}}
<pre>a a
a b
a c
b a
b b
b c
c a
c b
c c</pre>
 
Here is an other approach, counting all <math>k^n</math> possibilities in base <math>k</math>:
 
{{works with|rakudo|2016.07}}
<syntaxhighlight lang="raku" line>my @k = <a b c>;
my $n = 2;
 
say @k[.polymod: +@k xx $n-1] for ^@k**$n</syntaxhighlight>
 
{{out}}
<pre>a a
b a
c a
a b
b b
c b
a c
b c
c c</pre>
 
=={{header|REXX}}==
===version 1===
<langsyntaxhighlight lang="rexx">/*REXX programpgm generates/displays all permutations of withN repeatsdifferent objects oftaken M Nat a objectstime.*/
parse arg things bunch inbetweenChars names
/* ╔════════════════════════════════════════════════════════════════╗ */
/* ║ inBetweenChars (optional) defaults to a [null]. ║ */
/* ║ names (optional) defaults to digits (and letters).║ */
/* ╚════════════════════════════════════════════════════════════════╝ */
call permSets things, bunch, inBetweenChars, names
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
p: return word( arg(1), 1) /*P function (Pick first arg of many).*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
permSets: procedure; parse arg x,y,between,uSyms /*X things taken Y at a time. */
@.=; sep= /*X can't be > length(@0abcs). */
@abc = 'abcdefghijklmnopqrstuvwxyz'; @abcU= @abc; upper @abcU
@abcS = @abcU || @abc; @0abcS= 123456789 || @abcS
 
/* inbetweenChars (optional) defaultsdo tok=1 a for [null].x /*build a list of permutation symbols. */
/* _= p( word(uSyms, k) names p( substr(optional)@0abcS, k, 1) defaultsk) to) digits (and/*get/generate letters)a symbol. */
if length(_)\==1 then sep= '_' /*if not 1st character, then use sep. */
$.k= _ /*append the character to symbol list. */
end /*k*/
 
if between=='' then between= sep /*use the appropriate separator chars. */
call permRsets things,bunch,inbetweenChars,names
exit call .permSet 1 /*stickstart awith forkthe in it,first we're donepermutation. */
return /* [↓] this is a recursive subroutine.*/
/*──────────────────────────────────.PERMRSET subroutine────────────────*/
.permRsetpermSet: procedure expose (list)$. @. between x y; parse arg ?
if ?>y then do; _=@.1; do j=2 to for y-1; _=_ || between || @.j; end; say _; end
else do q=1 for x /*build permutation recursively. */end
@.?=$. else do q;=1 for x call /*build the permutation recursively.permRset ?+1*/
end /* @.?= $.q*/; call .permSet ?+1
end /*q*/
return
return /*this is meant to be an anonymous sub.*/</syntaxhighlight>
/*──────────────────────────────────PERMRSETS subroutine────────────────*/
{{out|output|text=&nbsp; when using the default inputs of: &nbsp; &nbsp; <tt> 3 &nbsp; 2 </tt>}}
permRsets: procedure; parse arg x,y,between,uSyms /*X things Y at a time*/
<pre>
@.=; 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: <tt> 3 2
<pre style="overflow:scroll">
11
12
Line 1,562 ⟶ 2,453:
33
</pre>
'''{{out|output'''|text=&nbsp; when using the inputdefault inputs of : &nbsp; &nbsp; <tt> 3 &nbsp; 2 &nbsp; , &nbsp; bat &nbsp; fox &nbsp; cow </tt>}}
<pre>
<pre style="overflow:scroll">
bat,bat
bat,fox
Line 1,582 ⟶ 2,473:
<br>&nbsp;&nbsp;Say 'too large for this Rexx version'
<br>Also note that the output isn't the same as REXX version 1 when the 1st argument is two digits or more, i.e.: &nbsp; '''11 &nbsp; 2'''
<langsyntaxhighlight 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
Line 1,617 ⟶ 2,508:
a=a||'Say' p 'permutations'
/* Say a */
Interpret a</langsyntaxhighlight>
 
===version 3===
This is a very simplistic version that is limited to nine things (''things'N''').
<br>It essentially just executes a &nbsp; '''DOdo''' &nbsp; loop and ignores any permutation out of range,
<br>this is very wasteful of CPU processing time when using a larger &nbsp; '''N'bunches''.
 
<br>This version isn't ready for ''prime time''.
This version could easily be extended to '''N''' up to 15 &nbsp; (using hexadecimal arithmetic).
<lang rexx>/*REXX pgm generates all permutations with repeats of N objects (< 10).*/
<syntaxhighlight lang="rexx">/*REXX pgm gens all permutations with repeats of N objects (<10) taken M at a time. */
parse arg things bunch .; z=things**bunch; good=left(1234567890,things)
parse arg N M .
t=0
z= N**M
do j=copies(1, bunch) until t==z
$= left(1234567890, N)
if verify(j,good)\==0 then iterate
t= 0
t=t+1
do j=copies(1, M) until t==z
if verify(j, $)\==0 then iterate
t= t+1
say j
end /*j*/ /*stick a fork in it, we're all done. */</syntaxhighlight>
end /*j*/
{{out|output|text= &nbsp; when using the following inputs: &nbsp; &nbsp; <tt> 3 &nbsp; 2 </tt>}}
/*stick a fork in it, we're done.*/</lang>
'''output''' when the input is: <tt> 3 2 </tt>
<pre>
11
Line 1,644 ⟶ 2,537:
32
33
</pre>
 
=={{header|Ring}}==
<syntaxhighlight lang="ring">
# Project : Permutations with repetitions
list1 = [["a", "b", "c"], ["a", "b", "c"]]
list2 = [["1", "2", "3"], ["1", "2", "3"]]
permutation(list1)
permutation(list2)
func permutation(list1)
for n = 1 to len(list1[1])
for m = 1 to len(list1[2])
see list1[1][n] + " " + list1[2][m] + nl
next
next
see nl
</syntaxhighlight>
Output:
<pre>
a a
a b
a c
b a
b b
b c
c a
c b
c c
 
1 1
1 2
1 3
2 1
2 2
2 3
3 1
3 2
3 3
</pre>
 
=={{header|Ruby}}==
This is built in　(Array#repeated_permutation):
<langsyntaxhighlight 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]]
 
#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]]</langsyntaxhighlight>
 
=={{header|Rust}}==
<syntaxhighlight lang="rust">
struct PermutationIterator<'a, T: 'a> {
universe: &'a [T],
size: usize,
prev: Option<Vec<usize>>,
}
 
fn permutations<T>(universe: &[T], size: usize) -> PermutationIterator<T> {
PermutationIterator {
universe,
size,
prev: None,
}
}
 
fn map<T>(values: &[T], ixs: &[usize]) -> Vec<T>
where
T: Clone,
{
ixs.iter().map(|&i| values[i].clone()).collect()
}
 
impl<'a, T> Iterator for PermutationIterator<'a, T>
where
T: Clone,
{
type Item = Vec<T>;
 
fn next(&mut self) -> Option<Vec<T>> {
let n = self.universe.len();
 
if n == 0 {
return None;
}
 
match self.prev {
None => {
let zeroes: Vec<usize> = std::iter::repeat(0).take(self.size).collect();
let result = Some(map(self.universe, &zeroes[..]));
self.prev = Some(zeroes);
result
}
Some(ref mut indexes) => match indexes.iter().position(|&i| i + 1 < n) {
None => None,
Some(position) => {
for index in indexes.iter_mut().take(position) {
*index = 0;
}
indexes[position] += 1;
Some(map(self.universe, &indexes[..]))
}
},
}
}
}
 
fn main() {
let universe = ["Annie", "Barbie"];
for p in permutations(&universe[..], 3) {
for element in &p {
print!("{} ", element);
}
println!();
}
}
 
</syntaxhighlight>
{{out}}
<pre>
Annie Annie Annie
Barbie Annie Annie
Annie Barbie Annie
Barbie Barbie Annie
Annie Annie Barbie
Barbie Annie Barbie
Annie Barbie Barbie
Barbie Barbie Barbie
</pre>
 
=={{header|Scala}}==
<langsyntaxhighlight lang="scala">package permutationsRep
 
object PermutationsRepTest extends Application {
Line 1,671 ⟶ 2,684:
}
println(permutationsWithRepetitions(List(1, 2, 3), 2))
}</langsyntaxhighlight>
{{out}}
<pre>
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))
</pre>
 
=={{header|Sidef}}==
<syntaxhighlight lang="ruby">var k = %w(a b c)
var n = 2
 
cartesian([k] * n, {|*a| say a.join(' ') })</syntaxhighlight>
{{out}}
<pre>
a a
a b
a c
b a
b b
b c
c a
c b
c c
</pre>
 
=={{header|Standard ML}}==
{{trans|Erlang}}
<syntaxhighlight lang="sml">
fun multiperms [] _ = [[]]
| multiperms _ 0 = [[]]
| multiperms xs n =
let
val rest = multiperms xs (n-1)
in
List.concat (List.map (fn a => (List.map (fn b => a::b) rest)) xs)
end
</syntaxhighlight>
 
=={{header|Tcl}}==
===Iterative version===
{{trans|PHP}}
<langsyntaxhighlight lang="tcl">
proc permutate {values size offset} {
set count [llength $values]
Line 1,703 ⟶ 2,747:
# Usage
permutations [list 1 2 3 4] 3
</syntaxhighlight>
</lang>
 
===Version without additional libraries===
{{works with|Tcl|8.6}}
{{trans|Scala}}
<langsyntaxhighlight lang="tcl">package require Tcl 8.6
 
# Utility function to make procedures that define generators
Line 1,737 ⟶ 2,781:
# Demonstrate usage
set g [permutationsWithRepetitions {1 2 3} 2]
while 1 {puts [$g]}</langsyntaxhighlight>
===Alternate version with extra library package===
{{tcllib|generator}}
{{works with|Tcl|8.6}}
<langsyntaxhighlight lang="tcl">package require Tcl 8.6
package require generator
 
Line 1,764 ⟶ 2,808:
generator foreach val [permutationsWithRepetitions {1 2 3} 2] {
puts $val
}</langsyntaxhighlight>
 
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="wren">var n = 3
var values = ["A", "B", "C", "D"]
var k = values.count
 
// terminate when first two characters of the permutation are 'B' and 'C' respectively
var decide = Fn.new { |pc| pc[0] == "B" && pc[1] == "C" }
 
var pn = List.filled(n, 0)
var pc = List.filled(n, null)
while (true) {
// generate permutation
var i = 0
for (x in pn) {
pc[i] = values[x]
i = i + 1
}
// show progress
System.print(pc)
// pass to deciding function
if (decide.call(pc)) return // terminate early
// increment permutation number
i = 0
while (true) {
pn[i] = pn[i] + 1
if (pn[i] < k) break
pn[i] = 0
i = i + 1
if (i == n) return // all permutations generated
}
}</syntaxhighlight>
 
{{out}}
<pre>
[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]
</pre>
 
=={{header|XPL0}}==
{{trans|Wren}}
<syntaxhighlight lang "XPL0">func Decide(PC);
\Terminate when first two characters of permutation are 'B' and 'C' respectively
int PC;
return PC(0)=^B & PC(1)=^C;
 
def N=3, K=4;
int Values, PN(N), PC(N), I, X;
[Values:= [^A, ^B, ^C, ^D];
for I:= 0 to N-1 do PN(I):= 0;
loop [for I:= 0 to N-1 do
[X:= PN(I);
PC(I):= Values(X);
];
ChOut(0, ^[); \show progress
for I:= 0 to N-1 do
[if I # 0 then Text(0, ", "); ChOut(0, PC(I))];
ChOut(0, ^]); CrLf(0);
\pass to deciding function
if Decide(PC) then return; \terminate early
I:= 0; \increment permutation number
loop [PN(I):= PN(I)+1;
if PN(I) < K then quit;
PN(I):= 0;
I:= I+1;
if I = N then return; \all permutations generated
];
];
]</syntaxhighlight>
{{out}}
<pre>
[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]
</pre>
Myrmidon
23

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/230059...362215"