Finding lists with no intersections

DeleteDuplicates[RandomSample @ jm, Intersection @ ## =!= {} &]

{{2, 7, 8}, {1, 5, 9}, {3, 4, 6}}

In versions 10.0+, you can also use IntersectingQ as the second argument of DeleteDuplicates:

DeleteDuplicates[RandomSample@jm, IntersectingQ]

{{2, 3, 5}, {6, 7, 8}, {1, 4, 9}}

for the example it is not too unreasonable to just generate all of them and pick one:

Select[ Subsets[jm, {3}] , Union@Flatten@# == Range[9] & ] ; (*280 results*)
RandomChoice[%]

{{1, 5, 9}, {2, 3, 4}, {6, 7, 8}}

Here is a way to avoid generating all the subsets:

Needs["Combinatorica`"]
jm = Union[Sort /@ Permutations[Range[9], {3}]];
While[ Union@Flatten[x = RandomKSubset[jm, 3]] != Range[9]]; x

{{1, 8, 9}, {2, 3, 4}, {5, 6, 7}}

Aside I'm puzzled why there is no NthKSubset function in Combinatorica ?

note for this specific example you could do this as well:

Sort /@ Partition[RandomSample[Range[9], 9], 3]

Try this:

Partition[RandomSample[Range[9]], 3]

Related