Euler Project 124

(defun radical (n)
"Gives the product of the distinct prime factors of N." 
The radical of n, rad(n), is the product of distinct prime factors of n. For example, 504 = 2³  3² 7, so rad(504) = 2  3  7 = 42.
If we calculate rad(n) for 1  n  10, then sort them on rad(n), and sorting on n if the radical values are equal, we get:

Unsorted			Sorted
n	rad(n)		n	rad(n)	k
1	1		1	1	1
2	2		2	2	2
3	3		4	2	3
4	2		8	2	4
5	5		3	3	5
6	6		9	3	6
7	7		5	5	7
8	2		6	6	8
9	3		7	7	9
10	10		10	10	10

Let E(k) be the kth element in the sorted n column; for example, E(4) = 8 and E(6) = 9.
If rad(n) is sorted for 1  n  100000, find E(10000).


My Solution Using the Mathematic

SortBy[Array[List[#, Apply[Times, FactorInteger[#]][[1]]] &, 100000], Last][[10000]][[1]]

Others' Solution

    (reduce #'* (remove-duplicates (prime-factorize n))))
  

(aref (sort (iter (for n from 1 to 100000) 

                   (collecting (cons n (radical n)) 

                                 result-type 'simple-vector)) 

            (lambda (a b) 

               (if (= (cdr a) (cdr b)) 

                   (< (car a) (car b)) 

                   (< (cdr a) (cdr b))))) 

    9999)

Second Solution

Last[Extract[Sort[Table[{With[{pf=PrimeFactorList[n]},Product[Extract[pf,i],{i,1,Length[pf]}]],n},{n,1,100000}]],10000]]

Third Solution

Rad[n_] := Times @@ First /@ FactorInteger[n];
KthElement[m_, k_] := Last@Sort[Table[{Rad[x], x}, {x, m}]][[k]];
KthElement[100000, 10000]

Fourth Solution

Timing[Sort[Table[{
Times @@ FactorInteger[i][[All, 1]], i}, {i, 1, 100000}]][[10000]]]

Fifth Solution

(defun prime-p (n)
(loop for i from 2 to (floor (sqrt n))
never (zerop (mod n i))))

;;(defvar *rad-image* (loop for x from 2 to 100000
;; if (loop for i from 2 to (floor (sqrt x))
;; never (zerop (mod x (* i i))))
;; collect x))

(defun euler-124 (n k) ;;n=100000, k=10000
(let ((count 1))
(loop for x in *rad-image*
if (prime-p x)
do (loop for exp from 1 to (floor (log n x))
do (incf count)
if (= count k) do (return-from euler-124 (expt x exp)))
else do (let ((potential-n (loop with banned
for i from 1 to (floor (/ n x))
if (prime-p i)
unless (zerop (mod x i))
do (push i banned)
else collect (* i x)
else if (loop for p in banned
never (zerop (mod i p)))
collect (* i x))))
(loop for num in potential-n
do (incf count)
if (= count k) do (return-from euler-124 num))))))

Sixth Solution

(defun euler124 ()
(rad-sieve 100000 10000))
  

(defun rad-sieve (n k &aux (n+1 (1+ n))) 

    (if (< n 2) 

        (return-from rad-sieve nil)) 

    (let ((rads (make-array n+1 :initial-element 1))) 

        (labels ((cross-off (i) 

                    (do ((j i (+ j i))) 

                        ((>= j n+1)) 

                        (setf (aref rads j) (* i (aref rads j))))) 

                    (next-i (i) 

                     (setf (aref rads i) (+ (* (aref rads i) n+1) i)) 

                     (iterate loop ((j (1+ i))) 

                        (cond ((>= j n+1) n+1) 

                              ((= (aref rads j) 1) j) 

                              (:else
(setf (aref rads j) (+ (* (aref rads j) n+1) j)) 

                                (loop (1+ j))))))) 

    (setf (aref rads 0) 0) 

    (setf (aref rads 1) (1+ n+1)) 

    (do ((i 2 (next-i i))) 

        ((>= i n+1) 

        (mod (aref (sort rads #'<) k) n+1)) 

     (cross-off i)))))