Euler Project 24

A permutation is an ordered arrangement of objects. For example, 3124 is one possible permutation of the digits 1, 2, 3 and 4. If all of the permutations are listed numerically or alphabetically, we call it lexicographic order. The lexicographic permutations of 0, 1 and 2 are:

012   021   102   120   201   210

What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?

My Solution

This time I use the Mathematica as my tool.

Take[Permutations[{0, 1, 2, 3, 4, 5, 6, 7, 8, 9}], {1000000, 1000000}]

Others' Solution using the Lisp

First Solution

(defun factorial (n) 
(if (= n 0) 
1 
(* n (factorial (- n 1))))) 

(defun but-nth (n lst) 
(if (= n 0) 
(cdr lst) 
(cons (car lst) 
(but-nth (- n 1) (cdr lst))))) 

(defun permute (n lst) 
(if (= n 0) 
lst 
(let* ((len (length lst)) 
(sublen (- len 1)) 
(modulus (factorial sublen))) 
(if (> n (* len modulus)) 
(error "List of length ~A doesn't have ~A permutations." len n) 
(multiple-value-bind 
(quotient remainder) (floor n modulus) 
(cons (nth quotient lst) 
(permute remainder (but-nth quotient lst)))))))) 

Second Solution

(defun euler24 (&optional (n 999999) (p '(0 1 2 3 4 5 6 7 8 9))) 

 (permute n p))
  

(defun permute (n p) 

 (let ((f (factorial (length p)))) 

     (cond ((= n 0) p)
((= n f) (reverse p)) 

           ((> n f) (permute (mod n (* f (1+ (length p)))) p)) 

           (t (multiple-value-bind (d r) (floor n (/ f (length p))) 

               (cons (nth d p) (permute r (remove (nth d p) p))))))))
  

(defun factorial (n) 

 (do ((i n (1- i)) (f 1 (* i f))) ((= i 0) f)))

Third Solution