How to generate all commutative pairings of list elements?Finding all elements within a certain range in a...
Is the term 'open source' a trademark?
How do governments keep track of their issued currency?
Payment instructions allegedly from HomeAway look fishy to me
Why is one of Madera Municipal's runways labelled with only "R" on both sides?
Can anyone identify this tank?
How to retract an idea already pitched to an employer?
Movie about a boy who was born old and grew young
Arriving at the same result with the opposite hypotheses
What can I, as a user, do about offensive reviews in App Store?
Should an arbiter claim draw at a K+R vs K+R endgame?
What's the largest optical telescope mirror ever put in space?
Russian equivalents of "no love lost"
Using a special key in function
Were Alexander the Great and Hephaestion lovers?
Genetic limitations to learn certain instruments
Does Disney no longer produce hand-drawn cartoon films?
Find the Factorial From the Given Prime Relationship
Which comes first? Multiple Imputation, Splitting into train/test, or Standardization/Normalization
What is the actual quality of machine translations?
Why doesn’t a normal window produce an apparent rainbow?
Watts vs. Volt Amps
How to tell your grandparent to not come to fetch you with their car?
How to generate all commutative pairings of list elements?
Can a black dragonborn's acid breath weapon destroy objects?
How to generate all commutative pairings of list elements?
Finding all elements within a certain range in a sorted listGenerating a non-convex polyhedron from a list of vertex coordinatesGenerating an ordered list of pairs of elements from ordered listsMining for matching elements of sets with equal divisorsWay to generate all multisetsHow to identify all the connected vertices from a list of coordinate pairs?Given list of associations, generate a list of all common associationsHow to generate all involutive permutations?
$begingroup$
Given a list with an even number of elements, e.g.
list = RandomSample[Array[e, 20]];
how can one generate a list of all different commutative pairings of the elements most efficiently in Mathematica?
A tiny example is:
list = {e[1],e[4],e[3],e[2]};
pairings[list]
{
{ {e[1],e[2]} , {e[3],e[4]} } ,
{ {e[1],e[3]} , {e[2],e[4]} } ,
{ {e[1],e[4]} , {e[2],e[3]} } ,
}
Note how the commutativity of the pairings sets e.g. {e[1],e[2]} and {e[2],e[1]} to be the same pair, so that only one such term is generated.
EDIT:
Alternatively, one can ask this question in terms of graphs:
How to generate all distinct sets of disconnected un-directed edges from a list of vertices most efficiently?
list-manipulation function-construction
edited 1 hour ago
user64494
3,92111323
asked 9 hours ago
KagaratschKagaratsch
5,25141351
$endgroup$
|
show 6 more comments
$begingroup$
Given a list with an even number of elements, e.g.
list = RandomSample[Array[e, 20]];
how can one generate a list of all different commutative pairings of the elements most efficiently in Mathematica?
A tiny example is:
list = {e[1],e[4],e[3],e[2]};
pairings[list]
{
{ {e[1],e[2]} , {e[3],e[4]} } ,
{ {e[1],e[3]} , {e[2],e[4]} } ,
{ {e[1],e[4]} , {e[2],e[3]} } ,
}
Note how the commutativity of the pairings sets e.g. {e[1],e[2]} and {e[2],e[1]} to be the same pair, so that only one such term is generated.
EDIT:
Alternatively, one can ask this question in terms of graphs:
How to generate all distinct sets of disconnected un-directed edges from a list of vertices most efficiently?
list-manipulation function-construction
edited 1 hour ago
user64494
3,92111323
asked 9 hours ago
KagaratschKagaratsch
5,25141351
$endgroup$
$begingroup$
Subsets[list, {2}]?
$endgroup$
– Christopher Lamb
9 hours ago
$begingroup$
@ChristopherLamb This creates a list of all possible pairs. But starting with a list of2nelements, we are looking for a list of groups ofnpairs instead.
$endgroup$
– Kagaratsch
9 hours ago
2
$begingroup$
@Kagaratsch partition[l_, v_, comp_] := Flatten /@ Reap [ Scan [ Which[ comp[ v, #], Sow[#, -1], comp[v, #], Sow[#, 1], True, Sow[#,0]]&,l], {-1,0,1}][[2]] (* Three way partition function using and ordering function by sowing values with tags -1,0, or 1, depending on a relation. You could build up a list by specifying tags with Sow and patterns that match those tags in Reap. If you build the list piece by piece with recursion I would not recommend using Append instead an approach using Reap and Sow could be more effective to collect intermediate results*)
$endgroup$
– Schopenhauer
4 hours ago
1
$begingroup$
@Kagaratsch I’ve seen programs that use Fold as alternative to recursion. g[{}] = x; g[l_] = f[First[l], g[Rest[l]]; could be translated to g[l_]= Fold[f[#1,#2]&, x,l].
$endgroup$
– Schopenhauer
4 hours ago
2
$begingroup$
@Kagaratsch I would also check the ??Developer`* and ??Experimental`* contexts for hidden gems like PartitionMap.
$endgroup$
– Schopenhauer
4 hours ago
|
show 6 more comments
$begingroup$
Given a list with an even number of elements, e.g.
list = RandomSample[Array[e, 20]];
how can one generate a list of all different commutative pairings of the elements most efficiently in Mathematica?
A tiny example is:
list = {e[1],e[4],e[3],e[2]};
pairings[list]
{
{ {e[1],e[2]} , {e[3],e[4]} } ,
{ {e[1],e[3]} , {e[2],e[4]} } ,
{ {e[1],e[4]} , {e[2],e[3]} } ,
}
Note how the commutativity of the pairings sets e.g. {e[1],e[2]} and {e[2],e[1]} to be the same pair, so that only one such term is generated.
EDIT:
Alternatively, one can ask this question in terms of graphs:
How to generate all distinct sets of disconnected un-directed edges from a list of vertices most efficiently?
list-manipulation function-construction
edited 1 hour ago
user64494
3,92111323
asked 9 hours ago
KagaratschKagaratsch
5,25141351
$endgroup$
Given a list with an even number of elements, e.g.
list = RandomSample[Array[e, 20]];
how can one generate a list of all different commutative pairings of the elements most efficiently in Mathematica?
A tiny example is:
list = {e[1],e[4],e[3],e[2]};
pairings[list]
{
{ {e[1],e[2]} , {e[3],e[4]} } ,
{ {e[1],e[3]} , {e[2],e[4]} } ,
{ {e[1],e[4]} , {e[2],e[3]} } ,
}
Note how the commutativity of the pairings sets e.g. {e[1],e[2]} and {e[2],e[1]} to be the same pair, so that only one such term is generated.
EDIT:
Alternatively, one can ask this question in terms of graphs:
How to generate all distinct sets of disconnected un-directed edges from a list of vertices most efficiently?
list-manipulation function-construction
list-manipulation function-construction
edited 1 hour ago
user64494
3,92111323
asked 9 hours ago
KagaratschKagaratsch
5,25141351
edited 1 hour ago
user64494
3,92111323
asked 9 hours ago
KagaratschKagaratsch
5,25141351
edited 1 hour ago
user64494
3,92111323
edited 1 hour ago
user64494
3,92111323
edited 1 hour ago
user64494
3,92111323
3,92111323
asked 9 hours ago
KagaratschKagaratsch
5,25141351
asked 9 hours ago
KagaratschKagaratsch
5,25141351
asked 9 hours ago
KagaratschKagaratsch
5,25141351
5,25141351
$begingroup$
Subsets[list, {2}]?
$endgroup$
– Christopher Lamb
9 hours ago
$begingroup$
@ChristopherLamb This creates a list of all possible pairs. But starting with a list of2nelements, we are looking for a list of groups ofnpairs instead.
$endgroup$
– Kagaratsch
9 hours ago
2
$begingroup$
@Kagaratsch partition[l_, v_, comp_] := Flatten /@ Reap [ Scan [ Which[ comp[ v, #], Sow[#, -1], comp[v, #], Sow[#, 1], True, Sow[#,0]]&,l], {-1,0,1}][[2]] (* Three way partition function using and ordering function by sowing values with tags -1,0, or 1, depending on a relation. You could build up a list by specifying tags with Sow and patterns that match those tags in Reap. If you build the list piece by piece with recursion I would not recommend using Append instead an approach using Reap and Sow could be more effective to collect intermediate results*)
$endgroup$
– Schopenhauer
4 hours ago
1
$begingroup$
@Kagaratsch I’ve seen programs that use Fold as alternative to recursion. g[{}] = x; g[l_] = f[First[l], g[Rest[l]]; could be translated to g[l_]= Fold[f[#1,#2]&, x,l].
$endgroup$
– Schopenhauer
4 hours ago
2
$begingroup$
@Kagaratsch I would also check the ??Developer`* and ??Experimental`* contexts for hidden gems like PartitionMap.
$endgroup$
– Schopenhauer
4 hours ago
|
show 6 more comments
$begingroup$
Subsets[list, {2}]?
$endgroup$
– Christopher Lamb
9 hours ago
$begingroup$
@ChristopherLamb This creates a list of all possible pairs. But starting with a list of2nelements, we are looking for a list of groups ofnpairs instead.
$endgroup$
– Kagaratsch
9 hours ago
2
$begingroup$
@Kagaratsch partition[l_, v_, comp_] := Flatten /@ Reap [ Scan [ Which[ comp[ v, #], Sow[#, -1], comp[v, #], Sow[#, 1], True, Sow[#,0]]&,l], {-1,0,1}][[2]] (* Three way partition function using and ordering function by sowing values with tags -1,0, or 1, depending on a relation. You could build up a list by specifying tags with Sow and patterns that match those tags in Reap. If you build the list piece by piece with recursion I would not recommend using Append instead an approach using Reap and Sow could be more effective to collect intermediate results*)
$endgroup$
– Schopenhauer
4 hours ago
1
$begingroup$
@Kagaratsch I’ve seen programs that use Fold as alternative to recursion. g[{}] = x; g[l_] = f[First[l], g[Rest[l]]; could be translated to g[l_]= Fold[f[#1,#2]&, x,l].
$endgroup$
– Schopenhauer
4 hours ago
2
$begingroup$
@Kagaratsch I would also check the ??Developer`* and ??Experimental`* contexts for hidden gems like PartitionMap.
$endgroup$
– Schopenhauer
4 hours ago
$begingroup$
Subsets[list, {2}] ?$endgroup$
– Christopher Lamb
9 hours ago
$begingroup$
Subsets[list, {2}] ?$endgroup$
– Christopher Lamb
9 hours ago
$begingroup$
@ChristopherLamb This creates a list of all possible pairs. But starting with a list of
2n elements, we are looking for a list of groups of n pairs instead.$endgroup$
– Kagaratsch
9 hours ago
$begingroup$
@ChristopherLamb This creates a list of all possible pairs. But starting with a list of
2n elements, we are looking for a list of groups of n pairs instead.$endgroup$
– Kagaratsch
9 hours ago
2
2
$begingroup$
@Kagaratsch partition[l_, v_, comp_] := Flatten /@ Reap [ Scan [ Which[ comp[ v, #], Sow[#, -1], comp[v, #], Sow[#, 1], True, Sow[#,0]]&,l], {-1,0,1}][[2]] (* Three way partition function using and ordering function by sowing values with tags -1,0, or 1, depending on a relation. You could build up a list by specifying tags with Sow and patterns that match those tags in Reap. If you build the list piece by piece with recursion I would not recommend using Append instead an approach using Reap and Sow could be more effective to collect intermediate results*)
$endgroup$
– Schopenhauer
4 hours ago
$begingroup$
@Kagaratsch partition[l_, v_, comp_] := Flatten /@ Reap [ Scan [ Which[ comp[ v, #], Sow[#, -1], comp[v, #], Sow[#, 1], True, Sow[#,0]]&,l], {-1,0,1}][[2]] (* Three way partition function using and ordering function by sowing values with tags -1,0, or 1, depending on a relation. You could build up a list by specifying tags with Sow and patterns that match those tags in Reap. If you build the list piece by piece with recursion I would not recommend using Append instead an approach using Reap and Sow could be more effective to collect intermediate results*)
$endgroup$
– Schopenhauer
4 hours ago
1
1
$begingroup$
@Kagaratsch I’ve seen programs that use Fold as alternative to recursion. g[{}] = x; g[l_] = f[First[l], g[Rest[l]]; could be translated to g[l_]= Fold[f[#1,#2]&, x,l].
$endgroup$
– Schopenhauer
4 hours ago
$begingroup$
@Kagaratsch I’ve seen programs that use Fold as alternative to recursion. g[{}] = x; g[l_] = f[First[l], g[Rest[l]]; could be translated to g[l_]= Fold[f[#1,#2]&, x,l].
$endgroup$
– Schopenhauer
4 hours ago
2
2
$begingroup$
@Kagaratsch I would also check the ??Developer`* and ??Experimental`* contexts for hidden gems like PartitionMap.
$endgroup$
– Schopenhauer
4 hours ago
$begingroup$
@Kagaratsch I would also check the ??Developer`* and ??Experimental`* contexts for hidden gems like PartitionMap.
$endgroup$
– Schopenhauer
4 hours ago
|
show 6 more comments
3 Answers
3
active
oldest
votes
$begingroup$
I think the number of such pairings is given by:
pairCounts[n_?EvenQ] := Multinomial @@ ConstantArray[2, n/2]/(n/2)!
So, you will get:
pairCounts[20]
654729075
which is a lot of pairings for a list of length 20. What do you plan to do with this list?
At any rate, here is a not very efficient method:
partitions[{a_,b_}] := {{{a,b}}}
partitions[{a_,b__}] := Catenate@Table[
Prepend[{a, {b}[[i]]}] /@ partitions[Delete[{b}, i]],
{i, Length[{b}]}
]
For example:
partitions[Range[4]]
partitions[Range[6]]
{{{1, 2}, {3, 4}}, {{1, 3}, {2, 4}}, {{1, 4}, {2, 3}}}
{{{1, 2}, {3, 4}, {5, 6}}, {{1, 2}, {3, 5}, {4, 6}}, {{1, 2}, {3, 6}, {4,
5}}, {{1, 3}, {2, 4}, {5, 6}}, {{1, 3}, {2, 5}, {4, 6}}, {{1, 3}, {2,
6}, {4, 5}}, {{1, 4}, {2, 3}, {5, 6}}, {{1, 4}, {2, 5}, {3, 6}}, {{1,
4}, {2, 6}, {3, 5}}, {{1, 5}, {2, 3}, {4, 6}}, {{1, 5}, {2, 4}, {3,
6}}, {{1, 5}, {2, 6}, {3, 4}}, {{1, 6}, {2, 3}, {4, 5}}, {{1, 6}, {2,
4}, {3, 5}}, {{1, 6}, {2, 5}, {3, 4}}}
answered 8 hours ago
Carl WollCarl Woll
82.2k3105212
$endgroup$
$begingroup$
Thanks, this one is quicker than the one I could write! I plan to collapse some of the vertices to obtain connected graphs and determine their multiplicity.
$endgroup$
– Kagaratsch
8 hours ago
$begingroup$
By the waypairCounts[n_?EvenQ] := (n-1)!!
$endgroup$
– Kagaratsch
7 hours ago
add a comment |
$begingroup$
Here a recursive solution, which I suspect is similar to the one by Carl Woll:
pairings[list_, progress_] := Block[{},
If[Length[list] > 1,
Flatten[
Table[
pairings[Drop[list[[2 ;;]], {i - 1}],
Append[progress, {list[[1]], list[[i]]}]]
, {i, 2, Length[list]}]
, 1]
,
p[progress]
]
]
With outputs
pairings[Range[4], {}]
{p[{{1, 2}, {3, 4}}], p[{{1, 3}, {2, 4}}], p[{{1, 4}, {2, 3}}]}
and
pairings[Range[6], {}]
{p[{{1, 2}, {3, 4}, {5, 6}}], p[{{1, 2}, {3, 5}, {4, 6}}],
p[{{1, 2}, {3, 6}, {4, 5}}], p[{{1, 3}, {2, 4}, {5, 6}}],
p[{{1, 3}, {2, 5}, {4, 6}}], p[{{1, 3}, {2, 6}, {4, 5}}],
p[{{1, 4}, {2, 3}, {5, 6}}], p[{{1, 4}, {2, 5}, {3, 6}}],
p[{{1, 4}, {2, 6}, {3, 5}}], p[{{1, 5}, {2, 3}, {4, 6}}],
p[{{1, 5}, {2, 4}, {3, 6}}], p[{{1, 5}, {2, 6}, {3, 4}}],
p[{{1, 6}, {2, 3}, {4, 5}}], p[{{1, 6}, {2, 4}, {3, 5}}],
p[{{1, 6}, {2, 5}, {3, 4}}]}
Turns out, this one is a bit slower than partitions by Carl Woll:
pairings[Range[14], {}] // Length // AbsoluteTiming
{1.91637, 135135}
partitions[Range[14]] // Length // AbsoluteTiming
{1.1277, 135135}
answered 8 hours ago
KagaratschKagaratsch
5,25141351
$endgroup$
add a comment |
$begingroup$
How is it that the comment by @ChristopherLamb is incorrect? Sets are order independent, so I would think this creates "commutative pairs."
set = Table[e[n], {n, 4}]
(* {e[1],e[2],e[3],e[4]} *)
Subsets[set, {2}]
(* {{e[1],e[2]},{e[1],e[3]},{e[1],e[4]},{e[2],e[3]},{e[2],e[4]},{e[3],e[4]}} *)
answered 9 hours ago
David KeithDavid Keith
2,1801516
$endgroup$
$begingroup$
This output is missing a dimension in the list, which would partition this set of pairs into groups of pairs in which all elements show up exactly once. Also note that some edges will exist more than once within these groups when list dimension is larger than4.
$endgroup$
– Kagaratsch
8 hours ago
add a comment |
Your Answer
StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "387"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});
function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: false,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: null,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});
}
});
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f199665%2fhow-to-generate-all-commutative-pairings-of-list-elements%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
3 Answers
3
active
oldest
votes
3 Answers
3
active
oldest
votes
active
oldest
votes
active
oldest
votes
$begingroup$
I think the number of such pairings is given by:
pairCounts[n_?EvenQ] := Multinomial @@ ConstantArray[2, n/2]/(n/2)!
So, you will get:
pairCounts[20]
654729075
which is a lot of pairings for a list of length 20. What do you plan to do with this list?
At any rate, here is a not very efficient method:
partitions[{a_,b_}] := {{{a,b}}}
partitions[{a_,b__}] := Catenate@Table[
Prepend[{a, {b}[[i]]}] /@ partitions[Delete[{b}, i]],
{i, Length[{b}]}
]
For example:
partitions[Range[4]]
partitions[Range[6]]
{{{1, 2}, {3, 4}}, {{1, 3}, {2, 4}}, {{1, 4}, {2, 3}}}
{{{1, 2}, {3, 4}, {5, 6}}, {{1, 2}, {3, 5}, {4, 6}}, {{1, 2}, {3, 6}, {4,
5}}, {{1, 3}, {2, 4}, {5, 6}}, {{1, 3}, {2, 5}, {4, 6}}, {{1, 3}, {2,
6}, {4, 5}}, {{1, 4}, {2, 3}, {5, 6}}, {{1, 4}, {2, 5}, {3, 6}}, {{1,
4}, {2, 6}, {3, 5}}, {{1, 5}, {2, 3}, {4, 6}}, {{1, 5}, {2, 4}, {3,
6}}, {{1, 5}, {2, 6}, {3, 4}}, {{1, 6}, {2, 3}, {4, 5}}, {{1, 6}, {2,
4}, {3, 5}}, {{1, 6}, {2, 5}, {3, 4}}}
answered 8 hours ago
Carl WollCarl Woll
82.2k3105212
$endgroup$
$begingroup$
Thanks, this one is quicker than the one I could write! I plan to collapse some of the vertices to obtain connected graphs and determine their multiplicity.
$endgroup$
– Kagaratsch
8 hours ago
$begingroup$
By the waypairCounts[n_?EvenQ] := (n-1)!!
$endgroup$
– Kagaratsch
7 hours ago
add a comment |
$begingroup$
I think the number of such pairings is given by:
pairCounts[n_?EvenQ] := Multinomial @@ ConstantArray[2, n/2]/(n/2)!
So, you will get:
pairCounts[20]
654729075
which is a lot of pairings for a list of length 20. What do you plan to do with this list?
At any rate, here is a not very efficient method:
partitions[{a_,b_}] := {{{a,b}}}
partitions[{a_,b__}] := Catenate@Table[
Prepend[{a, {b}[[i]]}] /@ partitions[Delete[{b}, i]],
{i, Length[{b}]}
]
For example:
partitions[Range[4]]
partitions[Range[6]]
{{{1, 2}, {3, 4}}, {{1, 3}, {2, 4}}, {{1, 4}, {2, 3}}}
{{{1, 2}, {3, 4}, {5, 6}}, {{1, 2}, {3, 5}, {4, 6}}, {{1, 2}, {3, 6}, {4,
5}}, {{1, 3}, {2, 4}, {5, 6}}, {{1, 3}, {2, 5}, {4, 6}}, {{1, 3}, {2,
6}, {4, 5}}, {{1, 4}, {2, 3}, {5, 6}}, {{1, 4}, {2, 5}, {3, 6}}, {{1,
4}, {2, 6}, {3, 5}}, {{1, 5}, {2, 3}, {4, 6}}, {{1, 5}, {2, 4}, {3,
6}}, {{1, 5}, {2, 6}, {3, 4}}, {{1, 6}, {2, 3}, {4, 5}}, {{1, 6}, {2,
4}, {3, 5}}, {{1, 6}, {2, 5}, {3, 4}}}
answered 8 hours ago
Carl WollCarl Woll
82.2k3105212
$endgroup$
$begingroup$
Thanks, this one is quicker than the one I could write! I plan to collapse some of the vertices to obtain connected graphs and determine their multiplicity.
$endgroup$
– Kagaratsch
8 hours ago
$begingroup$
By the waypairCounts[n_?EvenQ] := (n-1)!!
$endgroup$
– Kagaratsch
7 hours ago
add a comment |
$begingroup$
I think the number of such pairings is given by:
pairCounts[n_?EvenQ] := Multinomial @@ ConstantArray[2, n/2]/(n/2)!
So, you will get:
pairCounts[20]
654729075
which is a lot of pairings for a list of length 20. What do you plan to do with this list?
At any rate, here is a not very efficient method:
partitions[{a_,b_}] := {{{a,b}}}
partitions[{a_,b__}] := Catenate@Table[
Prepend[{a, {b}[[i]]}] /@ partitions[Delete[{b}, i]],
{i, Length[{b}]}
]
For example:
partitions[Range[4]]
partitions[Range[6]]
{{{1, 2}, {3, 4}}, {{1, 3}, {2, 4}}, {{1, 4}, {2, 3}}}
{{{1, 2}, {3, 4}, {5, 6}}, {{1, 2}, {3, 5}, {4, 6}}, {{1, 2}, {3, 6}, {4,
5}}, {{1, 3}, {2, 4}, {5, 6}}, {{1, 3}, {2, 5}, {4, 6}}, {{1, 3}, {2,
6}, {4, 5}}, {{1, 4}, {2, 3}, {5, 6}}, {{1, 4}, {2, 5}, {3, 6}}, {{1,
4}, {2, 6}, {3, 5}}, {{1, 5}, {2, 3}, {4, 6}}, {{1, 5}, {2, 4}, {3,
6}}, {{1, 5}, {2, 6}, {3, 4}}, {{1, 6}, {2, 3}, {4, 5}}, {{1, 6}, {2,
4}, {3, 5}}, {{1, 6}, {2, 5}, {3, 4}}}
answered 8 hours ago
Carl WollCarl Woll
82.2k3105212
$endgroup$
I think the number of such pairings is given by:
pairCounts[n_?EvenQ] := Multinomial @@ ConstantArray[2, n/2]/(n/2)!
So, you will get:
pairCounts[20]
654729075
which is a lot of pairings for a list of length 20. What do you plan to do with this list?
At any rate, here is a not very efficient method:
partitions[{a_,b_}] := {{{a,b}}}
partitions[{a_,b__}] := Catenate@Table[
Prepend[{a, {b}[[i]]}] /@ partitions[Delete[{b}, i]],
{i, Length[{b}]}
]
For example:
partitions[Range[4]]
partitions[Range[6]]
{{{1, 2}, {3, 4}}, {{1, 3}, {2, 4}}, {{1, 4}, {2, 3}}}
{{{1, 2}, {3, 4}, {5, 6}}, {{1, 2}, {3, 5}, {4, 6}}, {{1, 2}, {3, 6}, {4,
5}}, {{1, 3}, {2, 4}, {5, 6}}, {{1, 3}, {2, 5}, {4, 6}}, {{1, 3}, {2,
6}, {4, 5}}, {{1, 4}, {2, 3}, {5, 6}}, {{1, 4}, {2, 5}, {3, 6}}, {{1,
4}, {2, 6}, {3, 5}}, {{1, 5}, {2, 3}, {4, 6}}, {{1, 5}, {2, 4}, {3,
6}}, {{1, 5}, {2, 6}, {3, 4}}, {{1, 6}, {2, 3}, {4, 5}}, {{1, 6}, {2,
4}, {3, 5}}, {{1, 6}, {2, 5}, {3, 4}}}
answered 8 hours ago
Carl WollCarl Woll
82.2k3105212
answered 8 hours ago
Carl WollCarl Woll
82.2k3105212
answered 8 hours ago
Carl WollCarl Woll
82.2k3105212
answered 8 hours ago
Carl WollCarl Woll
82.2k3105212
82.2k3105212
$begingroup$
Thanks, this one is quicker than the one I could write! I plan to collapse some of the vertices to obtain connected graphs and determine their multiplicity.
$endgroup$
– Kagaratsch
8 hours ago
$begingroup$
By the waypairCounts[n_?EvenQ] := (n-1)!!
$endgroup$
– Kagaratsch
7 hours ago
add a comment |
$begingroup$
Thanks, this one is quicker than the one I could write! I plan to collapse some of the vertices to obtain connected graphs and determine their multiplicity.
$endgroup$
– Kagaratsch
8 hours ago
$begingroup$
By the waypairCounts[n_?EvenQ] := (n-1)!!
$endgroup$
– Kagaratsch
7 hours ago
$begingroup$
Thanks, this one is quicker than the one I could write! I plan to collapse some of the vertices to obtain connected graphs and determine their multiplicity.
$endgroup$
– Kagaratsch
8 hours ago
$begingroup$
Thanks, this one is quicker than the one I could write! I plan to collapse some of the vertices to obtain connected graphs and determine their multiplicity.
$endgroup$
– Kagaratsch
8 hours ago
$begingroup$
By the way
pairCounts[n_?EvenQ] := (n-1)!!$endgroup$
– Kagaratsch
7 hours ago
$begingroup$
By the way
pairCounts[n_?EvenQ] := (n-1)!!$endgroup$
– Kagaratsch
7 hours ago
add a comment |
$begingroup$
Here a recursive solution, which I suspect is similar to the one by Carl Woll:
pairings[list_, progress_] := Block[{},
If[Length[list] > 1,
Flatten[
Table[
pairings[Drop[list[[2 ;;]], {i - 1}],
Append[progress, {list[[1]], list[[i]]}]]
, {i, 2, Length[list]}]
, 1]
,
p[progress]
]
]
With outputs
pairings[Range[4], {}]
{p[{{1, 2}, {3, 4}}], p[{{1, 3}, {2, 4}}], p[{{1, 4}, {2, 3}}]}
and
pairings[Range[6], {}]
{p[{{1, 2}, {3, 4}, {5, 6}}], p[{{1, 2}, {3, 5}, {4, 6}}],
p[{{1, 2}, {3, 6}, {4, 5}}], p[{{1, 3}, {2, 4}, {5, 6}}],
p[{{1, 3}, {2, 5}, {4, 6}}], p[{{1, 3}, {2, 6}, {4, 5}}],
p[{{1, 4}, {2, 3}, {5, 6}}], p[{{1, 4}, {2, 5}, {3, 6}}],
p[{{1, 4}, {2, 6}, {3, 5}}], p[{{1, 5}, {2, 3}, {4, 6}}],
p[{{1, 5}, {2, 4}, {3, 6}}], p[{{1, 5}, {2, 6}, {3, 4}}],
p[{{1, 6}, {2, 3}, {4, 5}}], p[{{1, 6}, {2, 4}, {3, 5}}],
p[{{1, 6}, {2, 5}, {3, 4}}]}
Turns out, this one is a bit slower than partitions by Carl Woll:
pairings[Range[14], {}] // Length // AbsoluteTiming
{1.91637, 135135}
partitions[Range[14]] // Length // AbsoluteTiming
{1.1277, 135135}
answered 8 hours ago
KagaratschKagaratsch
5,25141351
$endgroup$
add a comment |
$begingroup$
Here a recursive solution, which I suspect is similar to the one by Carl Woll:
pairings[list_, progress_] := Block[{},
If[Length[list] > 1,
Flatten[
Table[
pairings[Drop[list[[2 ;;]], {i - 1}],
Append[progress, {list[[1]], list[[i]]}]]
, {i, 2, Length[list]}]
, 1]
,
p[progress]
]
]
With outputs
pairings[Range[4], {}]
{p[{{1, 2}, {3, 4}}], p[{{1, 3}, {2, 4}}], p[{{1, 4}, {2, 3}}]}
and
pairings[Range[6], {}]
{p[{{1, 2}, {3, 4}, {5, 6}}], p[{{1, 2}, {3, 5}, {4, 6}}],
p[{{1, 2}, {3, 6}, {4, 5}}], p[{{1, 3}, {2, 4}, {5, 6}}],
p[{{1, 3}, {2, 5}, {4, 6}}], p[{{1, 3}, {2, 6}, {4, 5}}],
p[{{1, 4}, {2, 3}, {5, 6}}], p[{{1, 4}, {2, 5}, {3, 6}}],
p[{{1, 4}, {2, 6}, {3, 5}}], p[{{1, 5}, {2, 3}, {4, 6}}],
p[{{1, 5}, {2, 4}, {3, 6}}], p[{{1, 5}, {2, 6}, {3, 4}}],
p[{{1, 6}, {2, 3}, {4, 5}}], p[{{1, 6}, {2, 4}, {3, 5}}],
p[{{1, 6}, {2, 5}, {3, 4}}]}
Turns out, this one is a bit slower than partitions by Carl Woll:
pairings[Range[14], {}] // Length // AbsoluteTiming
{1.91637, 135135}
partitions[Range[14]] // Length // AbsoluteTiming
{1.1277, 135135}
answered 8 hours ago
KagaratschKagaratsch
5,25141351
$endgroup$
add a comment |
$begingroup$
Here a recursive solution, which I suspect is similar to the one by Carl Woll:
pairings[list_, progress_] := Block[{},
If[Length[list] > 1,
Flatten[
Table[
pairings[Drop[list[[2 ;;]], {i - 1}],
Append[progress, {list[[1]], list[[i]]}]]
, {i, 2, Length[list]}]
, 1]
,
p[progress]
]
]
With outputs
pairings[Range[4], {}]
{p[{{1, 2}, {3, 4}}], p[{{1, 3}, {2, 4}}], p[{{1, 4}, {2, 3}}]}
and
pairings[Range[6], {}]
{p[{{1, 2}, {3, 4}, {5, 6}}], p[{{1, 2}, {3, 5}, {4, 6}}],
p[{{1, 2}, {3, 6}, {4, 5}}], p[{{1, 3}, {2, 4}, {5, 6}}],
p[{{1, 3}, {2, 5}, {4, 6}}], p[{{1, 3}, {2, 6}, {4, 5}}],
p[{{1, 4}, {2, 3}, {5, 6}}], p[{{1, 4}, {2, 5}, {3, 6}}],
p[{{1, 4}, {2, 6}, {3, 5}}], p[{{1, 5}, {2, 3}, {4, 6}}],
p[{{1, 5}, {2, 4}, {3, 6}}], p[{{1, 5}, {2, 6}, {3, 4}}],
p[{{1, 6}, {2, 3}, {4, 5}}], p[{{1, 6}, {2, 4}, {3, 5}}],
p[{{1, 6}, {2, 5}, {3, 4}}]}
Turns out, this one is a bit slower than partitions by Carl Woll:
pairings[Range[14], {}] // Length // AbsoluteTiming
{1.91637, 135135}
partitions[Range[14]] // Length // AbsoluteTiming
{1.1277, 135135}
answered 8 hours ago
KagaratschKagaratsch
5,25141351
$endgroup$
Here a recursive solution, which I suspect is similar to the one by Carl Woll:
pairings[list_, progress_] := Block[{},
If[Length[list] > 1,
Flatten[
Table[
pairings[Drop[list[[2 ;;]], {i - 1}],
Append[progress, {list[[1]], list[[i]]}]]
, {i, 2, Length[list]}]
, 1]
,
p[progress]
]
]
With outputs
pairings[Range[4], {}]
{p[{{1, 2}, {3, 4}}], p[{{1, 3}, {2, 4}}], p[{{1, 4}, {2, 3}}]}
and
pairings[Range[6], {}]
{p[{{1, 2}, {3, 4}, {5, 6}}], p[{{1, 2}, {3, 5}, {4, 6}}],
p[{{1, 2}, {3, 6}, {4, 5}}], p[{{1, 3}, {2, 4}, {5, 6}}],
p[{{1, 3}, {2, 5}, {4, 6}}], p[{{1, 3}, {2, 6}, {4, 5}}],
p[{{1, 4}, {2, 3}, {5, 6}}], p[{{1, 4}, {2, 5}, {3, 6}}],
p[{{1, 4}, {2, 6}, {3, 5}}], p[{{1, 5}, {2, 3}, {4, 6}}],
p[{{1, 5}, {2, 4}, {3, 6}}], p[{{1, 5}, {2, 6}, {3, 4}}],
p[{{1, 6}, {2, 3}, {4, 5}}], p[{{1, 6}, {2, 4}, {3, 5}}],
p[{{1, 6}, {2, 5}, {3, 4}}]}
Turns out, this one is a bit slower than partitions by Carl Woll:
pairings[Range[14], {}] // Length // AbsoluteTiming
{1.91637, 135135}
partitions[Range[14]] // Length // AbsoluteTiming
{1.1277, 135135}
answered 8 hours ago
KagaratschKagaratsch
5,25141351
edited 7 hours ago
answered 8 hours ago
KagaratschKagaratsch
5,25141351
answered 8 hours ago
KagaratschKagaratsch
5,25141351
answered 8 hours ago
KagaratschKagaratsch
5,25141351
5,25141351
add a comment |
add a comment |
$begingroup$
How is it that the comment by @ChristopherLamb is incorrect? Sets are order independent, so I would think this creates "commutative pairs."
set = Table[e[n], {n, 4}]
(* {e[1],e[2],e[3],e[4]} *)
Subsets[set, {2}]
(* {{e[1],e[2]},{e[1],e[3]},{e[1],e[4]},{e[2],e[3]},{e[2],e[4]},{e[3],e[4]}} *)
answered 9 hours ago
David KeithDavid Keith
2,1801516
$endgroup$
$begingroup$
This output is missing a dimension in the list, which would partition this set of pairs into groups of pairs in which all elements show up exactly once. Also note that some edges will exist more than once within these groups when list dimension is larger than4.
$endgroup$
– Kagaratsch
8 hours ago
add a comment |
$begingroup$
How is it that the comment by @ChristopherLamb is incorrect? Sets are order independent, so I would think this creates "commutative pairs."
set = Table[e[n], {n, 4}]
(* {e[1],e[2],e[3],e[4]} *)
Subsets[set, {2}]
(* {{e[1],e[2]},{e[1],e[3]},{e[1],e[4]},{e[2],e[3]},{e[2],e[4]},{e[3],e[4]}} *)
answered 9 hours ago
David KeithDavid Keith
2,1801516
$endgroup$
$begingroup$
This output is missing a dimension in the list, which would partition this set of pairs into groups of pairs in which all elements show up exactly once. Also note that some edges will exist more than once within these groups when list dimension is larger than4.
$endgroup$
– Kagaratsch
8 hours ago
add a comment |
$begingroup$
How is it that the comment by @ChristopherLamb is incorrect? Sets are order independent, so I would think this creates "commutative pairs."
set = Table[e[n], {n, 4}]
(* {e[1],e[2],e[3],e[4]} *)
Subsets[set, {2}]
(* {{e[1],e[2]},{e[1],e[3]},{e[1],e[4]},{e[2],e[3]},{e[2],e[4]},{e[3],e[4]}} *)
answered 9 hours ago
David KeithDavid Keith
2,1801516
$endgroup$
How is it that the comment by @ChristopherLamb is incorrect? Sets are order independent, so I would think this creates "commutative pairs."
set = Table[e[n], {n, 4}]
(* {e[1],e[2],e[3],e[4]} *)
Subsets[set, {2}]
(* {{e[1],e[2]},{e[1],e[3]},{e[1],e[4]},{e[2],e[3]},{e[2],e[4]},{e[3],e[4]}} *)
answered 9 hours ago
David KeithDavid Keith
2,1801516
answered 9 hours ago
David KeithDavid Keith
2,1801516
answered 9 hours ago
David KeithDavid Keith
2,1801516
answered 9 hours ago
David KeithDavid Keith
2,1801516
2,1801516
$begingroup$
This output is missing a dimension in the list, which would partition this set of pairs into groups of pairs in which all elements show up exactly once. Also note that some edges will exist more than once within these groups when list dimension is larger than4.
$endgroup$
– Kagaratsch
8 hours ago
add a comment |
$begingroup$
This output is missing a dimension in the list, which would partition this set of pairs into groups of pairs in which all elements show up exactly once. Also note that some edges will exist more than once within these groups when list dimension is larger than4.
$endgroup$
– Kagaratsch
8 hours ago
$begingroup$
This output is missing a dimension in the list, which would partition this set of pairs into groups of pairs in which all elements show up exactly once. Also note that some edges will exist more than once within these groups when list dimension is larger than
4.$endgroup$
– Kagaratsch
8 hours ago
$begingroup$
This output is missing a dimension in the list, which would partition this set of pairs into groups of pairs in which all elements show up exactly once. Also note that some edges will exist more than once within these groups when list dimension is larger than
4.$endgroup$
– Kagaratsch
8 hours ago
add a comment |
Thanks for contributing an answer to Mathematica Stack Exchange!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
Use MathJax to format equations. MathJax reference.
To learn more, see our tips on writing great answers.
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f199665%2fhow-to-generate-all-commutative-pairings-of-list-elements%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
$begingroup$
Subsets[list, {2}]?$endgroup$
– Christopher Lamb
9 hours ago
$begingroup$
@ChristopherLamb This creates a list of all possible pairs. But starting with a list of
2nelements, we are looking for a list of groups ofnpairs instead.$endgroup$
– Kagaratsch
9 hours ago
2
$begingroup$
@Kagaratsch partition[l_, v_, comp_] := Flatten /@ Reap [ Scan [ Which[ comp[ v, #], Sow[#, -1], comp[v, #], Sow[#, 1], True, Sow[#,0]]&,l], {-1,0,1}][[2]] (* Three way partition function using and ordering function by sowing values with tags -1,0, or 1, depending on a relation. You could build up a list by specifying tags with Sow and patterns that match those tags in Reap. If you build the list piece by piece with recursion I would not recommend using Append instead an approach using Reap and Sow could be more effective to collect intermediate results*)
$endgroup$
– Schopenhauer
4 hours ago
1
$begingroup$
@Kagaratsch I’ve seen programs that use Fold as alternative to recursion. g[{}] = x; g[l_] = f[First[l], g[Rest[l]]; could be translated to g[l_]= Fold[f[#1,#2]&, x,l].
$endgroup$
– Schopenhauer
4 hours ago
2
$begingroup$
@Kagaratsch I would also check the ??Developer`* and ??Experimental`* contexts for hidden gems like PartitionMap.
$endgroup$
– Schopenhauer
4 hours ago