Rebol3 Code Examplex

Rebol [
    title: "Rosetta code: Pairs with common factors"
    file:  %Pairs_with_common_factors.r3
    url:   https://rosettacode.org/wiki/Pairs_with_common_factors
]

list-totients: function [
    "Sieve to compute Euler's totient for all numbers up to limit"
    limit [integer!]
][
    totients: make vector! compose [uint64! (limit + 1)]
    repeat n limit + 1 [totients/:n: n - 1]
    i: 2
    while [i <= limit] [
        if i = totients/(i + 1) [
            totients/(i + 1): i - 1
            j: i * 2
            while [j <= limit] [
                totients/(j + 1): (totients/(j + 1) / i) * (i - 1)
                j: j + i
            ]
        ]
        ++ i
    ]
    totients
]

limit: 1000000

print "Computing totients..."
totients: list-totients limit

pairs-count: make vector! compose [uint64! (limit + 1)]
totient-sum: 0

print "Computing pairs..."
repeat number limit [
    totient-sum: totient-sum + totients/(number + 1)
    pairs-count/(number + 1): either prime? number [
        pairs-count/:number
    ][
        (number * (number - 1) / 2) - totient-sum + 1
    ]
]

print "The first one hundred terms of the number of pairs with common factors:"
repeat number 100 [
    prin ajoin [
        pad pairs-count/(number + 1) -5
        either zero? number % 10 [LF][SP]
    ]
]
print ""

;; Print at powers of 10
term: 1 while [term <= limit] [
    label: ajoin ["Term " term ":"]
    print [pad label 13 pairs-count/(term + 1)]
    term: term * 10
]

Computing totients...
Computing pairs...
The first one hundred terms of the number of pairs with common factors:
    0     0     0     1     1     4     4     7     9    14
   14    21    21    28    34    41    41    52    52    63
   71    82    82    97   101   114   122   137   137   158
  158   173   185   202   212   235   235   254   268   291
  291   320   320   343   363   386   386   417   423   452
  470   497   497   532   546   577   597   626   626   669
  669   700   726   757   773   818   818   853   877   922
  922   969   969  1006  1040  1079  1095  1148  1148  1195
 1221  1262  1262  1321  1341  1384  1414  1461  1461  1526
 1544  1591  1623  1670  1692  1755  1755  1810  1848  1907

Term 1:       0
Term 10:      14
Term 100:     1907
Term 1000:    195309
Term 10000:   19597515
Term 100000:  1960299247
Term 1000000: 196035947609