Euler Project 70

My Solution using the Mathematica
Euler's Totient function, φ(n) [sometimes called the phi function], is used to determine the number of positive numbers less than or equal to n which are relatively prime to n. For example, as 1, 2, 4, 5, 7, and 8, are all less than nine and relatively prime to nine, φ(9)=6.
The number 1 is considered to be relatively prime to every positive number, so φ(1)=1.
Interestingly, φ(87109)=79180, and it can be seen that 87109 is a permutation of 79180.
Find the value of n, 1  n  10⁷, for which φ(n) is a permutation of n and the ratio n/φ(n) produces a minimum.

currentiter = 2; minRatio = 10; For[i = 2, i < 10000000, i++,  EulerPhiValue = EulerPhi[i]; If[MemberQ[Permutations[IntegerDigits[i]],  IntegerDigits[EulerPhiValue]] && i/EulerPhiValue < minRatio,  currentiter = i; minRatio = i/EulerPhiValue]]; Print[currentiter]; Print[minRatio]

Others' Solution

First Solution
Timing[counter = 1; answer = {2, 2}; While[counter++ < 10^7, {If[Sort[IntegerDigits[EulerPhi[counter]]] == Sort[IntegerDigits[ counter]], If[ counter/EulerPhi[counter] < answer[[2]], answer = {counter, counter/EulerPhi[counter]}]]}]; answer]

Second Solution

t = Reap[NestWhile[ (If[isPermutation[#, EulerPhi[#]], Sow[#]]; # + 1) &, 1, # < 10000000 &]];

Third Solution

(defun phi-to-n (n)
(let ((primzahlen (loop for i from 1 to n if (primep i) collect i))
(phi-werte (make-array (1+ n) :initial-element nil)))
(loop for i in primzahlen
do (loop for j = i then (+ j i) while (<= j n)
do (push i (aref phi-werte j))))
(loop for i from 2 to n
do (setf (aref phi-werte i)
(* i (reduce #'*
(loop for j in (aref phi-werte i) collecting (- 1 (/ 1 j)))))))
phi-werte))

63sec for running through the results with collecting permutations by

(defun permutationp (x y)
(equal (sort (number->digits x) #'<) (sort (number->digits y) #'<)))

Fourth Solution

(defun euler70 () 

    (generate-all-primes 10000) 

    (let ((best 6) 

          (ratio 3.0)) 

         (loop for a in all-primes 

                do (loop for b in all-primes 

                        as n = (* b a) 

                        as phi = (1+ (- n a b))

                        while (< b a) 

                        while (< n 10000000) 

                        if (and (< (/ n phi) ratio) 

                                (equal (sort (digits n) #'<) (sort (digits phi) #'<))) 

                        do (progn
(setf ratio (/ n phi)) 

                                  (setf best n) 

                                  (print (list best phi (coerce ratio 'float))))) 

                 finally (return best))))

Fifth Solution

(defun euler070 ()
(let ((res (primes-array+sieve 10000000)))
(if res
(2-radical-search (car res) (cdr res) 10000000))))

(defun 2-radical-search (primes-array sieve-of-indices n)
(do ((idx1 (prime-floor-index (isqrt n) sieve-of-indices) (1+ idx1))
(brsf 100)
(bnsf nil)
(bphisf nil))
((> (aref primes-array idx1) (/ n 2))
(list brsf bnsf bphisf))
(block scan-second-prime
(let ((p1 (aref primes-array idx1)))
(do ((idx2 (prime-floor-index (floor n p1) sieve-of-indices) (1- idx2)))
((< idx2 0))
(let ((p2 (aref primes-array idx2)))
(let ((p1p2/phi (* (/ p1 (1- p1)) (/ p2 (1- p2)))))
(do ((p1^k p1 (* p1^k p1))
(phi-p^k (1- p1) (* p1 phi-p^k)))
((> p1^k (/ n p2)))
(do ((p1^kp2^l (* p2 p1^k) (* p1^kp2^l p2))
(phi-p1^kp2^l (* phi-p^k (1- p2)) (* p2 phi-p1^kp2^l)))
((> p1^kp2^l n))
(when (and (= (goedel p1^kp2^l) (goedel phi-p1^kp2^l))
(< p1p2/phi brsf))
(setf brsf p1p2/phi
bnsf p1^kp2^l
bphisf phi-p1^kp2^l)
(return-from scan-second-prime)))))))))))

Sixth Solution

a = {11/10}; For[i = 10^7 - 1, i > 1, i--, b = EulerPhi[i];
If[IntegerLength[i] == IntegerLength[b] && i/b < Min[a] &&
MemberQ[Permutations[IntegerDigits[i]], IntegerDigits[b]],
AppendTo[a, {i, i/b}]; Print[{i, i/b}]]];
Print[ a[[Position[a, Min[a]][[1, 1]]]]]