How to get a Table of pairs (a/b, c/d) where GCD[a,b]==1 and GCD[c,d]==1?

I am trying to make a Table pairs of (a/b, c/d) where GCD[a,b]==1 and GCD[c,d]==1. I have tried the following:

Table[{{a/b, c/d}}, {a, 1, 6}, {b, 1, 6}, {c, 1, 4}, {d, 1, 4}]


Trying the following doesn't help:

Table[{{a/b, c/d}}, {a, 1, 6}, {b, 1, 6}, {c, 1, 4}, {d, 1, 4}, GCD[a, b] == 1, GCD[c, d] == 1]


How can I get the desired result?

sol = Solve[{GCD[a, b] == 1, GCD[c, d] == 1, 1 <= a <= 6, 1 <= b <= 6,
1 <= c <= 6, 1 <= d <= 4}, Integers];
{a/b, c/d} /. sol


This may need to be rethought if you want to search a large number of integers. You could start by finding relatively prime pairs within some range:

relativelyPrimePairs = Select[Tuples[Range@6, 2], Apply[CoprimeQ]]


Now you can take all pairs of those:

Tuples[relativelyPrimePairs, 2]


Then you can make fractions:

Map[Apply[Divide], Tuples[relativelyPrimePairs, 2], {-2}]


I notice that your example uses fewer samples for the second fraction, so we could filter that list:

Map[
Apply[Divide],
Tuples[{relativelyPrimePairs, Select[relativelyPrimePairs, AllTrue[LessEqualThan[4]]]}], {-2}]


You can also do this by adding an If in the Table:

Select[Flatten[Table[If[GCD[a, b] == 1 && GCD[c, d] == 1,
{a/b, c/d}], {a, 1, 6}, {b, 1, 6}, {c, 1, 4}, {d, 1, 4}], 3], # =!= Null &]


The Flatten removes all the extra parentheses and the Select removes all the ones that do not fulfill the condition.

Do[
If[CoprimeQ[a, b] && CoprimeQ[c, d],
Sow[{a / b, c / d}]
]
,
{a, 1, 6}
,
{b, 1, 6}
,
{c, 1, 4}
,
{d, 1, 4}
] //
Reap //
#[[2]]& //
First

• You can replace // #[[2]]& // First by // #[[2,1]]&. And to be honest you can replace that by (Do[...]//Reap)[[2,1]]. Commented Aug 5, 2023 at 12:07
t = Table[{{a, b, c, d}}, {a, 1, 6}, {b, 1, 6}, {c, 1, 4}, {d, 1,
4}] // Flatten[#, 4] &;
t2 = (t /. {a_, b_, c_, d_} :>
If[CoprimeQ[a, b] && CoprimeQ[c, d], {{a, b, c, d}, a/b, c/d},
Nothing]);
Length /@ {t, t2}


{576, 253}

To see this in a grid format:

t2 // Grid


Just another way using RelationGraph

helper = Function[u, Union@Catenate[{#1/#2, #2/#1} & @@@ u]];
c6 = RelationGraph[CoprimeQ, Range[6]] // EdgeList;
c4 = RelationGraph[CoprimeQ, Range[4]] // EdgeList;
Tuples[{helper[c6], helper[c4]}]


helper just tidies up coprime pairs from each range

c4, c6 are just coprime pairs in relevant range

The last line is result sorted.

ClearAll[coprimePairRatios]

coprimePairRatios = Tuples @*
Map[{Array[If[CoprimeQ @ ##, #/#2, Nothing] &, #, 1, Sequence]} &];

Length @ coprimePairRatios @ {{6, 6}, {4, 4}}

253

Short[coprimePairRatios @ {{6, 6}, {4, 4}}, 3]


Some other approaches using GroupBy and Pick:

t = Tuples[{Range[6], Range[6], Range[4], Range[4]}];
res1 = True /.
GroupBy[t, (CoprimeQ[#[[1]], #[[2]]]) &&
CoprimeQ[#[[3]], #[[4]]] & -> ({#[[1]]/#[[2]], #[[3]]/#[[4]]} \
&)];
res2 = {#1/#2, #3/#4} & @@@
Pick[t, (CoprimeQ[#[[1]], #[[2]]]) && CoprimeQ[#[[3]], #[[4]]] & /@
t];$$$$
`