How to generate all commutative pairings of list elements?Obtain all the (multinomial) subsetsFinding 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?
Difference between prepositions in "...killed during/in the war"
Do empty drive bays need to be filled?
How to create a cubic equation that include sums of the roots of another cubic equation
A Salute to Poetry
Proving that a Russian cryptographic standard is too structured
As easy as Three, Two, One... How fast can you go from Five to Four?
Is Lambda Calculus purely syntactic?
Can the removal of a duty-free sales trolley result in a measurable reduction in emissions?
The origin of the Russian proverb about two hares
That's not my X, its Y is too Z
Why did the World Bank set the global poverty line at $1.90?
Was planting UN flag on Moon ever discussed?
Is it okay to have a sequel start immediately after the end of the first book?
Is it a acceptable way to write a loss function in this form?
How do you play "tenth" chords on the guitar?
What should I discuss with my DM prior to my first game?
Is there a DSLR/mirorless camera with minimal options like a classic, simple SLR?
Is it safe to remove python 2.7.15rc1 from Ubuntu 18.04?
To what extent do precedents in Westminster systems apply in other countries that use it?
Command of files and size
Does the new finding on "reversing a quantum jump mid-flight" rule out any interpretations of QM?
Analogy between an unknown in an argument, and a contradiction in the principle of explosion
Accessing /systemTopic/ streaming channel
How far would a landing Airbus A380 go until it stops with no brakes?
How to generate all commutative pairings of list elements?
Obtain all the (multinomial) subsetsFinding 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 Jun 4 at 5:04
user64494
3,97111323
asked Jun 3 at 20:56
KagaratschKagaratsch
5,41141352
$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 Jun 4 at 5:04
user64494
3,97111323
asked Jun 3 at 20:56
KagaratschKagaratsch
5,41141352
$endgroup$
1
$begingroup$
Subsets[list, 2]?
$endgroup$
– Christopher Lamb
Jun 3 at 21:10
$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
Jun 3 at 21:12
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
Jun 4 at 1:55
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
Jun 4 at 2:08
2
$begingroup$
@Kagaratsch I would also check the ??Developer`* and ??Experimental`* contexts for hidden gems like PartitionMap.
$endgroup$
– Schopenhauer
Jun 4 at 2:14
|
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 Jun 4 at 5:04
user64494
3,97111323
asked Jun 3 at 20:56
KagaratschKagaratsch
5,41141352
$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 Jun 4 at 5:04
user64494
3,97111323
asked Jun 3 at 20:56
KagaratschKagaratsch
5,41141352
edited Jun 4 at 5:04
user64494
3,97111323
asked Jun 3 at 20:56
KagaratschKagaratsch
5,41141352
edited Jun 4 at 5:04
user64494
3,97111323
edited Jun 4 at 5:04
user64494
3,97111323
edited Jun 4 at 5:04
user64494
3,97111323
3,97111323
asked Jun 3 at 20:56
KagaratschKagaratsch
5,41141352
asked Jun 3 at 20:56
KagaratschKagaratsch
5,41141352
asked Jun 3 at 20:56
KagaratschKagaratsch
5,41141352
5,41141352
1
$begingroup$
Subsets[list, 2]?
$endgroup$
– Christopher Lamb
Jun 3 at 21:10
$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
Jun 3 at 21:12
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
Jun 4 at 1:55
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
Jun 4 at 2:08
2
$begingroup$
@Kagaratsch I would also check the ??Developer`* and ??Experimental`* contexts for hidden gems like PartitionMap.
$endgroup$
– Schopenhauer
Jun 4 at 2:14
|
show 6 more comments
1
$begingroup$
Subsets[list, 2]?
$endgroup$
– Christopher Lamb
Jun 3 at 21:10
$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
Jun 3 at 21:12
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
Jun 4 at 1:55
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
Jun 4 at 2:08
2
$begingroup$
@Kagaratsch I would also check the ??Developer`* and ??Experimental`* contexts for hidden gems like PartitionMap.
$endgroup$
– Schopenhauer
Jun 4 at 2:14
1
1
$begingroup$
Subsets[list, 2] ?$endgroup$
– Christopher Lamb
Jun 3 at 21:10
$begingroup$
Subsets[list, 2] ?$endgroup$
– Christopher Lamb
Jun 3 at 21:10
$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
Jun 3 at 21:12
$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
Jun 3 at 21:12
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
Jun 4 at 1:55
$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
Jun 4 at 1:55
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
Jun 4 at 2:08
$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
Jun 4 at 2:08
2
2
$begingroup$
@Kagaratsch I would also check the ??Developer`* and ??Experimental`* contexts for hidden gems like PartitionMap.
$endgroup$
– Schopenhauer
Jun 4 at 2:14
$begingroup$
@Kagaratsch I would also check the ??Developer`* and ??Experimental`* contexts for hidden gems like PartitionMap.
$endgroup$
– Schopenhauer
Jun 4 at 2:14
|
show 6 more comments
5 Answers
5
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 Jun 3 at 21:48
Carl WollCarl Woll
83.2k3105216
$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
Jun 3 at 22:16
$begingroup$
By the waypairCounts[n_?EvenQ] := (n-1)!!
$endgroup$
– Kagaratsch
Jun 3 at 23:10
add a comment |
$begingroup$
ClearAll[perfectMatchings]
perfectMatchings = Module[subs = Subsets[#, 2], l = Length @ #, matchings,
matchings = FindIndependentVertexSet[LineGraph[UndirectedEdge @@@ subs], l/2, All];
Extract[subs, List /@ matchings] ] &;
perfectMatchings[Range @ 4] // Grid // TeXForm
$smallbeginarraycc
1,4 & 2,3 \
1,3 & 2,4 \
1,2 & 3,4 \
endarray$
perfectMatchings[Range @ 6] // Grid // TeXForm
$smallbeginarrayccc
1,6 & 2,5 & 3,4 \
1,6 & 2,4 & 3,5 \
1,6 & 2,3 & 4,5 \
1,5 & 2,6 & 3,4 \
1,5 & 2,4 & 3,6 \
1,5 & 2,3 & 4,6 \
1,4 & 2,6 & 3,5 \
1,4 & 2,5 & 3,6 \
1,4 & 2,3 & 5,6 \
1,3 & 2,6 & 4,5 \
1,3 & 2,5 & 4,6 \
1,3 & 2,4 & 5,6 \
1,2 & 3,6 & 4,5 \
1,2 & 3,5 & 4,6 \
1,2 & 3,4 & 5,6 \
endarray$
Note: This is much slower than Carl's partitions and Kagaratsch's pairings.
answered Jun 3 at 21:28
kglrkglr
197k10222444
$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 Jun 3 at 22:06
KagaratschKagaratsch
5,41141352
$endgroup$
add a comment |
$begingroup$
This question kind of looks similar to 167488 IMO.
The answer here uses the same idea of the answer.
commPairs[list_] := Module[perms,
perms =
Table[(ConstantArray[Unique[], 2]), Length[list]/2] // Flatten //
Permutations;
Keys@GatherBy[#, Last] & /@ (Thread[list -> #] & /@ perms) //
DeleteDuplicates
];
Test:
commPairs[Range@4]
1, 2, 3, 4, 1, 3, 2, 4, 1, 4, 2, 3
commPairs[Range@6]
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,
5, 2, 3, 4, 6, 1, 6, 2, 3, 4, 5, 1, 4, 2, 5, 3,
6, 1, 4, 2, 6, 3, 5, 1, 5, 2, 4, 3, 6, 1,
6, 2, 4, 3, 5, 1, 5, 2, 6, 3, 4, 1, 6, 2, 5, 3,
4
answered Jun 4 at 13:36
Anjan KumarAnjan Kumar
3,99311026
$endgroup$
$begingroup$
Unfortunately, generating alln!permutations in the intermediate terms instead of just the(n-1)!!needed ones makes this kind of slow.
$endgroup$
– Kagaratsch
Jun 6 at 18:58
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 Jun 3 at 21:26
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
Jun 3 at 21:39
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
5 Answers
5
active
oldest
votes
5 Answers
5
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 Jun 3 at 21:48
Carl WollCarl Woll
83.2k3105216
$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
Jun 3 at 22:16
$begingroup$
By the waypairCounts[n_?EvenQ] := (n-1)!!
$endgroup$
– Kagaratsch
Jun 3 at 23:10
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 Jun 3 at 21:48
Carl WollCarl Woll
83.2k3105216
$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
Jun 3 at 22:16
$begingroup$
By the waypairCounts[n_?EvenQ] := (n-1)!!
$endgroup$
– Kagaratsch
Jun 3 at 23:10
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 Jun 3 at 21:48
Carl WollCarl Woll
83.2k3105216
$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 Jun 3 at 21:48
Carl WollCarl Woll
83.2k3105216
answered Jun 3 at 21:48
Carl WollCarl Woll
83.2k3105216
answered Jun 3 at 21:48
Carl WollCarl Woll
83.2k3105216
answered Jun 3 at 21:48
Carl WollCarl Woll
83.2k3105216
83.2k3105216
$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
Jun 3 at 22:16
$begingroup$
By the waypairCounts[n_?EvenQ] := (n-1)!!
$endgroup$
– Kagaratsch
Jun 3 at 23:10
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
Jun 3 at 22:16
$begingroup$
By the waypairCounts[n_?EvenQ] := (n-1)!!
$endgroup$
– Kagaratsch
Jun 3 at 23:10
$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
Jun 3 at 22:16
$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
Jun 3 at 22:16
$begingroup$
By the way
pairCounts[n_?EvenQ] := (n-1)!!$endgroup$
– Kagaratsch
Jun 3 at 23:10
$begingroup$
By the way
pairCounts[n_?EvenQ] := (n-1)!!$endgroup$
– Kagaratsch
Jun 3 at 23:10
add a comment |
$begingroup$
ClearAll[perfectMatchings]
perfectMatchings = Module[subs = Subsets[#, 2], l = Length @ #, matchings,
matchings = FindIndependentVertexSet[LineGraph[UndirectedEdge @@@ subs], l/2, All];
Extract[subs, List /@ matchings] ] &;
perfectMatchings[Range @ 4] // Grid // TeXForm
$smallbeginarraycc
1,4 & 2,3 \
1,3 & 2,4 \
1,2 & 3,4 \
endarray$
perfectMatchings[Range @ 6] // Grid // TeXForm
$smallbeginarrayccc
1,6 & 2,5 & 3,4 \
1,6 & 2,4 & 3,5 \
1,6 & 2,3 & 4,5 \
1,5 & 2,6 & 3,4 \
1,5 & 2,4 & 3,6 \
1,5 & 2,3 & 4,6 \
1,4 & 2,6 & 3,5 \
1,4 & 2,5 & 3,6 \
1,4 & 2,3 & 5,6 \
1,3 & 2,6 & 4,5 \
1,3 & 2,5 & 4,6 \
1,3 & 2,4 & 5,6 \
1,2 & 3,6 & 4,5 \
1,2 & 3,5 & 4,6 \
1,2 & 3,4 & 5,6 \
endarray$
Note: This is much slower than Carl's partitions and Kagaratsch's pairings.
answered Jun 3 at 21:28
kglrkglr
197k10222444
$endgroup$
add a comment |
$begingroup$
ClearAll[perfectMatchings]
perfectMatchings = Module[subs = Subsets[#, 2], l = Length @ #, matchings,
matchings = FindIndependentVertexSet[LineGraph[UndirectedEdge @@@ subs], l/2, All];
Extract[subs, List /@ matchings] ] &;
perfectMatchings[Range @ 4] // Grid // TeXForm
$smallbeginarraycc
1,4 & 2,3 \
1,3 & 2,4 \
1,2 & 3,4 \
endarray$
perfectMatchings[Range @ 6] // Grid // TeXForm
$smallbeginarrayccc
1,6 & 2,5 & 3,4 \
1,6 & 2,4 & 3,5 \
1,6 & 2,3 & 4,5 \
1,5 & 2,6 & 3,4 \
1,5 & 2,4 & 3,6 \
1,5 & 2,3 & 4,6 \
1,4 & 2,6 & 3,5 \
1,4 & 2,5 & 3,6 \
1,4 & 2,3 & 5,6 \
1,3 & 2,6 & 4,5 \
1,3 & 2,5 & 4,6 \
1,3 & 2,4 & 5,6 \
1,2 & 3,6 & 4,5 \
1,2 & 3,5 & 4,6 \
1,2 & 3,4 & 5,6 \
endarray$
Note: This is much slower than Carl's partitions and Kagaratsch's pairings.
answered Jun 3 at 21:28
kglrkglr
197k10222444
$endgroup$
add a comment |
$begingroup$
ClearAll[perfectMatchings]
perfectMatchings = Module[subs = Subsets[#, 2], l = Length @ #, matchings,
matchings = FindIndependentVertexSet[LineGraph[UndirectedEdge @@@ subs], l/2, All];
Extract[subs, List /@ matchings] ] &;
perfectMatchings[Range @ 4] // Grid // TeXForm
$smallbeginarraycc
1,4 & 2,3 \
1,3 & 2,4 \
1,2 & 3,4 \
endarray$
perfectMatchings[Range @ 6] // Grid // TeXForm
$smallbeginarrayccc
1,6 & 2,5 & 3,4 \
1,6 & 2,4 & 3,5 \
1,6 & 2,3 & 4,5 \
1,5 & 2,6 & 3,4 \
1,5 & 2,4 & 3,6 \
1,5 & 2,3 & 4,6 \
1,4 & 2,6 & 3,5 \
1,4 & 2,5 & 3,6 \
1,4 & 2,3 & 5,6 \
1,3 & 2,6 & 4,5 \
1,3 & 2,5 & 4,6 \
1,3 & 2,4 & 5,6 \
1,2 & 3,6 & 4,5 \
1,2 & 3,5 & 4,6 \
1,2 & 3,4 & 5,6 \
endarray$
Note: This is much slower than Carl's partitions and Kagaratsch's pairings.
answered Jun 3 at 21:28
kglrkglr
197k10222444
$endgroup$
ClearAll[perfectMatchings]
perfectMatchings = Module[subs = Subsets[#, 2], l = Length @ #, matchings,
matchings = FindIndependentVertexSet[LineGraph[UndirectedEdge @@@ subs], l/2, All];
Extract[subs, List /@ matchings] ] &;
perfectMatchings[Range @ 4] // Grid // TeXForm
$smallbeginarraycc
1,4 & 2,3 \
1,3 & 2,4 \
1,2 & 3,4 \
endarray$
perfectMatchings[Range @ 6] // Grid // TeXForm
$smallbeginarrayccc
1,6 & 2,5 & 3,4 \
1,6 & 2,4 & 3,5 \
1,6 & 2,3 & 4,5 \
1,5 & 2,6 & 3,4 \
1,5 & 2,4 & 3,6 \
1,5 & 2,3 & 4,6 \
1,4 & 2,6 & 3,5 \
1,4 & 2,5 & 3,6 \
1,4 & 2,3 & 5,6 \
1,3 & 2,6 & 4,5 \
1,3 & 2,5 & 4,6 \
1,3 & 2,4 & 5,6 \
1,2 & 3,6 & 4,5 \
1,2 & 3,5 & 4,6 \
1,2 & 3,4 & 5,6 \
endarray$
Note: This is much slower than Carl's partitions and Kagaratsch's pairings.
answered Jun 3 at 21:28
kglrkglr
197k10222444
edited Jun 4 at 7:52
answered Jun 3 at 21:28
kglrkglr
197k10222444
answered Jun 3 at 21:28
kglrkglr
197k10222444
answered Jun 3 at 21:28
kglrkglr
197k10222444
197k10222444
add a comment |
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 Jun 3 at 22:06
KagaratschKagaratsch
5,41141352
$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 Jun 3 at 22:06
KagaratschKagaratsch
5,41141352
$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 Jun 3 at 22:06
KagaratschKagaratsch
5,41141352
$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 Jun 3 at 22:06
KagaratschKagaratsch
5,41141352
edited Jun 3 at 22:41
answered Jun 3 at 22:06
KagaratschKagaratsch
5,41141352
answered Jun 3 at 22:06
KagaratschKagaratsch
5,41141352
answered Jun 3 at 22:06
KagaratschKagaratsch
5,41141352
5,41141352
add a comment |
add a comment |
$begingroup$
This question kind of looks similar to 167488 IMO.
The answer here uses the same idea of the answer.
commPairs[list_] := Module[perms,
perms =
Table[(ConstantArray[Unique[], 2]), Length[list]/2] // Flatten //
Permutations;
Keys@GatherBy[#, Last] & /@ (Thread[list -> #] & /@ perms) //
DeleteDuplicates
];
Test:
commPairs[Range@4]
1, 2, 3, 4, 1, 3, 2, 4, 1, 4, 2, 3
commPairs[Range@6]
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,
5, 2, 3, 4, 6, 1, 6, 2, 3, 4, 5, 1, 4, 2, 5, 3,
6, 1, 4, 2, 6, 3, 5, 1, 5, 2, 4, 3, 6, 1,
6, 2, 4, 3, 5, 1, 5, 2, 6, 3, 4, 1, 6, 2, 5, 3,
4
answered Jun 4 at 13:36
Anjan KumarAnjan Kumar
3,99311026
$endgroup$
$begingroup$
Unfortunately, generating alln!permutations in the intermediate terms instead of just the(n-1)!!needed ones makes this kind of slow.
$endgroup$
– Kagaratsch
Jun 6 at 18:58
add a comment |
$begingroup$
This question kind of looks similar to 167488 IMO.
The answer here uses the same idea of the answer.
commPairs[list_] := Module[perms,
perms =
Table[(ConstantArray[Unique[], 2]), Length[list]/2] // Flatten //
Permutations;
Keys@GatherBy[#, Last] & /@ (Thread[list -> #] & /@ perms) //
DeleteDuplicates
];
Test:
commPairs[Range@4]
1, 2, 3, 4, 1, 3, 2, 4, 1, 4, 2, 3
commPairs[Range@6]
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,
5, 2, 3, 4, 6, 1, 6, 2, 3, 4, 5, 1, 4, 2, 5, 3,
6, 1, 4, 2, 6, 3, 5, 1, 5, 2, 4, 3, 6, 1,
6, 2, 4, 3, 5, 1, 5, 2, 6, 3, 4, 1, 6, 2, 5, 3,
4
answered Jun 4 at 13:36
Anjan KumarAnjan Kumar
3,99311026
$endgroup$
$begingroup$
Unfortunately, generating alln!permutations in the intermediate terms instead of just the(n-1)!!needed ones makes this kind of slow.
$endgroup$
– Kagaratsch
Jun 6 at 18:58
add a comment |
$begingroup$
This question kind of looks similar to 167488 IMO.
The answer here uses the same idea of the answer.
commPairs[list_] := Module[perms,
perms =
Table[(ConstantArray[Unique[], 2]), Length[list]/2] // Flatten //
Permutations;
Keys@GatherBy[#, Last] & /@ (Thread[list -> #] & /@ perms) //
DeleteDuplicates
];
Test:
commPairs[Range@4]
1, 2, 3, 4, 1, 3, 2, 4, 1, 4, 2, 3
commPairs[Range@6]
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,
5, 2, 3, 4, 6, 1, 6, 2, 3, 4, 5, 1, 4, 2, 5, 3,
6, 1, 4, 2, 6, 3, 5, 1, 5, 2, 4, 3, 6, 1,
6, 2, 4, 3, 5, 1, 5, 2, 6, 3, 4, 1, 6, 2, 5, 3,
4
answered Jun 4 at 13:36
Anjan KumarAnjan Kumar
3,99311026
$endgroup$
This question kind of looks similar to 167488 IMO.
The answer here uses the same idea of the answer.
commPairs[list_] := Module[perms,
perms =
Table[(ConstantArray[Unique[], 2]), Length[list]/2] // Flatten //
Permutations;
Keys@GatherBy[#, Last] & /@ (Thread[list -> #] & /@ perms) //
DeleteDuplicates
];
Test:
commPairs[Range@4]
1, 2, 3, 4, 1, 3, 2, 4, 1, 4, 2, 3
commPairs[Range@6]
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,
5, 2, 3, 4, 6, 1, 6, 2, 3, 4, 5, 1, 4, 2, 5, 3,
6, 1, 4, 2, 6, 3, 5, 1, 5, 2, 4, 3, 6, 1,
6, 2, 4, 3, 5, 1, 5, 2, 6, 3, 4, 1, 6, 2, 5, 3,
4
answered Jun 4 at 13:36
Anjan KumarAnjan Kumar
3,99311026
edited Jun 4 at 13:48
answered Jun 4 at 13:36
Anjan KumarAnjan Kumar
3,99311026
answered Jun 4 at 13:36
Anjan KumarAnjan Kumar
3,99311026
answered Jun 4 at 13:36
Anjan KumarAnjan Kumar
3,99311026
3,99311026
$begingroup$
Unfortunately, generating alln!permutations in the intermediate terms instead of just the(n-1)!!needed ones makes this kind of slow.
$endgroup$
– Kagaratsch
Jun 6 at 18:58
add a comment |
$begingroup$
Unfortunately, generating alln!permutations in the intermediate terms instead of just the(n-1)!!needed ones makes this kind of slow.
$endgroup$
– Kagaratsch
Jun 6 at 18:58
$begingroup$
Unfortunately, generating all
n! permutations in the intermediate terms instead of just the (n-1)!! needed ones makes this kind of slow.$endgroup$
– Kagaratsch
Jun 6 at 18:58
$begingroup$
Unfortunately, generating all
n! permutations in the intermediate terms instead of just the (n-1)!! needed ones makes this kind of slow.$endgroup$
– Kagaratsch
Jun 6 at 18:58
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 Jun 3 at 21:26
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
Jun 3 at 21:39
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 Jun 3 at 21:26
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
Jun 3 at 21:39
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 Jun 3 at 21:26
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 Jun 3 at 21:26
David KeithDavid Keith
2,1801516
answered Jun 3 at 21:26
David KeithDavid Keith
2,1801516
answered Jun 3 at 21:26
David KeithDavid Keith
2,1801516
answered Jun 3 at 21:26
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
Jun 3 at 21:39
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
Jun 3 at 21:39
$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
Jun 3 at 21:39
$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
Jun 3 at 21:39
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
1
$begingroup$
Subsets[list, 2]?$endgroup$
– Christopher Lamb
Jun 3 at 21:10
$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
Jun 3 at 21:12
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
Jun 4 at 1:55
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
Jun 4 at 2:08
2
$begingroup$
@Kagaratsch I would also check the ??Developer`* and ??Experimental`* contexts for hidden gems like PartitionMap.
$endgroup$
– Schopenhauer
Jun 4 at 2:14