4
$\begingroup$

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?

$\endgroup$
0

8 Answers 8

8
$\begingroup$
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
$\endgroup$
0
5
$\begingroup$

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}]
$\endgroup$
4
$\begingroup$

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.

$\endgroup$
4
$\begingroup$
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
$\endgroup$
1
  • 1
    $\begingroup$ You can replace // #[[2]]& // First by // #[[2,1]]&. And to be honest you can replace that by (Do[...]//Reap)[[2,1]]. $\endgroup$ Commented Aug 5, 2023 at 12:07
3
$\begingroup$
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
$\endgroup$
3
$\begingroup$

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.

$\endgroup$
3
$\begingroup$
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]

![enter image description here

$\endgroup$
3
$\begingroup$

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];`
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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