Perfect totient numbers

Generate and show here, the first twenty Perfect totient numbers.

Related task

Totient function

Also see

the OEIS entry for perfect totient numbers.
mrob list of the first 54

11l

Translation of: Python

<lang 11l>F φ(n)

  R sum((1..n).filter(k -> gcd(@n, k) == 1).map(k -> 1))

F perfect_totient(cnt)

  [Int] r

  L(n0) 1..
     V parts = 0
     V n = n0
     L n != 1
        n = φ(n)
        parts += n
     I parts == n0
        r [+]= n0
        I r.len == cnt
           R r

print(perfect_totient(20))</lang>

Output:

[3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571]

AArch64 Assembly

Works with: as version Raspberry Pi 3B version Buster 64 bits
or android 64 bits with application Termux

<lang AArch64 Assembly> /* ARM assembly AARCH64 Raspberry PI 3B */ /* program totientPerfect64.s */

/************************************/ /* Constantes */ /************************************/ .include "../includeConstantesARM64.inc" .equ MAXI, 20

/*********************************/ /* Initialized data */ /*********************************/ .data szMessNumber: .asciz " @ " szCarriageReturn: .asciz "\n" /*********************************/ /* UnInitialized data */ /*********************************/ .bss sZoneConv: .skip 24 /*********************************/ /* code section */ /*********************************/ .text .global main main:

   mov x4,#2                   // start number
   mov x6,#0                   // line counter
   mov x7,#0                   // result counter

1:

   mov x0,x4
   mov x5,#0                   // totient sum

2:

   bl totient                  // compute totient
   add x5,x5,x0                // add totient
   cmp x0,#1
   beq 3f
   b 2b

3:

   cmp x5,x4                   // compare number and totient sum
   bne 4f
   mov x0,x4                   // display result if equals
   ldr x1,qAdrsZoneConv
   bl conversion10             // call décimal conversion
   ldr x0,qAdrszMessNumber
   ldr x1,qAdrsZoneConv        // insert conversion in message
   bl strInsertAtCharInc
   bl affichageMess            // display message
   add x7,x7,#1
   add x6,x6,#1                // increment indice line display
   cmp x6,#5                   // if = 5  new line
   bne 4f
   mov x6,#0
   ldr x0,qAdrszCarriageReturn
   bl affichageMess

4:

   add x4,x4,#1                 // increment number
   cmp x7,#MAXI                 // maxi ?
   blt 1b                       // and loop
   
   ldr x0,qAdrszCarriageReturn
   bl affichageMess

100: // standard end of the program

   mov x0, #0                  // return code
   mov x8,EXIT 
   svc #0                      // perform the system call

qAdrszCarriageReturn: .quad szCarriageReturn qAdrsZoneConv: .quad sZoneConv qAdrszMessNumber: .quad szMessNumber /******************************************************************/ /* compute totient of number */ /******************************************************************/ /* x0 contains number */ totient:

   stp x1,lr,[sp,-16]!       // save  registers 
   stp x2,x3,[sp,-16]!       // save  registers 
   stp x4,x5,[sp,-16]!       // save  registers 
   mov x4,x0                 // totient
   mov x5,x0                 // save number
   mov x1,#0                 // for first divisor

1: // begin loop

   mul x3,x1,x1              // compute square
   cmp x3,x5                 // compare number
   bgt 4f                    // end 
   add x1,x1,#2              // next divisor
   udiv x2,x5,x1
   msub x3,x1,x2,x5          // compute remainder
   cmp x3,#0                 // remainder null ?
   bne 3f

2: // begin loop 2

   udiv x2,x5,x1
   msub x3,x1,x2,x5          // compute remainder
   cmp x3,#0
   csel x5,x2,x5,eq          // new value = quotient
   beq 2b

   udiv x2,x4,x1             // divide totient
   sub x4,x4,x2              // compute new totient

3:

   cmp x1,#2                 // first divisor ?
   mov x0,1
   csel x1,x0,x1,eq          // divisor = 1
   b 1b                      // and loop

4:

   cmp x5,#1                 // final value > 1
   ble 5f
   mov x0,x4                 // totient
   mov x1,x5                 // divide by value
   udiv x2,x4,x5             // totient divide by value
   sub x4,x4,x2              // compute new totient

5:

   mov x0,x4

100:

   ldp x4,x5,[sp],16         // restaur  registers 
   ldp x2,x3,[sp],16         // restaur  registers 
   ldp x1,lr,[sp],16         // restaur  registers
   ret

/***************************************************/ /* ROUTINES INCLUDE */ /***************************************************/ .include "../includeARM64.inc" </lang>

 3  9  15  27  39
 81  111  183  243  255
 327  363  471  729  2187
 2199  3063  4359  4375  5571

ALGOL 68

<lang algol68>BEGIN # find the first 20 perfect totient numbers #

   # returns the number of integers k where 1 <= k <= n that are mutually prime to n #
   PROC totient = ( INT n )INT: # algorithm from the second Go sample #
       IF   n < 3 THEN 1
       ELIF n = 3 THEN 2
       ELSE
           INT result := n;
           INT v      := n;
           INT i      := 2;
           WHILE i * i <= v DO
               IF v MOD i = 0 THEN
                   WHILE v MOD i = 0 DO v OVERAB i OD;
                   result -:= result OVER i
               FI;
               IF i = 2 THEN
                  i := 1
               FI;
               i +:= 2
           OD;
           IF v > 1 THEN result -:= result OVER v FI;
           result
        FI # totient # ;
   # find the first 20 perfect totient numbers #
   INT p count := 0;
   FOR i FROM 2 WHILE p count < 20 DO
       INT t   := totient( i );
       INT sum := t;
       WHILE t /= 1 DO
           t    := totient( t );
           sum +:= t
       OD;
       IF sum = i THEN
           # have a perfect totient #
           p count +:= 1;
           print( ( " ", whole( i, 0 ) ) )
       FI
   OD;
   print( ( newline ) )

END</lang>

Output:

 3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

APL

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

ARM Assembly

Works with: as version Raspberry Pi
or android 32 bits with application Termux

<lang ARM Assembly> /* ARM assembly Raspberry PI or android with termux */ /* program totientPerfect.s */

/* REMARK 1 : this program use routines in a include file 
  see task Include a file language arm assembly 
  for the routine affichageMess conversion10 
  see at end of this program the instruction include */

/* for constantes see task include a file in arm assembly */ /************************************/ /* Constantes */ /************************************/ .include "../constantes.inc" .equ MAXI, 20

/*********************************/ /* Initialized data */ /*********************************/ .data szMessNumber: .asciz " @ " szCarriageReturn: .asciz "\n"

/*********************************/ /* UnInitialized data */ /*********************************/ .bss sZoneConv: .skip 24 /*********************************/ /* code section */ /*********************************/ .text .global main main:

   mov r4,#2                   @ start number
   mov r6,#0                   @ line counter
   mov r7,#0                   @ result counter

1:

   mov r0,r4
   mov r5,#0                   @ totient sum

2:

   bl totient                  @ compute totient
   add r5,r5,r0                @ add totient
   cmp r0,#1
   beq 3f
   b 2b

3:

   cmp r5,r4                   @ compare number and totient sum
   bne 4f
   mov r0,r4                   @ display result if equals
   ldr r1,iAdrsZoneConv
   bl conversion10             @ call décimal conversion
   ldr r0,iAdrszMessNumber
   ldr r1,iAdrsZoneConv        @ insert conversion in message
   bl strInsertAtCharInc
   bl affichageMess            @ display message
   add r7,r7,#1
   add r6,r6,#1                @ increment indice line display
   cmp r6,#5                   @ if = 5  new line
   bne 4f
   mov r6,#0
   ldr r0,iAdrszCarriageReturn
   bl affichageMess

4:

   add r4,r4,#1                 @ increment number
   cmp r7,#MAXI                 @ maxi ?
   blt 1b                       @ and loop
   
   ldr r0,iAdrszCarriageReturn
   bl affichageMess

100: @ standard end of the program

   mov r0, #0                  @ return code
   mov r7, #EXIT               @ request to exit program
   svc #0                      @ perform the system call

iAdrszCarriageReturn: .int szCarriageReturn iAdrsZoneConv: .int sZoneConv iAdrszMessNumber: .int szMessNumber /******************************************************************/ /* compute totient of number */ /******************************************************************/ /* r0 contains number */ totient:

   push {r1-r5,lr}           @ save  registers 
   mov r4,r0                 @ totient
   mov r5,r0                 @ save number
   mov r1,#0                 @ for first divisor

1: @ begin loop

   mul r3,r1,r1              @ compute square
   cmp r3,r5                 @ compare number
   bgt 4f                    @ end 
   add r1,r1,#2              @ next divisor
   mov r0,r5
   bl division      
   cmp r3,#0                 @ remainder null ?
   bne 3f

2: @ begin loop 2

   mov r0,r5
   bl division
   cmp r3,#0
   moveq r5,r2               @ new value = quotient
   beq 2b

   mov r0,r4                 @ totient
   bl division
   sub r4,r4,r2              @ compute new totient

3:

   cmp r1,#2                 @ first divisor ?
   moveq r1,#1               @ divisor = 1
   b 1b                      @ and loop

4:

   cmp r5,#1                 @ final value > 1
   ble 5f
   mov r0,r4                 @ totient
   mov r1,r5                 @ divide by value
   bl division
   sub r4,r4,r2              @ compute new totient

5:

   mov r0,r4

100:

   pop {r1-r5,pc}             @ restaur registers

/***************************************************/ /* ROUTINES INCLUDE */ /***************************************************/ .include "../affichage.inc" </lang>

 3            9            15           27           39
 81           111          183          243          255
 327          363          471          729          2187
 2199         3063         4359         4375         5571

Arturo

Translation of: Nim

<lang rebol>totient: function [n][

   tt: new n
   nn: new n
   i: new 2

   while [nn >= i ^ 2][
       if zero? nn % i [
           while [zero? nn % i]->
               'nn / i
           'tt - tt/i
       ]
       if i = 2 -> 
           i: new 1

       'i + 2
   ]
   if nn > 1 ->
       'tt - tt/nn

   return tt

]

x: new 1 num: new 0

while [num < 20][

   tot: new x
   s: new 0

   while [tot <> 1][
       tot: totient tot
       's + tot
   ]
   if s = x [
       prints ~"|x| "
       inc 'num
   ]
   'x + 2

] print ""</lang>

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

AutoHotkey

<lang AutoHotkey>MsgBox, 262144, , % result := perfect_totient(20)

perfect_totient(n){

   count := sum := tot := 0, str:= "", m := 1    
   while (count < n) {
       tot := m, sum := 0
       while (tot != 1) {
           tot := totient(tot)
           sum += tot
       }
       if (sum = m) {
           str .= m ", "
           count++
       }
       m++
   }
   return Trim(str, ", ")

}

totient(n) {

   tot := n,     i := 2
   while (i*i <= n) {
       if !Mod(n, i) {
           while !Mod(n, i)
               n /= i
           tot -= tot / i
       }
       if (i = 2)
           i := 1
       i+=2
   }
   if (n > 1)
       tot -= tot / n
   return tot

}</lang>

Output:

3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571

AWK

syntax: GAWK -f PERFECT_TOTIENT_NUMBERS.AWK

BEGIN {

   i = 20
   printf("The first %d perfect totient numbers:\n%s\n",i,perfect_totient(i))
   exit(0)

} function perfect_totient(n, count,m,str,sum,tot) {

   for (m=1; count<n; m++) {
     tot = m
     sum = 0
     while (tot != 1) {
       tot = totient(tot)
       sum += tot
     }
     if (sum == m) {
       str = str m " "
       count++
     }
   }
   return(str)

} function totient(n, i,tot) {

   tot = n
   for (i=2; i*i<=n; i+=2) {
     if (n % i == 0) {
       while (n % i == 0) {
         n /= i
       }
       tot -= tot / i
     }
     if (i == 2) {
       i = 1
     }
   }
   if (n > 1) {
     tot -= tot / n
   }
   return(tot)

} </lang>

Output:

The first 20 perfect totient numbers:
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

BASIC

<lang BASIC>10 DEFINT A-Z 20 N=3 30 S=N: T=0 40 X=S: S=0 50 FOR I=1 TO X-1 60 A=X: B=I 70 IF B>0 THEN C=A: A=B: B=C MOD B: GOTO 70 80 IF A=1 THEN S=S+1 90 NEXT 100 T=T+S 110 IF S>1 GOTO 40 120 IF T=N THEN PRINT N,: Z=Z+1 130 N=N+2 140 IF Z<20 GOTO 30</lang>

Output:

 3             9             15            27            39
 81            111           183           243           255
 327           363           471           729           2187
 2199          3063          4359          4375          5571

BASIC256

Translation of: FreeBASIC

<lang freebasic>found = 0 curr = 3

while found < 20

   sum = Totient(curr)
   toti = sum
   while toti <> 1
       toti = Totient(toti)
       sum += toti
   end while
   if sum = curr then
       print sum
       found += 1
   end if
   curr += 1

end while end

function GCD(n, d)

   if n = 0 then return d
   if d = 0 then return n
   if n > d then return GCD(d, (n mod d))
   return GCD(n, (d mod n))

end function

function Totient(n)

   phi = 0
   for m = 1 to n
       if GCD(m, n) = 1 then phi += 1
   next m
   return phi

end function</lang>

bc

<lang bc>define gcd (i, j) {

   while(j != 0) {
       k = j
       j = i % j
       i = k
   }
   return i

}

define is_perfect_totient (num) {

   tot = 0
   for (i = 1; i < num; i++) {
       if (gcd(num, i) == 1) {
           tot += 1
       }
   }
   sum = tot + cache[tot]
   cache[num] = sum
   return num == sum

}

j = 1 count = 0

we only go to 15 (not 20) because bc is very slow

while (count <= 15) {

   if (is_perfect_totient(j)) {
       print j, " "
       count += 1
   }
   j += 1

} print "\n" quit </lang>

Output:

$ time bc -q perfect-totient.bc
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199

real    0m35,553s
user    0m35,437s
sys     0m0,030s

BCPL

<lang bcpl>get "libhdr"

let gcd(a,b) = b=0 -> a, gcd(b, a rem b)

let totient(n) = valof $( let r = 0

   for i=1 to n-1
       if gcd(n,i) = 1 then r := r + 1
   resultis r

$)

let perfect(n) = valof $( let sum = 0 and x = n

   $(  x := totient(x)
       sum := sum + x
   $) repeatuntil x = 1
   resultis sum = n

$)

let start() be $( let seen = 0 and n = 3

   while seen < 20
   $(  if perfect(n)
       $(  writef("%N ", n)
           seen := seen + 1
       $)
       n := n + 2
   $)
   wrch('*N')

$)</lang>

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

C

Calculates as many perfect Totient numbers as entered on the command line. <lang C>#include<stdlib.h>

include<stdio.h>

long totient(long n){ long tot = n,i;

for(i=2;i*i<=n;i+=2){ if(n%i==0){ while(n%i==0) n/=i; tot-=tot/i; }

if(i==2) i=1; }

if(n>1) tot-=tot/n;

return tot; }

long* perfectTotients(long n){ long *ptList = (long*)malloc(n*sizeof(long)), m,count=0,sum,tot;

for(m=1;count<n;m++){ tot = m; sum = 0;

       while(tot != 1){
           tot = totient(tot);
           sum += tot;
       }
       if(sum == m)

ptList[count++] = m;

return ptList; }

long main(long argC, char* argV[]) { long *ptList,i,n;

if(argC!=2) printf("Usage : %s <number of perfect Totient numbers required>",argV[0]); else{ n = atoi(argV[1]);

ptList = perfectTotients(n);

printf("The first %d perfect Totient numbers are : \n[",n);

for(i=0;i<n;i++) printf(" %d,",ptList[i]); printf("\b]"); }

return 0; } </lang> Output for multiple runs, a is the default executable file name produced by GCC

C:\rossetaCode>a 10
The first 10 perfect Totient numbers are :
[ 3, 9, 15, 27, 39, 81, 111, 183, 243, 255]
C:\rossetaCode>a 20
The first 20 perfect Totient numbers are :
[ 3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571]
C:\rossetaCode>a 30
The first 30 perfect Totient numbers are :
[ 3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571, 6561, 8751, 15723, 19683, 36759, 46791, 59049, 65535, 140103, 177147]
C:\rossetaCode>a 40
The first 40 perfect Totient numbers are :
[ 3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571, 6561, 8751, 15723, 19683, 36759, 46791, 59049, 65535, 140103, 177147, 208191, 441027, 531441, 1594323, 4190263, 4782969, 9056583, 14348907, 43046721, 57395631]

C++

<lang cpp>#include <cassert>

include <iostream>
include <vector>

class totient_calculator { public:

   explicit totient_calculator(int max) : totient_(max + 1) {
       for (int i = 1; i <= max; ++i)
           totient_[i] = i;
       for (int i = 2; i <= max; ++i) {
           if (totient_[i] < i)
               continue;
           for (int j = i; j <= max; j += i)
               totient_[j] -= totient_[j] / i;
       }
   }
   int totient(int n) const {
       assert (n >= 1 && n < totient_.size());
       return totient_[n];
   }
   bool is_prime(int n) const {
       return totient(n) == n - 1;
   }

private:

   std::vector<int> totient_;

};

bool perfect_totient_number(const totient_calculator& tc, int n) {

   int sum = 0;
   for (int m = n; m > 1; ) {
       int t = tc.totient(m);
       sum += t;
       m = t;
   }
   return sum == n;

}

int main() {

   totient_calculator tc(10000);
   int count = 0, n = 1;
   std::cout << "First 20 perfect totient numbers:\n";
   for (; count < 20; ++n) {
       if (perfect_totient_number(tc, n))  {
           if (count > 0)
               std::cout << ' ';
           ++count;
           std::cout << n;
       }
   }
   std::cout << '\n';
   return 0;

}</lang>

Output:

First 20 perfect totient numbers:
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

CLU

<lang clu>gcd = proc (a, b: int) returns (int)

   while b ~= 0 do
       a, b := b, a//b
   end
   return(a)

end gcd

totient = proc (n: int) returns (int)

   tot: int := 0
   for i: int in int$from_to(1,n-1) do
       if gcd(n,i)=1 then tot := tot + 1 end
   end
   return(tot)

end totient

perfect = proc (n: int) returns (bool)

   sum: int := 0
   x: int := n
   while true do 
       x := totient(x)
       sum := sum + x
       if x=1 then break end
   end
   return(sum = n)

end perfect

start_up = proc ()

   po: stream := stream$primary_output()
   seen: int := 0
   n: int := 3
   while seen < 20 do
       if perfect(n) then
           stream$puts(po, int$unparse(n) || " ")
           seen := seen + 1
       end
       n := n + 2
   end

end start_up</lang>

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Cowgol

<lang cowgol>include "cowgol.coh";

sub gcd(a: uint16, b: uint16): (r: uint16) is

   while b != 0 loop
       r := a;
       a := b;
       b := r % b;
   end loop;
   r := a;

end sub;

sub totient(n: uint16): (tot: uint16) is

   var i: uint16 := 1;
   tot := 0;
   while i < n loop
       if gcd(n,i) == 1 then
           tot := tot + 1;
       end if;
       i := i + 1;
   end loop;

end sub;

sub totientSum(n: uint16): (sum: uint16) is

   var x := n;
   sum := 0;
   while x > 1 loop
       x := totient(x);
       sum := sum + x;
   end loop;

end sub;

var seen: uint8 := 0; var n: uint16 := 3; while seen < 20 loop

   if totientSum(n) == n then
       print_i16(n);
       print_char(' ');
       seen := seen + 1;
   end if;
   n := n + 2;

end loop; print_nl();</lang>

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Dart

<lang dart>import "dart:io";

var cache = List<int>.filled(10000, 0, growable: true);

void main() {

   cache[0] = 0;
   var count = 0;
   var i = 1;
   while (count < 20) {
       if (is_perfect_totient(i)) {
           stdout.write("$i ");
           count++;
       }
       i++;
   }
   print(" ");

}

bool is_perfect_totient(n) {

   var tot = 0;
   for (int i = 1; i < n; i++ ) {
      if (i.gcd(n) == 1) {
           tot++;
       }
   }
   int sum = tot + cache[tot];
   cache[n] = sum;
   return n == sum;

} </lang>

Delphi

Library: System.SysUtils

Translation of: Go

<lang Delphi> program Perfect_totient_numbers;

{$APPTYPE CONSOLE}

uses

 System.SysUtils;

function totient(n: Integer): Integer; begin

 var tot := n;
 var i := 2;
 while i * i <= n do
 begin
   if (n mod i) = 0 then
   begin
     while (n mod i) = 0 do
       n := n div i;
     dec(tot, tot div i);
   end;
   if i = 2 then
     i := 1;
   inc(i, 2);
 end;
 if n > 1 then
   dec(tot, tot div n);
 Result := tot;

end;

begin

 var perfect: TArray<Integer>;
 var n := 1;
 while length(perfect) < 20 do
 begin
   var tot := n;
   var sum := 0;
   while tot <> 1 do
   begin
     tot := totient(tot);
     inc(sum, tot);
   end;
   if sum = n then
   begin
     SetLength(perfect, Length(perfect) + 1);
     perfect[High(perfect)] := n;
   end;
   inc(n, 2);
 end;
 writeln('The first 20 perfect totient numbers are:');
 write('[');
 for var e in perfect do
   write(e, ' ');
 writeln(']');
 readln;

end.</lang>

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Draco

<lang draco>proc nonrec gcd(word a, b) word:

   word c;
   while b ~= 0 do 
       c := a;
       a := b;
       b := c % b
   od;
   a

corp

proc nonrec totient(word n) word:

   word r, i;
   r := 0;
   for i from 1 upto n-1 do
       if gcd(n,i) = 1 then r := r+1 fi
   od;
   r

corp

proc nonrec perfect(word n) bool:

   word sum, x;
   sum := 0;
   x := n;
   while
       x := totient(x);
       sum := sum + x;
       x ~= 1
   do od;
   sum = n

corp

proc nonrec main() void:

   word seen, n;
   seen := 0;
   n := 3;
   while seen < 20 do
       if perfect(n) then
           write(n, " ");
           seen := seen + 1
       fi;
       n := n + 2
   od

corp</lang>

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Factor

<lang factor>USING: formatting kernel lists lists.lazy math math.primes.factors ;

perfect? ( n -- ? )

   [ 0 ] dip dup [ dup 2 < ] [ totient tuck [ + ] 2dip ] until
   drop = ;

20 1 lfrom [ perfect? ] lfilter ltake list>array "%[%d, %]\n" printf</lang>

Output:

{ 3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571 }

FreeBASIC

Uses the code from the Totient Function example as an include.

<lang freebasic>#include"totient.bas"

dim as uinteger found = 0, curr = 3, sum, toti

while found < 20

   sum = totient(curr)
   toti = sum
   do
       toti = totient(toti)
       sum += toti
   loop while toti <> 1  
   if sum = curr then
       print sum
       found += 1
   end if
   curr += 1

wend</lang>

Go

<lang go>package main

import "fmt"

func gcd(n, k int) int {

   if n < k || k < 1 {
       panic("Need n >= k and k >= 1")
   }

   s := 1
   for n&1 == 0 && k&1 == 0 {
       n >>= 1
       k >>= 1
       s <<= 1
   }

   t := n
   if n&1 != 0 {
       t = -k
   }
   for t != 0 {
       for t&1 == 0 {
           t >>= 1
       }
       if t > 0 {
           n = t
       } else {
           k = -t
       }
       t = n - k
   }
   return n * s

}

func totient(n int) int {

   tot := 0
   for k := 1; k <= n; k++ {
       if gcd(n, k) == 1 {
           tot++
       }
   }
   return tot

}

func main() {

   var perfect []int
   for n := 1; len(perfect) < 20; n += 2 {
       tot := n
       sum := 0
       for tot != 1 {
           tot = totient(tot)
           sum += tot
       }
       if sum == n {
           perfect = append(perfect, n)
       }
   }
   fmt.Println("The first 20 perfect totient numbers are:")
   fmt.Println(perfect)

}</lang>

Output:

The first 20 perfect totient numbers are:
[3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571]

The following much quicker version uses Euler's product formula rather than repeated invocation of the gcd function to calculate the totient: <lang go>package main

import "fmt"

func totient(n int) int {

   tot := n
   for i := 2; i*i <= n; i += 2 {
       if n%i == 0 {
           for n%i == 0 {
               n /= i
           }
           tot -= tot / i
       }
       if i == 2 {
           i = 1
       }
   }
   if n > 1 {
       tot -= tot / n
   }
   return tot

}

func main() {

   var perfect []int
   for n := 1; len(perfect) < 20; n += 2 {
       tot := n
       sum := 0
       for tot != 1 {
           tot = totient(tot)
           sum += tot
       }
       if sum == n {
           perfect = append(perfect, n)
       }
   }
   fmt.Println("The first 20 perfect totient numbers are:")
   fmt.Println(perfect)

}</lang>

The output is the same as before.

Haskell

<lang haskell>perfectTotients :: [Int] perfectTotients =

 filter ((==) <*> (succ . sum . tail . takeWhile (1 /=) . iterate φ)) [2 ..]

φ :: Int -> Int φ = memoize (\n -> length (filter ((1 ==) . gcd n) [1 .. n]))

memoize :: (Int -> a) -> (Int -> a) memoize f = (!!) (f <$> [0 ..])

main :: IO () main = print $ take 20 perfectTotients</lang>

Output:

[3,9,15,27,39,81,111,183,243,255,327,363,471,729,2187,2199,3063,4359,4375,5571]

J

<lang J> Until =: conjunction def 'u^:(0 -: v)^:_' Filter =: (#~`)(`:6) totient =: 5&p: totient_chain =: [: }. (, totient@{:)Until(1={:) ptnQ =: (= ([: +/ totient_chain))&> </lang> With these definitions I've found the first 28 perfect totient numbers

   PTN =: ptnQ Filter >: i.99999
   #PTN
28
   PTN
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571 6561 8751 15723 19683 36759 46791 59049 65535

Java

<lang Java> import java.util.ArrayList; import java.util.List;

public class PerfectTotientNumbers {

   public static void main(String[] args) {
       computePhi();
       int n = 20;
       System.out.printf("The first %d perfect totient numbers:%n%s%n", n, perfectTotient(n));
   }
   
   private static final List<Integer> perfectTotient(int n) {
       int test = 2;
       List<Integer> results = new ArrayList<Integer>();
       for ( int i = 0 ; i < n ; test++ ) {
           int phiLoop = test;
           int sum = 0;
           do {
               phiLoop = phi[phiLoop];
               sum += phiLoop;
           } while ( phiLoop > 1);
           if ( sum == test ) {
               i++;
               results.add(test);
           }
       }
       return results;
   }

   private static final int max = 100000;
   private static final int[] phi = new int[max+1];

   private static final void computePhi() {
       for ( int i = 1 ; i <= max ; i++ ) {
           phi[i] = i;
       }
       for ( int i = 2 ; i <= max ; i++ ) {
           if (phi[i] < i) continue;
           for ( int j = i ; j <= max ; j += i ) {
               phi[j] -= phi[j] / i;
           }
       }
   }

} </lang>

Output:

The first 20 perfect totient numbers:
[3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571]

JavaScript

<lang javascript>(() => {

   'use strict';

   // main :: IO ()
   const main = () =>
       showLog(
           take(20, perfectTotients())
       );

   // perfectTotients :: Generator [Int]
   function* perfectTotients() {
       const
           phi = memoized(
               n => length(
                   filter(
                       k => 1 === gcd(n, k),
                       enumFromTo(1, n)
                   )
               )
           ),
           imperfect = n => n !== sum(
               tail(iterateUntil(
                   x => 1 === x,
                   phi,
                   n
               ))
           );
       let ys = dropWhileGen(imperfect, enumFrom(1))
       while (true) {
           yield ys.next().value - 1;
           ys = dropWhileGen(imperfect, ys)
       }
   }

   // GENERIC FUNCTIONS ----------------------------

   // abs :: Num -> Num
   const abs = Math.abs;

   // dropWhileGen :: (a -> Bool) -> Gen [a] -> [a]
   const dropWhileGen = (p, xs) => {
       let
           nxt = xs.next(),
           v = nxt.value;
       while (!nxt.done && p(v)) {
           nxt = xs.next();
           v = nxt.value;
       }
       return xs;
   };

   // enumFrom :: Int -> [Int]
   function* enumFrom(x) {
       let v = x;
       while (true) {
           yield v;
           v = 1 + v;
       }
   }

   // enumFromTo :: Int -> Int -> [Int]
   const enumFromTo = (m, n) =>
       m <= n ? iterateUntil(
           x => n <= x,
           x => 1 + x,
           m
       ) : [];

   // filter :: (a -> Bool) -> [a] -> [a]
   const filter = (f, xs) => xs.filter(f);

   // gcd :: Int -> Int -> Int
   const gcd = (x, y) => {
       const
           _gcd = (a, b) => (0 === b ? a : _gcd(b, a % b)),
           abs = Math.abs;
       return _gcd(abs(x), abs(y));
   };

   // iterateUntil :: (a -> Bool) -> (a -> a) -> a -> [a]
   const iterateUntil = (p, f, x) => {
       const vs = [x];
       let h = x;
       while (!p(h))(h = f(h), vs.push(h));
       return vs;
   };

   // Returns Infinity over objects without finite length.
   // This enables zip and zipWith to choose the shorter
   // argument when one is non-finite, like cycle, repeat etc

   // length :: [a] -> Int
   const length = xs =>
       (Array.isArray(xs) || 'string' === typeof xs) ? (
           xs.length
       ) : Infinity;

   // memoized :: (a -> b) -> (a -> b)
   const memoized = f => {
       const dctMemo = {};
       return x => {
           const v = dctMemo[x];
           return undefined !== v ? v : (dctMemo[x] = f(x));
       };
   };

   // showLog :: a -> IO ()
   const showLog = (...args) =>
       console.log(
           args
           .map(JSON.stringify)
           .join(' -> ')
       );

   // sum :: [Num] -> Num
   const sum = xs => xs.reduce((a, x) => a + x, 0);

   // tail :: [a] -> [a]
   const tail = xs => 0 < xs.length ? xs.slice(1) : [];

   // take :: Int -> [a] -> [a]
   // take :: Int -> String -> String
   const take = (n, xs) =>
       'GeneratorFunction' !== xs.constructor.constructor.name ? (
           xs.slice(0, n)
       ) : [].concat.apply([], Array.from({
           length: n
       }, () => {
           const x = xs.next();
           return x.done ? [] : [x.value];
       }));

   // MAIN ---
   main();

})();</lang>

Output:

[3,9,15,27,39,81,111,183,243,255,327,363,471,729,2187,2199,3063,4359,4375,5571]

jq

Adapted from Julia

Works with: jq

Works with gojq, the Go implementation of jq

One small point of interest in the following implementation is the way the cacheing of totient values is accomplished using a helper function (`cachephi`). <lang jq>

jq optimizes the recursive call of _gcd in the following:

def gcd(a;b):

 def _gcd:
   if .[1] != 0 then [.[1], .[0] % .[1]] | _gcd else .[0] end;
 [a,b] | _gcd ;

def count(s): reduce s as $x (0; .+1);

A perfect totient number is an integer that is equal to the sum of its iterated totients.
aka Euler's phi function

def totient:

 . as $n
 | count( range(0; .) | select( gcd($n; .) == 1) );

input: the cache
output: the updated cache

def cachephi($n):

 ($n|tostring) as $s
 | if (has($s)|not) then .[$s] = ($n|totient) else . end ;

Emit the stream of perfect totients

def perfect_totients:

 . as $n
 | foreach range(1; infinite) as $i ({cache: {}};
       .tot = $i
       | .tsum = 0
       | until( .tot == 1;

.tot as $tot

            | .cache |= cachephi($tot)
            | .tot = .cache[$tot|tostring]
            | .tsum += .tot);
       if .tsum == $i then $i else empty end );

"The first 20 perfect totient numbers:", limit(20; perfect_totients)</lang>

Output:

The first 20 perfect totient numbers:
3
9
15
27
39
81
111
183
243
255
327
363
471
729
2187
2199
3063
4359
4375
5571

Julia

<lang julia>using Primes

eulerphi(n) = (r = one(n); for (p,k) in factor(abs(n)) r *= p^(k-1)*(p-1) end; r)

const phicache = Dict{Int, Int}()

cachedphi(n) = (if !haskey(phicache, n) phicache[n] = eulerphi(n) end; phicache[n])

function perfecttotientseries(n)

   perfect = Vector{Int}()
   i = 1
   while length(perfect) < n
       tot = i
       tsum = 0
       while tot != 1
           tot = cachedphi(tot)
           tsum += tot
       end
       if tsum == i
           push!(perfect, i)
       end
       i += 1
   end
   perfect

end

println("The first 20 perfect totient numbers are: $(perfecttotientseries(20))") println("The first 40 perfect totient numbers are: $(perfecttotientseries(40))")

</lang>

Output:


The first 20 perfect totient numbers are: [3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571]
The first 40 perfect totient numbers are: [3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571, 6561, 8751, 15723, 19683, 36759, 46791, 59049, 65535, 140103, 177147, 208191, 441027, 531441, 1594323, 4190263, 4782969, 9056583, 14348907, 43046721, 57395631]

Kotlin

Translation of: Go

<lang scala>// Version 1.3.21

fun totient(n: Int): Int {

   var tot = n
   var nn = n
   var i = 2
   while (i * i <= nn) {
       if (nn % i == 0) {
           while (nn % i == 0) nn /= i
           tot -= tot / i
       }
       if (i == 2) i = 1
       i += 2
   }
   if (nn > 1) tot -= tot / nn
   return tot

}

fun main() {

   val perfect = mutableListOf<Int>()
   var n = 1
   while (perfect.size < 20) {
       var tot = n
       var sum = 0
       while (tot != 1) {
           tot = totient(tot)
           sum += tot
       }
       if (sum == n) perfect.add(n)
       n += 2
   }
   println("The first 20 perfect totient numbers are:")
   println(perfect)

}</lang>

Output:

The first 20 perfect totient numbers are:
[3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571]

Lua

<lang Lua>local function phi(n)

  assert(type(n) == 'number', 'n must be a number!')
  local result, i = n, 2
  while i <= n do
     if n % i == 0 then

while n % i == 0 do n = n // i end result = result - (result // i)

     end
     if i == 2 then i = 1 end
     i = i + 2
  end
  if n > 1 then result = result - (result // n) end
  return result

end

local function phi_iter(n)

  assert(type(n) == 'number', 'n must be a number!')
  if n == 2 then
     return phi(n) + 0
  else
     return phi(n) + phi_iter(phi(n))
  end

end

local i, count = 2, 0 while count ~= 20 do

  if i == phi_iter(i) then
     io.write(i, ' ')
     count = count + 1
  end
  i = i + 1

end </lang>

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

MAD

<lang MAD> NORMAL MODE IS INTEGER

           INTERNAL FUNCTION(Y,Z)
           ENTRY TO GCD.
           A = Y
           B = Z

LOOP WHENEVER A.E.B, FUNCTION RETURN A

           WHENEVER A.G.B, A = A-B 
           WHENEVER A.L.B, B = B-A
           TRANSFER TO LOOP
           END OF FUNCTION
           
           INTERNAL FUNCTION(C)
           ENTRY TO TOTENT.
           E = 0
           THROUGH LOOP, FOR D=1, 1, D.GE.C

LOOP WHENEVER GCD.(C,D).E.1, E = E+1

           FUNCTION RETURN E
           END OF FUNCTION
           
           INTERNAL FUNCTION(G)
           ENTRY TO PERFCT.
           H = G
           I = 0

LOOP H = TOTENT.(H)

           I = I+H
           WHENEVER H.G.1, TRANSFER TO LOOP
           FUNCTION RETURN I.E.G
           END OF FUNCTION
           
           SEEN = 0
           THROUGH LOOP, FOR N=3, 2, SEEN.GE.20
           WHENEVER PERFCT.(N)
               SEEN = SEEN+1
               PRINT FORMAT FMT,N
           END OF CONDITIONAL

LOOP CONTINUE

           VECTOR VALUES FMT = $I9*$
           END OF PROGRAM </lang>

Output:

Maple

<lang Maple>iterated_totient := proc(n::posint, total)

if NumberTheory:-Totient(n) = 1 then
  return total + 1;
else
  return iterated_totient(NumberTheory:-Totient(n), total + NumberTheory:-Totient(n));
end if;

end proc:

isPerfect := n -> evalb(iterated_totient(n, 0) = n):

count := 0: num_list := []: for i while count < 20 do

if isPerfectTotient(i) then
 num_list := [op(num_list), i];
 count := count + 1;
end if;

end do; num_list;</lang>

Output:

[3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571]

Mathematica / Wolfram Language

<lang Mathematica>ClearAll[PerfectTotientNumberQ] PerfectTotientNumberQ[n_Integer] := Total[Rest[Most[FixedPointList[EulerPhi, n]]]] == n res = {}; i = 0; While[Length[res] < 20,

i++;
If[PerfectTotientNumberQ[i], AppendTo[res, i]]
]

res</lang>

Output:

{3,9,15,27,39,81,111,183,243,255,327,363,471,729,2187,2199,3063,4359,4375,5571}

Modula-2

<lang modula2>MODULE PerfectTotient; FROM InOut IMPORT WriteCard, WriteLn;

CONST Amount = 20; VAR n, seen: CARDINAL;

PROCEDURE GCD(a, b: CARDINAL): CARDINAL; VAR c: CARDINAL; BEGIN

   WHILE b # 0 DO
       c := a MOD b;
       a := b;
       b := c;
   END;
   RETURN a;

END GCD;

PROCEDURE Totient(n: CARDINAL): CARDINAL; VAR i, tot: CARDINAL; BEGIN

   tot := 0;
   FOR i := 1 TO n/2 DO
       IF GCD(n,i) = 1 THEN
           tot := tot + 1;
       END;
   END;
   RETURN tot;

END Totient;

PROCEDURE Perfect(n: CARDINAL): BOOLEAN; VAR sum, x: CARDINAL; BEGIN

   sum := 0;
   x := n;
   REPEAT
       x := Totient(x);
       sum := sum + x;
   UNTIL x = 1;
   RETURN sum = n;

END Perfect;

BEGIN

   seen := 0;
   n := 3;
   WHILE seen < Amount DO
       IF Perfect(n) THEN
           WriteCard(n,5);
           seen := seen + 1;
           IF seen MOD 14 = 0 THEN
               WriteLn();
           END;
       END;
       n := n + 2;
   END;
   WriteLn();

END PerfectTotient.</lang>

Output:

    3    9   15   27   39   81  111  183  243  255  327  363  471  729
 2187 2199 3063 4359 4375 5571

Nim

<lang nim>import strformat

func totient(n: int): int =

 var tot = n
 var nn = n
 var i = 2
 while i * i <= nn:
   if nn mod i == 0:
     while nn mod i == 0:
       nn = nn div i
     dec tot, tot div i
   if i == 2:
     i = 1
   inc i, 2
 if nn > 1:
   dec tot, tot div nn
 tot

var n = 1 var num = 0 echo "The first 20 perfect totient numbers are:" while num < 20:

 var tot = n
 var sum = 0
 while tot != 1:
   tot = totient(tot)
   inc sum, tot
 if sum == n:
   write(stdout, fmt"{n} ")
   inc num
 inc n, 2

write(stdout, "\n")</lang>

Output:

The first 20 perfect totient numbers are:
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Pascal

I am using a really big array to calculate the Totient of every number up to 1.162.261.467, the 46.te perfect totient number. ( I can only test up to 1.5e9 before I get - out of memory ( 6.5 GB ) ). I'm doing this, by using only prime numbers to calculate the Totientnumbers. After that I sum up the totient numbers Tot[i] := Tot[i]+Tot[Tot[i]]; Tot[Tot[i]] is always < Tot[i], so it is already calculated. So I needn't calculations going trough so whole array ending up in Tot[2].
With limit 57395631 it takes "real 0m2,025s "
The c-program takes "real 3m12,481s"
A test with using floating point/SSE is by 2 seconds faster for 46.th perfect totient number, with the coming new Version of Freepascal 3.2.0 <lang pascal>program Perftotient; {$IFdef FPC}

 {$MODE DELPHI} {$CodeAlign proc=32,loop=1}

{$IFEND} uses

 sysutils;

const

 cLimit = 57395631;//177147;//4190263;//57395631;//1162261467;//

//global var

 TotientList : array of LongWord;
 Sieve : Array of byte;
 SolList : array of LongWord;
 T1,T0 : INt64;

procedure SieveInit(svLimit:NativeUint); var

 pSieve:pByte;
 i,j,pr :NativeUint;

Begin

 svlimit := (svLimit+1) DIV 2;
 setlength(sieve,svlimit+1);
 pSieve := @Sieve[0];
 For i := 1 to svlimit do
 Begin
   IF pSieve[i]= 0 then
   Begin
     pr := 2*i+1;
     j := (sqr(pr)-1) DIV 2;
     IF  j> svlimit then
       BREAK;
     repeat
       pSieve[j]:= 1;
       inc(j,pr);
     until j> svlimit;
   end;
 end;
 pr := 0;
 j := 0;
 For i := 1 to svlimit do
 Begin
   IF pSieve[i]= 0 then
   Begin
     pSieve[j] := i-pr;
     inc(j);
     pr := i;
   end;
 end;
 setlength(sieve,j);

end;

procedure TotientInit(len: NativeUint); var

 pTotLst : pLongWord;
 pSieve  : pByte;
 test : double;
 i: NativeInt;
 p,j,k,svLimit : NativeUint;

Begin

 SieveInit(len);
 T0:= GetTickCount64;
 setlength(TotientList,len+12);
 pTotLst := @TotientList[0];

//Fill totient with simple start values for odd and even numbers //and multiples of 3

 j := 1;
 k := 1;// k == j DIV 2
 p := 1;// p == j div 3;
 repeat
   pTotLst[j] := j;//1
   pTotLst[j+1] := k;//2 j DIV 2; //2
   inc(k);
   inc(j,2);
   pTotLst[j] := j-p;//3
   inc(p);
   pTotLst[j+1] := k;//4  j div 2
   inc(k);
   inc(j,2);
   pTotLst[j] := j;//5
   pTotLst[j+1] := p;//6   j DIV 3 <=  (div 2) * 2 DIV/3
   inc(j,2);
   inc(p);
   inc(k);
 until j>len+6;

//correct values of totient by prime factors

 svLimit := High(sieve);
 p := 3;// starting after 3
 pSieve := @Sieve[svLimit+1];
 i := -svlimit;
 repeat
   p := p+2*pSieve[i];
   j := p;

// Test := (1-1/p);

   while j <= cLimit do
   Begin

// pTotLst[j] := trunc(pTotLst[j]*Test);

     k:= pTotLst[j];
     pTotLst[j]:= k-(k DIV p);
     inc(j,p);
   end;
   inc(i);
 until i=0;

 T1:= GetTickCount64;
 writeln('totient calculated in ',T1-T0,' ms');
 setlength(sieve,0);

end;

function GetPerfectTotient(len: NativeUint):NativeUint; var

 pTotLst : pLongWord;
 i,sum: NativeUint;

Begin

 T0:= GetTickCount64;
 pTotLst := @TotientList[0];
 setlength(SolList,100);
 result := 0;
 For i := 3 to Len do
 Begin
   sum := pTotLst[i];
   pTotLst[i] := sum+pTotLst[sum];
 end;
 //Check for solution ( IF ) in seperate loop ,reduces time consuption ~ 12% for this function
 For i := 3 to Len do
   IF pTotLst[i] =i then
   Begin
     SolList[result] := i;
     inc(result);
   end;

 T1:= GetTickCount64;
 setlength(SolList,result);
 writeln('calculated totientsum in ',T1-T0,' ms');
 writeln('found ',result,' perfect totient numbers');

end;

var

 j,k : NativeUint;

Begin

 TotientInit(climit);
 GetPerfectTotient(climit);
 k := 0;
 For j := 0 to High(Sollist) do
 Begin
   inc(k);
   if k > 4 then
   Begin
     writeln(Sollist[j]);
     k := 0;
   end
   else
     write(Sollist[j],',');
 end;

end.</lang>

OutPut

compiled with fpc 3.0.4 -O3 "Perftotient.pas"
totient calculated in 32484 ms
calculated totientsum in 8244 ms
found 46 perfect totient numbers
3,9,15,27,39
81,111,183,243,255
327,363,471,729,2187
2199,3063,4359,4375,5571
6561,8751,15723,19683,36759
46791,59049,65535,140103,177147
208191,441027,531441,1594323,4190263
4782969,9056583,14348907,43046721,57395631
129140163,172186887,236923383,387420489,918330183
1162261467,
real  0m47,690s
*
found 40 perfect totient numbers
...
real  0m2,025s

Perl

Library: ntheory

<lang perl>use ntheory qw(euler_phi);

sub phi_iter {

   my($p) = @_;
   euler_phi($p) + ($p == 2 ? 0 : phi_iter(euler_phi($p)));

}

my @perfect; for (my $p = 2; @perfect < 20 ; ++$p) {

   push @perfect, $p if $p == phi_iter($p);

}

printf "The first twenty perfect totient numbers:\n%s\n", join ' ', @perfect;</lang>

Output:

The first twenty Perfect totient numbers:
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Phix

Translation of: Go

with javascript_semantics
function totient(integer n)
    integer tot = n, i = 2
    while i*i<=n do
        if mod(n,i)=0 then
            while true do
                n /= i
                if mod(n,i)!=0 then exit end if
            end while
            tot -= tot/i
        end if
        i += iff(i=2?1:2)
    end while
    if n>1 then
        tot -= tot/n
    end if
    return tot
end function
 
sequence perfect = {}
integer n = 1
while length(perfect)<20 do
    integer tot = n,
            tsum = 0
    while tot!=1 do
        tot = totient(tot)
        tsum += tot
    end while
    if tsum=n then
        perfect &= n
    end if
    n += 2
end while
printf(1,"The first 20 perfect totient numbers are:\n")
?perfect

Output:

The first 20 perfect totient numbers are:
{3,9,15,27,39,81,111,183,243,255,327,363,471,729,2187,2199,3063,4359,4375,5571}

PicoLisp

<lang PicoLisp>(gc 16) (de gcd (A B)

  (until (=0 B)
     (let M (% A B)
        (setq A B B M) ) )
  (abs A) )

(de totient (N)

  (let C 0
     (for I N
        (and (=1 (gcd N I)) (inc 'C)) )
     C ) )

(de totients (NIL)

  (let (C 0  N 1)
     (while (> 20 C)
        (let (Cur N  S 0)
           (while (> Cur 1)
              (inc 'S (setq Cur (totient Cur))) )
           (when (= S N)
              (inc 'C)
              (prin N " ")
              (flush) )
           (inc 'N 2) ) )
     (prinl) ) )

(totients)</lang>

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

PILOT

<lang pilot>C :z=0

 :n=3

num

C :s=0

 :x=n

perfect

C :t=0

 :i=1

totient

C :a=x

 :b=i

gcd

C :c=a-b*(a/b)

 :a=b
 :b=c

J (b>0):*gcd C (a=1):t=t+1 C :i=i+1 J (i<=x-1):*totient C :x=t

 :s=s+x

J (x<>1):*perfect T (s=n):#n C (s=n):z=z+1 C :n=n+2 J (z<20):*num E :</lang>

Output:

PL/I

<lang pli>perfectTotient: procedure options(main);

   gcd: procedure(aa, bb) returns(fixed);
       declare (aa, bb, a, b, c) fixed;
       a = aa; 
       b = bb;
       do while(b ^= 0);
           c = a;
           a = b;
           b = mod(c, b);
       end;
       return(a);
   end gcd;
   
   totient: procedure(n) returns(fixed);
       declare (i, n, s) fixed;
       s = 0;
       do i=1 to n-1;
           if gcd(n,i) = 1 then s = s+1;
       end;
       return(s);
   end totient;
   
   perfect: procedure(n) returns(bit);
       declare (n, x, sum) fixed;
       sum = 0;
       x = n;
       do while(x > 1);
           x = totient(x);
           sum = sum + x;
       end;
       return(sum = n);
   end perfect;
   
   declare (n, seen) fixed;
   seen = 0;
   do n=3 repeat(n+2) while(seen<20);
       if perfect(n) then do;
           put edit(n) (F(5));
           seen = seen+1;
           if mod(seen,10) = 0 then put skip;
       end;
   end;

end perfectTotient;</lang>

Output:

    3    9   15   27   39   81  111  183  243  255
  327  363  471  729 2187 2199 3063 4359 4375 5571

PL/M

<lang plm>100H: BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS; EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT; PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;

PRINT$NUMBER: PROCEDURE (N);

   DECLARE S (7) BYTE INITIAL ('..... $');
   DECLARE (N, P) ADDRESS, C BASED P BYTE;
   P = .S(5);

DIGIT:

   P = P - 1;
   C = N MOD 10 + '0';
   N = N / 10;
   IF N > 0 THEN GO TO DIGIT;
   CALL PRINT(P);

END PRINT$NUMBER;

GCD: PROCEDURE (A, B) ADDRESS;

   DECLARE (A, B, C) ADDRESS;
   DO WHILE B <> 0;
       C = A;
       A = B;
       B = C MOD B;
   END;
   RETURN A;

END GCD;

TOTIENT: PROCEDURE (N) ADDRESS;

   DECLARE (I, N, S) ADDRESS;
   S = 0;
   DO I=1 TO N-1;
       IF GCD(N,I) = 1 THEN S = S+1;
   END;
   RETURN S;

END TOTIENT;

PERFECT: PROCEDURE (N) BYTE;

   DECLARE (N, X, SUM) ADDRESS;
   X = N;
   SUM = 0;
   DO WHILE X > 1;
       X = TOTIENT(X);
       SUM = SUM + X;
   END;
   RETURN SUM = N;

END PERFECT;

DECLARE N ADDRESS, SEEN BYTE; SEEN = 0; N = 3; DO WHILE SEEN < 20;

   IF PERFECT(N) THEN DO;
       CALL PRINT$NUMBER(N);
       SEEN = SEEN+1;
   END;
   N = N+2;

END; CALL EXIT; EOF</lang>

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Python

<lang python>from math import gcd from functools import lru_cache from itertools import islice, count

@lru_cache(maxsize=None) def φ(n):

   return sum(1 for k in range(1, n + 1) if gcd(n, k) == 1)

def perfect_totient():

   for n0 in count(1):
       parts, n = 0, n0
       while n != 1:
           n = φ(n)
           parts += n
       if parts == n0:
           yield n0

if __name__ == '__main__':

   print(list(islice(perfect_totient(), 20)))</lang>

Output:

[3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571]

Alternatively, by composition of generic functions:

<lang python>Perfect totient numbers

from functools import lru_cache from itertools import count, islice from math import gcd import operator

perfectTotients :: () -> [Int]

def perfectTotients():

   An unbounded sequence of perfect totients.
      OEIS A082897
   
   def p(x):
       return x == 1 + sum(
           iterateUntil(eq(1))(
               phi
           )(x)[1:]
       )
   return filter(p, count(2))

@lru_cache(maxsize=None) def phi(n):

   Euler's totient function.
      The count of integers up to n which
      are relatively prime to n.
   
   return len([
       x for x in enumFromTo(1)(n)
       if 1 == gcd(n, x)
   ])

TEST ----------------------------------------------------
main :: IO ()

def main():

   First twenty perfect totient numbers
   print(
       take(20)(
           perfectTotients()
       )
   )

GENERIC -------------------------------------------------

curry :: ((a, b) -> c) -> a -> b -> c

def curry(f):

   A curried function derived
      from an uncurried function.
   
   return lambda x: lambda y: f(x, y)

enumFromTo :: Int -> Int -> [Int]

def enumFromTo(m):

   Enumeration of integer values [m..n]
   return lambda n: range(m, 1 + n)

eq (==) :: Eq a => a -> a -> Bool

eq = curry(operator.eq) True if a and b are comparable and a equals b.

iterateUntil :: (a -> Bool) -> (a -> a) -> a -> [a]

def iterateUntil(p):

   A list of the results of repeated
      applications of f, until p matches.
   
   def go(f, x):
       vs = []
       v = x
       while True:
           if p(v):
               break
           vs.append(v)
           v = f(v)
       return vs

   return lambda f: lambda x: go(f, x)

take :: Int -> [a] -> [a]
take :: Int -> String -> String

def take(n):

   The prefix of xs of length n,
      or xs itself if n > length xs.
   
   return lambda xs: (
       xs[0:n]
       if isinstance(xs, (list, tuple))
       else list(islice(xs, n))
   )

MAIN ---

if __name__ == '__main__':

   main()</lang>

Output:

[3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571]

Quackery

totient is defined at Totient function#Quackery.

<lang Quackery> [ 0 over

   [ dup 1 != while 
     totient
     dup dip +
     again ]  
   drop = ]                is perfecttotient ( n --> b )    

 [ [] 1
   [ dup perfecttotient if
       [ dup dip join ]
     2 +
   over size 20 = 
   until ] drop ]          is task            (   -->  )

</lang>

Output:

[ 3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571 ]

Racket

lang racket

(require math/number-theory)

(define (tot n)

 (match n
   [1 0]
   [n (define t (totient n))
      (+ t (tot t))]))

(define (perfect? n)

 (= n (tot n)))

(define-values (ns i)

 (for/fold ([ns '()] [i 0])
           ([n (in-naturals 1)]
            #:break (= i 20)
            #:when (perfect? n))
   (values (cons n ns) (+ i 1))))

(reverse ns) </lang>

Raku

(formerly Perl 6)

Works with: Rakudo version 2018.11

<lang perl6>use Prime::Factor;

my \𝜑 = lazy 0, |(1..*).hyper.map: -> \t { t * [*] t.&prime-factors.squish.map: 1 - 1/* } my \𝜑𝜑 = Nil, |(3, *+2 … *).grep: -> \p { p == sum 𝜑[p], { 𝜑[$_] } … 1 };

put "The first twenty Perfect totient numbers:\n", 𝜑𝜑[1..20];</lang>

Output:

The first twenty Perfect totient numbers:
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

REXX

unoptimized

<lang rexx>/*REXX program calculates and displays the first N perfect totient numbers. */ parse arg N . /*obtain optional argument from the CL.*/ if N== | N=="," then N= 20 /*Not specified? Then use the default.*/ @.= . /*memoization array of totient numbers.*/ p= 0 /*the count of perfect " " */ $= /*list of the " " " */

   do j=3  by 2  until p==N;   s= phi(j)        /*obtain totient number for a number.  */
   a= s                                         /* [↓]  search for a perfect totient #.*/
                               do until a==1;           a= phi(a);            s= s + a
                               end   /*until*/
   if s\==j  then iterate                       /*Is  J  not a perfect totient number? */
   p= p + 1                                     /*bump count of perfect totient numbers*/
   $= $ j                                       /*add to perfect totient numbers list. */
   end   /*j*/

say 'The first ' N " perfect totient numbers:" /*display the header to the terminal. */ say strip($) /* " " list. " " " */ exit 0 /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ gcd: parse arg x,y; do until y==0; parse value x//y y with y x; end; return x /*──────────────────────────────────────────────────────────────────────────────────────*/ phi: procedure expose @.; parse arg z; if @.z\==. then return @.z /*was found before?*/

    #= z==1;         do m=1  for z-1;   if gcd(m, z)==1  then #= # + 1;    end  /*m*/
    @.z= #;   return #                                              /*use memoization. */</lang>

output when using the default input of : 20

The first  20  perfect totient numbers:
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

optimized

This REXX version is over twice as fast as the unoptimized version.

It takes advantage of the fact that all known perfect totient numbers less than 3²² have at least one of these factors: 3, 5, or 7

(3²² = 31,381,059,609). <lang rexx>/*REXX program calculates and displays the first N perfect totient numbers. */ parse arg N . /*obtain optional argument from the CL.*/ if N== | N=="," then N= 20 /*Not specified? Then use the default.*/ @.= . /*memoization array of totient numbers.*/ p= 0 /*the count of perfect " " */ $= /*list of the " " " */

    do j=3  by 2  until p==N                    /*obtain the totient number for index J*/
    if j//3\==0   then  if j//5\==0   then  if j//7\==0   then iterate
    s= phi(j);  a= s                            /* [↑]  J  must have 1 of these factors*/
                              do until a==1;  if @.a==.  then a= phi(a);    else a= @.a
                                              s= s + a
                              end   /*until*/
    if s\==j  then iterate                      /*Is  J  not a perfect totient number? */
    p= p + 1                                    /*bump count of perfect totient numbers*/
    $= $ j                                      /*add to perfect totient numbers list. */
    end   /*j*/

say 'The first ' N " perfect totient numbers:" /*display the header to the terminal. */ say strip($) /* " " list. " " " */ exit 0 /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ gcd: parse arg x,y; do until y==0; parse value x//y y with y x; end; return x /*──────────────────────────────────────────────────────────────────────────────────────*/ phi: procedure expose @.; parse arg z; if @.z\==. then return @.z /*was found before?*/

    #= z==1;         do m=1  for z-1;   if gcd(m, z)==1  then #= # + 1;    end  /*m*/
    @.z= #;   return #                                              /*use memoization. */</lang>

output is identical to the 1^st REXX version.

Ring

<lang ring> perfect = [] n = 1 while len(perfect)<20

     totnt = n
     tsum = 0
     while totnt!=1 
           totnt = totient(totnt)
           tsum = tsum + totnt
     end
     if tsum=n 
        add(perfect,n)
     ok
     n = n + 2

end see "The first 20 perfect totient numbers are:" + nl showarray(perfect)

func totient n

    totnt = n
    i = 2
    while i*i <= n
          if n%i=0 
             while true
                   n = n/i
                   if n%i!=0 
                      exit
                   ok
             end 
             totnt = totnt - totnt/i
          ok
          if i=2
             i = i + 1
          else
             i = i + 2
          ok
    end
   if n>1 
      totnt = totnt - totnt/n
   ok
   return totnt

func showArray array

    txt = ""
    see "["
    for n = 1 to len(array)
        txt = txt + array[n] + ","
    next
    txt = left(txt,len(txt)-1)
    txt = txt + "]"
    see txt

</lang>

The first 20 perfect totient numbers are:
[3,9,15,27,39,81,111,183,243,255,327,363,471,729,2187,2199,3063,4359,4375,5571]

Ruby

<lang ruby>require "prime"

class Integer

 def φ
   prime_division.inject(1) {|res, (pr, exp)| res *= (pr-1) * pr**(exp-1) } 
 end

 def perfect_totient?
   f, sum = self, 0
   until f == 1 do
     f = f.φ
     sum += f
   end
   self == sum
 end

end

puts (1..).lazy.select(&:perfect_totient?).first(20).join(", ") </lang>

Output:

3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571

Scala

In this example we define a function which determines whether or not a number is a perfect totient number, then use it to construct a lazily evaluated list which contains all perfect totient numbers. Calculating the first n perfect totient numbers only requires taking the first n elements from the list. <lang scala>//List of perfect totients def isPerfectTotient(num: Int): Boolean = LazyList.iterate(totient(num))(totient).takeWhile(_ != 1).foldLeft(0L)(_+_) + 1 == num def perfectTotients: LazyList[Int] = LazyList.from(3).filter(isPerfectTotient)

//Totient Function @tailrec def scrub(f: Long, num: Long): Long = if(num%f == 0) scrub(f, num/f) else num def totient(num: Long): Long = LazyList.iterate((num, 2: Long, num)){case (ac, i, n) => if(n%i == 0) (ac*(i - 1)/i, i + 1, scrub(i, n)) else (ac, i + 1, n)}.dropWhile(_._3 != 1).head._1</lang>

Output:

scala> perfectTotients.take(20).mkString(", ")
res1: String = 3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571

Sidef

<lang ruby>func perfect_totient({.<=1}, sum=0) { sum } func perfect_totient( n, sum=0) { __FUNC__(var(t = n.euler_phi), sum + t) }

say (1..Inf -> lazy.grep {|n| perfect_totient(n) == n }.first(20))</lang>

Output:

[3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571]

Swift

<lang swift>public func totient(n: Int) -> Int {

 var n = n
 var i = 2
 var tot = n

 while i * i <= n {
   if n % i == 0 {
     while n % i == 0 {
       n /= i
     }

     tot -= tot / i
   }

   if i == 2 {
     i = 1
   }

   i += 2
 }

 if n > 1 {
   tot -= tot / n
 }

 return tot

}

public struct PerfectTotients: Sequence, IteratorProtocol {

 private var m = 1

 public init() { }

 public mutating func next() -> Int? {
   while true {
     defer {
       m += 1
     }

     var tot = m
     var sum = 0

     while tot != 1 {
       tot = totient(n: tot)
       sum += tot
     }

     if sum == m {
       return m
     }
   }
 }

}

print("The first 20 perfect totient numbers are:") print(Array(PerfectTotients().prefix(20)))</lang>

Output:

The first 20 perfect totient numbers are:
[3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571]

Tcl

<lang tcl>array set cache {}

set cache(0) 0

proc gcd {i j} {

  while {$j != 0} {
     set t [expr {$i % $j}]
     set i $j
     set j $t
  }
  return $i

}

proc is_perfect_totient {n} {

   global cache
   set tot 0
   for {set i 1} {$i < $n} {incr i} {
       if [ expr [gcd $i $n] == 1 ] {
           incr tot
       }
   }
   set sum [expr $tot + $cache($tot)]
   set cache($n) $sum
   return [ expr $n == $sum ? 1 : 0]

}

set i 1 set count 0 while { $count < 20 } {

   if [ is_perfect_totient $i ] {
       puts -nonewline  "${i} "
       incr count
   }
   incr i

} puts "" </lang>

Output:

$ time tclsh perfect-totient.tcl
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

real    1m18,058s
user    1m17,593s
sys     0m0,046s

Wren

Translation of: Go

The version using Euler's product formula. <lang ecmascript>var totient = Fn.new { |n|

   var tot = n
   var i = 2
   while (i*i <= n) {
       if (n%i == 0) {
           while(n%i == 0) n = (n/i).floor
           tot = tot - (tot/i).floor
       }
       if (i == 2) i = 1
       i = i + 2
   }
   if (n > 1) tot = tot - (tot/n).floor
   return tot

}

var perfect = [] var n = 1 while (perfect.count < 20) {

   var tot = n
   var sum = 0
   while (tot != 1) {
       tot = totient.call(tot)
       sum = sum + tot
   }
   if (sum == n) perfect.add(n)
   n = n + 2

} System.print("The first 20 perfect totient numbers are:") System.print(perfect)</lang>

Output:

The first 20 perfect totient numbers are:
[3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571]

zkl

<lang zkl>var totients=List.createLong(10_000,0); // cache fcn totient(n){ if(phi:=totients[n]) return(phi);

  totients[n]=[1..n].reduce('wrap(p,k){ p + (n.gcd(k)==1) })

} fcn perfectTotientW{ // -->iterator

  (1).walker(*).tweak(fcn(z){
     parts,n := 0,z;
     while(n!=1){ parts+=( n=totient(n) ) }
     if(parts==z) z else Void.Skip;
  })

}</lang> <lang zkl>perfectTotientW().walk(20).println();</lang>

Output:

L(3,9,15,27,39,81,111,183,243,255,327,363,471,729,2187,2199,3063,4359,4375,5571)