6
$\begingroup$

I have this command that prints all combination without repetition:

    Grid[DeleteDuplicates[Map[Sort, Tuples[{a, b, c, d}, 3]]]]

As a matter of fact the output is:

    a   a   a
    a   a   b
    a   a   c
    a   a   d
    a   b   b
    a   b   c
    a   b   d
    a   c   c
    a   c   d
    a   d   d
    b   b   b
    b   b   c
    b   b   d
    b   c   c
    b   c   d
    b   d   d
    c   c   c
    c   c   d
    c   d   d
    d   d   d

How can I delete the vectors wich have two o more 'b','c','d' ?

$\endgroup$
2
  • 2
    $\begingroup$ If you want to construct all orderless lists of length 3 from {a,b,c,d}, where any of b,c,d appear maximum once, there can be a simpler solution. E. g. Map[PadLeft[#, 3, a]&, Subsets[{b, c, d}]] $\endgroup$ – Shadowray Apr 22 '17 at 11:04
  • $\begingroup$ Just for fun: DeleteDuplicates@Subsets[Join[ConstantArray[a, 3], {b, c, d}], {3}] == Select[Permutations[Join[ConstantArray[a, 3], {b, c, d}], {3}], OrderedQ] == Map[PadLeft[#, 3, a] &, Subsets[{b, c, d}]] $\endgroup$ – user1066 Apr 22 '17 at 18:59
6
$\begingroup$

How can I delete the vectors wich have two or more 'b','c','d' ?

 (lst = DeleteDuplicates[Map[Sort, Tuples[{a, b, c, d}, 3]]]) // Grid

Mathematica graphics

Create the pattern to delete

 tst=Flatten[Permutations[{#,#,_},{3}]&/@{b,c,d},1]

Mathematica graphics

Delete them. I do not know now how to map/reset DeleteCases, so used a Do

 Do[lst= DeleteCases[lst,tst[[n]]],{n,1,Length@tst}]
 lst // Grid

Mathematica graphics

$\endgroup$
0
5
$\begingroup$

Here is a fairly clean approach. By naming the pattern b | c | d (| is the short form of Alternatives) we force a match for the same letter each time.

m = DeleteDuplicates[Map[Sort, Tuples[{a, b, c, d}, 3]]];

m2 = DeleteCases[m, {___, x : b|c|d, x_, ___}]

m2 // Grid

$\begin{array}{ccc} a & a & a \\ a & a & b \\ a & a & c \\ a & a & d \\ a & b & c \\ a & b & d \\ a & c & d \\ b & c & d \\ \end{array}$

$\endgroup$
1
  • $\begingroup$ @Wizard +1 for the nice approach. I adapted yours for the OrderlessPatternSequence $\endgroup$ – Ali Hashmi Apr 22 '17 at 13:45
5
$\begingroup$
Pick[lst, Max[Function[{x}, Count[#, x]] /@ {b, c, d}] <= 1 & /@ lst] // Grid

Mathematica graphics

Update: A variation on @Shadowray's suggestion to construct the desired list directly:

PadLeft[Subsets[{b, c, d}], Automatic, a]
(* or PadLeft[Subsets[{b, c, d}]] /. 0 -> a *)

{{a, a, a}, {a, a, b}, {a, a, c}, {a, a, d}, {a, b, c}, {a, b, d}, {a, c, d},{b, c, d}}

Update 2: Also

 DeleteDuplicates@Subsets[{a, a, a, b, c, d}, {3}]

{{a, a, a}, {a, a, b}, {a, a, c}, {a, a, d}, {a, b, c}, {a, b, d}, {a, c, d},{b, c, d}}

$\endgroup$
1
  • $\begingroup$ +1 for the automatic creation of the list $\endgroup$ – Ali Hashmi Apr 22 '17 at 13:44
4
$\begingroup$
m = DeleteDuplicates[Map[Sort, Tuples[{a, b, c, d}, 3]]];

DeleteCases[m, {Alternatives@@Function[x, OrderlessPatternSequence[_, x, x],
Listable], {b, c, d}]}]

(*{{a, a, a}, {a, a, b}, {a, a, c}, {a, a, d}, {a, b, c}, {a, b, d}, {a,c,d},{b, c, d}}*)

(* adopting Wizard's approach *)
DeleteCases[m, {OrderlessPatternSequence[x : b | c | d, x_, _] }] 
(*{{a, a, a}, {a, a, b}, {a, a, c}, {a, a, d}, {a, b, c}, {a, b, d}, {a,c,d}, {b, c, d}}*)
$\endgroup$
2
$\begingroup$

Here is an alternative way to do it..

lst = Sort /@ Permutations[{b, c, d}, 3] // DeleteDuplicates
PadLeft[#, 3, a] & /@ lst
$\endgroup$
1
  • $\begingroup$ I realize my solution is similar to @shadowray but his solution is more clean than mine.. $\endgroup$ – OkkesDulgerci Apr 22 '17 at 14:00
2
$\begingroup$

And yet another method. Delete the a's from each sublist, and then check to see if Union will remove anything else:

In[1]:= list = DeleteDuplicates[Map[Sort, Tuples[{a, b, c, d}, 3]]];

In[2]:= Select[list, 
 Length[Union[DeleteCases[#, a]]] == Length[DeleteCases[#, a]] &]

Out[2]= {{a, a, a}, {a, a, b}, {a, a, c}, {a, a, d}, {a, b, c}, {a, b,
   d}, {a, c, d}, {b, c, d}}
$\endgroup$
1
$\begingroup$

In:

MapThread[Join, {Subsets[{a, a, a}] // Reverse, Subsets[{b, c, d}]}]

Out:

{{a, a, a}, {a, a, b}, {a, a, c}, {a, a, d}, {a, b, c}, {a, b, d}, {a,
   c, d}, {b, c, d}}
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.