Clojure Project Euler: Smallest multiple

@_sg · Регистрация: 12.05.2012

Author24 — интернет-сервис помощи студентам

Project Euler: Smallest multiple

2520 - самое маленькое число, которое делится без остатка на все числа от 1 до 10. Какое самое маленькое число делится нацело на все числа от 1 до 20?

@korvin_ · 23.11.2014, 21:34

Сообщение от _sg

Какое самое маленькое число делится нацело на все числа от 1 до 20?

Lisp

(defun divisors (n primes)
  (let ((divs (make-hash-table :test #'eql)))
    (loop :while (and primes (> n 0)) :do
          (multiple-value-bind (q r) (floor n (first primes))
            (if (= r 0)
                (progn
                  (incf (gethash (first primes) divs 0))
                  (setf n q))
                (setf primes (rest primes)))))
    (when (= 0 (hash-table-count divs))
      (setf (gethash n divs) 1))
    divs))
 
(defun merge-divisors (dst src)
  (maphash #'(lambda (divisor dst-count)
               (setf (gethash divisor dst)
                     (max dst-count (gethash divisor src 0)))
               (remhash divisor src))
           dst)
  (maphash #'(lambda (divisor src-count)
               (setf (gethash divisor dst) src-count))
           src)
  dst)
 
(defun min-divisible (n)
  (let ((primes  ())
        (divs    (make-hash-table :test #'eql))
        (result  1))
    (loop :for i :from 2 :to n :do
          (let ((idivs (divisors i primes)))
            (when (and (=   1 (hash-table-count idivs))
                       (eql 1 (gethash i idivs)))
              (push i primes))
            (format t "; Num ~a divs: " i)
            (print-hash idivs)
            (merge-divisors divs idivs)
            (format t "~%;    all divs: ")
            (print-hash divs)
            (format t "~%;    primes:~{ ~a~}~%" primes)
            ))
    (maphash #'(lambda (divisor count)
                 (setf result (* result (expt divisor count))))
             divs)
    result))
 
 
(defun print-hash (h)
  (maphash #'(lambda (k v)
               (format t "~a=>~a; " k v))
           h))

Lisp

(min-divisible 10)
; Num 2 divs: 2=>1; 
;    all divs: 2=>1; 
;    primes: 2
; Num 3 divs: 3=>1; 
;    all divs: 2=>1; 3=>1; 
;    primes: 3 2
; Num 4 divs: 2=>2; 
;    all divs: 2=>2; 3=>1; 
;    primes: 3 2
; Num 5 divs: 5=>1; 
;    all divs: 2=>2; 3=>1; 5=>1; 
;    primes: 5 3 2
; Num 6 divs: 2=>1; 3=>1; 
;    all divs: 2=>2; 3=>1; 5=>1; 
;    primes: 5 3 2
; Num 7 divs: 7=>1; 
;    all divs: 2=>2; 3=>1; 5=>1; 7=>1; 
;    primes: 7 5 3 2
; Num 8 divs: 2=>3; 
;    all divs: 2=>3; 3=>1; 5=>1; 7=>1; 
;    primes: 7 5 3 2
; Num 9 divs: 3=>2; 
;    all divs: 2=>3; 3=>2; 5=>1; 7=>1; 
;    primes: 7 5 3 2
; Num 10 divs: 2=>1; 5=>1; 
;    all divs: 2=>3; 3=>2; 5=>1; 7=>1; 
;    primes: 7 5 3 2
2520

Lisp

(min-divisible 20)
; Num 2 divs: 2=>1; 
;    all divs: 2=>1; 
;    primes: 2
; Num 3 divs: 3=>1; 
;    all divs: 2=>1; 3=>1; 
;    primes: 3 2
; Num 4 divs: 2=>2; 
;    all divs: 2=>2; 3=>1; 
;    primes: 3 2
; Num 5 divs: 5=>1; 
;    all divs: 2=>2; 3=>1; 5=>1; 
;    primes: 5 3 2
; Num 6 divs: 2=>1; 3=>1; 
;    all divs: 2=>2; 3=>1; 5=>1; 
;    primes: 5 3 2
; Num 7 divs: 7=>1; 
;    all divs: 2=>2; 3=>1; 5=>1; 7=>1; 
;    primes: 7 5 3 2
; Num 8 divs: 2=>3; 
;    all divs: 2=>3; 3=>1; 5=>1; 7=>1; 
;    primes: 7 5 3 2
; Num 9 divs: 3=>2; 
;    all divs: 2=>3; 3=>2; 5=>1; 7=>1; 
;    primes: 7 5 3 2
; Num 10 divs: 2=>1; 5=>1; 
;    all divs: 2=>3; 3=>2; 5=>1; 7=>1; 
;    primes: 7 5 3 2
; Num 11 divs: 11=>1; 
;    all divs: 2=>3; 3=>2; 5=>1; 7=>1; 11=>1; 
;    primes: 11 7 5 3 2
; Num 12 divs: 2=>2; 3=>1; 
;    all divs: 2=>3; 3=>2; 5=>1; 7=>1; 11=>1; 
;    primes: 11 7 5 3 2
; Num 13 divs: 13=>1; 
;    all divs: 2=>3; 3=>2; 5=>1; 7=>1; 11=>1; 13=>1; 
;    primes: 13 11 7 5 3 2
; Num 14 divs: 2=>1; 7=>1; 
;    all divs: 2=>3; 3=>2; 5=>1; 7=>1; 11=>1; 13=>1; 
;    primes: 13 11 7 5 3 2
; Num 15 divs: 3=>1; 5=>1; 
;    all divs: 2=>3; 3=>2; 5=>1; 7=>1; 11=>1; 13=>1; 
;    primes: 13 11 7 5 3 2
; Num 16 divs: 2=>4; 
;    all divs: 2=>4; 3=>2; 5=>1; 7=>1; 11=>1; 13=>1; 
;    primes: 13 11 7 5 3 2
; Num 17 divs: 17=>1; 
;    all divs: 2=>4; 3=>2; 5=>1; 7=>1; 11=>1; 13=>1; 17=>1; 
;    primes: 17 13 11 7 5 3 2
; Num 18 divs: 2=>1; 3=>2; 
;    all divs: 2=>4; 3=>2; 5=>1; 7=>1; 11=>1; 13=>1; 17=>1; 
;    primes: 17 13 11 7 5 3 2
; Num 19 divs: 19=>1; 
;    all divs: 2=>4; 3=>2; 5=>1; 7=>1; 11=>1; 13=>1; 17=>1; 19=>1; 
;    primes: 19 17 13 11 7 5 3 2
; Num 20 divs: 2=>2; 5=>1; 
;    all divs: 2=>4; 3=>2; 5=>1; 7=>1; 11=>1; 13=>1; 17=>1; 19=>1; 
;    primes: 19 17 13 11 7 5 3 2
232792560

@Catstail · 23.11.2014, 21:36

Lisp

(defun is-prime (n)
  (if (evenp n) nil
      (let* ((b (flo2fix (sqr n)))
             (beg (if (evenp b) (- b 1) b))
             (res t))
            (iter (for k from beg to 3 by -2) (when (zerop (rem n k)) (setq res nil) (return nil)))
            res)))
 
(defun factorize (n)
  (if (is-prime n) 
      (list n)
      (let* ((e (quotient n 2))
             (res nil))
        (iter (for i from 2 to e) (when (and (is-prime i) (zerop (rem n i))) (collecting i into res)))
      res)))
 
(defun task (n)
  (let ((res (list 2 3)))
     (iter (for i from 4 to n) (setq res (append res (factorize i))))
     (apply '* (setof res))))  
 
==> task
 
(task 20)
 
==> 38798760

Нет. Опять поторопился. Надо править

@_sg · 23.11.2014, 21:41 **[ТС]**

Lisp

(defun smallest-multiple (w &optional (n (car w)))
  (if (every #'(lambda (a) (zerop (rem n a))) w)
      n
      (smallest-multiple w (+ n (car w)))))
 
> (smallest-multiple '(20 19 18 17 16 15 14 13 12 11))
232792560

@korvin_ · 23.11.2014, 22:05

Catstail,

Lisp

(defun check (x n)
  (loop :for i :from 1 :to n :do
        (multiple-value-bind (q r) (floor x i)
          (when (> r 0)
            (format t "; ~a -> ~a~%" i r)))))

Lisp

(check 38798760 20)
; 9 -> 3
; 16 -> 8
; 18 -> 12

Добавлено через 13 минут
_sg, LispWorks выпадает с переполнением стека из-за глубины рекурсии. =)

Lisp

(defun smallest-multiple (n &aux (m n))
  (loop :until (loop :for i :from (floor n 2) :to n :always (= 0 (rem m i)))
        :do (incf m n))
  m)

Lisp

(time (min-divisible 20))
Timing the evaluation of (MIN-DIVISIBLE 20)
 
User time    =        0.000
System time  =        0.000
Elapsed time =        0.000
Allocation   = 9772 bytes
0 Page faults
232792560
 
CL-USER 50 > (time (smallest-multiple 20))
Timing the evaluation of (SMALLEST-MULTIPLE 20)
 
User time    =        1.918
System time  =        0.000
Elapsed time =        1.918
Allocation   = 39448 bytes
0 Page faults
232792560

Добавлено через 5 минут

Lisp

(time (min-divisible 30))
Timing the evaluation of (MIN-DIVISIBLE 30)
 
User time    =        0.000
System time  =        0.000
Elapsed time =        0.000
Allocation   = 15220 bytes
0 Page faults
2329089562800
 
CL-USER 52 > (time (smallest-multiple 30))
Timing the evaluation of (SMALLEST-MULTIPLE 30)
 
Break. ; я не дождался =)

@castorsky · 23.11.2014, 22:13

Lisp

> (apply lcm (range 1 21))
232792560
> (time (apply lcm (range 1 21)))
cpu time: 0 real time: 0 gc time: 0
232792560
>

Добавлено через 2 минуты

Lisp

;; rakcket-lang.org
(define (foo n)
  (apply lcm (range 1 (add1 n))))
 
> (time (foo 500))
cpu time: 1 real time: 1 gc time: 0
732396223189528465938638745190422988297613382512892590463491900345963074208037133
943277598198913269852683126066484088757133140133136233370943124406636598033520614
15560955398316253892220738945585450197206138869521568000
>

@smoke853 · 23.11.2014, 22:49

Clojure:

Lisp

(ns learn-clojure.example)
 
(defn gcd [a b]
  (if (zero? b)
    a
    (recur b (rem a b))))
;; => #'learn-clojure.example/gcd
 
(defn lcm [a b]
  (/ (* a b) (gcd a b)))
;; => #'learn-clojure.example/lcm
 
(defn task [a b]
  (reduce lcm (range a b)))
;; => #'learn-clojure.example/task
 
(task 1 20)
;; => 232792560

Lisp

(defn prime-factors [n]
  (loop [n n p 2 acc {}]
    (cond (<= n 1) acc
          (zero? (rem n p)) (recur (quot n p) p (assoc acc p (inc (get acc p 0))))
          :else (recur n (inc p) acc))))
;; => #'learn-clojure.example/prime-factors
 
(defn lcm [a b]
  (apply * (map (fn [[k v]] (apply * (repeat v k)))
                (merge-with max (prime-factors a) (prime-factors b)))))
;; => #'learn-clojure.example/lcm
 
(defn task [a b]
  (reduce lcm (range a b)))
;; => #'learn-clojure.example/task
 
(task 1 20)
;; => 232792560

@Catstail · 23.11.2014, 22:56

Вот:

Lisp

;; Проверка простоты числа
 
(defun is-prime (n)
  (cond ((member n '(2 3 5 7)) t)
        ((evenp n) nil)
        (t (let* ((b (flo2fix (sqr n)))
             (beg (if (evenp b) (- b 1) b))
             (res t))
            (iter (for k from beg to 3 by -2) (when (zerop (rem n k)) (setq res nil) (return nil)))
            res))))
        
;; Разложение на простые множители
 
(defun factorize (n)
  (if (is-prime n) 
      (list n)
      (let* ((e (quotient n 2))
             (res nil))
        (iter (for i from 2 to e) (when (and (is-prime i) (zerop (rem n i))) (collecting i into res)))
      res)))
      
;; Получение простых множителей со степенями
 
(defun all-div (n)
  (let ((f (factorize n)) (res nil))
    (iter (for i in f)
      (let ((p i))
        (loop
           (when (/= 0 (rem n p)) (return t))
           (setq p (* p i)) (push i res)))) res))
 
;; Объединение списков
 
(defun connect (lst1 lst2 &optional (r nil))
  (cond ((null lst1) (append r lst2))
        ((member (car lst1) lst2) (connect (cdr lst1) (removef (car lst1) lst2) (cons (car lst1) r)))
        (t (connect (cdr lst1) lst2 (cons (car lst1) r)))))
 
;; Решение
 
(defun task (n)
  (let ((r nil))
   (iter (for i from 2 to n) (setq r (connect (all-div i) r)))
   (apply '* r)))
 
(task 20)
 
==> 232792560
 
(task 10)
 
==> 2520

Добавлено через 54 секунды
korvin_, да, я уже сообразил и переделал.

@korvin_ · 23.11.2014, 23:07

castorsky, лол, я думал на Project Euler какие-то сложные задачи, а это оказалась простейшая lcm. Я вначале подумал об этом, но все же решил, что это что-то другое.

Lisp

(defun foo (n)
  (apply #'lcm (loop :for i :from 2 :to n :collect i)))
 
(compile 'foo)
(time (foo 500))
 
; Timing the evaluation of (FOO 500)
 
; User time    =        0.000
; System time  =        0.000
; Elapsed time =        0.000
; Allocation   = 80420 bytes
; 0 Page faults
73239622318952846593863874519042298829761338251289259046349190034596307420803713394327759819891326985268312606648408875713314013313623337094312440663659803352061415560955398316253892220738945585450197206138869521568000

@_sg · 23.11.2014, 23:25 **[ТС]**

Lisp

(defun smallest-multiple (w)
  (reduce #'lcm w))
 
> (smallest-multiple '(20 19 18 17 16 15 14 13 12 11))
232792560

@smoke853 · 24.11.2014, 00:47

Еще один вариант, переписал с решения на F#:

Кликните здесь для просмотра всего текста

Код

let problem5_correct() = 
    let primesWithLimit limit = 
        let testPrime (possiblePrime : float) = 
            let sqrRootOfPrime = sqrt (possiblePrime)
            {2.0..sqrRootOfPrime} |> Seq.forall (fun divisor -> 
                                         match divisor with
                                         | 1.0 -> true
                                         | x when divisor = possiblePrime -> true
                                         | _ -> possiblePrime % divisor > 0.0)
        {2.0..limit} |> Seq.filter (fun index -> testPrime index)
    
    let computeLimit = sqrt (20.0)
    primesWithLimit 20.0
    |> Seq.fold (fun state prime -> 
           let exponent = 
               match prime < computeLimit with
               | true -> floor ((log (20.0) / log (prime)))
               | _ -> 1.0
           state * (float (prime) ** exponent)) 1.0
    |> int64

// 232792560L
problem5_correct() |> printfn "%A"

Lisp

(defn sieve
  "Sieve of Eratosthenes"
  [s]
  (cons (first s) (lazy-seq (sieve (remove #(zero? (rem % (first s))) (rest s))))))
;; => #'learn-clojure.example/sieve
 
(defn task [n]
  (reduce (fn [state prime]
            (let [exp (if (< prime (Math/sqrt n))
                        (long (Math/floor (/ (Math/log n) (Math/log prime))))
                        1)]
              (apply *' state (repeat exp prime))))
          1
          (take-while #(< % n) (sieve (iterate inc 2)))))
;; => #'learn-clojure.example/task
 
(task 20)
;; => 232792560
(task 500)
;; => 73239622318952846593863874519042298829761338251289259046349190034596307420803713394327759819891326985268312606648408875713314013313623337094312440663659803352061415560955398316253892220738945585450197206138869521568000N

@castorsky · 24.11.2014, 17:20

Сообщение от korvin_

я думал на Project Euler

Типовые, в первых местах конечно, дальше я не смотрел. Может хедхант, не знаю.

@korvin_ · 24.11.2014, 23:20

Сообщение от castorsky

Типовые, в первых местах конечно, дальше я не смотрел. Может хедхант, не знаю.

Кстати, свертку лучше сделать вручную, чем через CL'ный reduce:

Lisp

(defun reduced-lcm (n &aux (m 2))
  (loop :for x :from 3 :to n :do (setf m (lcm x m)))
  m)
 
(defun compare-lcm (n)
  (let ((args (loop :for x :from 2 :to n :collect x)))
    (= (time (reduced-lcm n))
       (time (reduce #'lcm args)))))

Lisp

(compare-lcm 100000)
 
; Timing the evaluation of (REDUCED-LCM N)
; User time    =        2.636
; System time  =        0.000
; Elapsed time =        2.636
; Allocation   = 124 480 404 bytes
; 0 Page faults
 
; Timing the evaluation of (REDUCE (FUNCTION LCM) ARGS)
; User time    =        6.786
; System time  =        0.015
; Elapsed time =        6.772
; Allocation   = 1 847 195 464 bytes
; 0 Page faults
T

Вообще странно, что простой проход по списку оказывается дольше почти в три раза и (тем более) жрет так много памяти.

@castorsky · 25.11.2014, 00:22

Сообщение от korvin_

Вообще странно, что простой проход по списку оказывается дольше почти в три раза и (тем более) жрет так много памяти.

Что же тут странного? Это не простой проход, а универсальная рекурсивная фвп, которая компенсирует ограничение на длину списка.

Lisp

(defun reduced-lcm (n &aux (m 2))
  (loop :for x :from 3 :to n :do (setf m (lcm x m)))
  m)
 
(defun range (max &key (min 1) (step 1))
   (loop :for n :from min :below max :by step
      :collect n))
 
(defun just-lcm (args)
  (eval (cons 'lcm args)))
 
(defun compare-lcm (n)
  (let ((args (loop :for x :from 2 :to n :collect x)))
    (= (time (reduced-lcm n))
       (time (reduce #'lcm args))
       (time (just-lcm args))))

Lisp

L-USER 49 > (compare-lcm 10000)
Timing the evaluation of (REDUCED-LCM N)
 
User time    =        0.046
System time  =        0.000
Elapsed time =        0.057
Allocation   = 10967124 bytes
0 Page faults
Calls to %EVAL    199985
Timing the evaluation of (REDUCE (FUNCTION LCM) ARGS)
 
User time    =        0.078
System time  =        0.000
Elapsed time =        0.055
Allocation   = 18759664 bytes
0 Page faults
Timing the evaluation of (JUST-LCM ARGS)
 
Error: Last argument to apply is too long.
  1 (abort) Return to level 0.
  2 Return to top loop level 0.
 
Type :b for backtrace or :c <option number> to proceed.
Type :bug-form "<subject>" for a bug report template or :? for other options.
 
CL-USER 50 : 1 > :c 1
 
User time    =        0.031
System time  =        0.046
Elapsed time =        4.619
Allocation   = 104792 bytes
0 Page faults
Calls to %EVAL    2060
 
CL-USER 51 >

transformator.t · 25.11.2014, 07:52

korvin_,

Lisp

INSOMNIA> (defun compare-lcm (n)
            (let ((args (loop :for x :from 2 :to n :collect x)))
              (= (time (reduce #'lcm args))
                 (time (reduced-lcm n)))))
STYLE-WARNING: redefining INSOMNIA::COMPARE-LCM in DEFUN
COMPARE-LCM
INSOMNIA> (compare-lcm 100000)
Evaluation took:
  8.141 seconds of real time
  8.100000 seconds of total run time (7.941000 user, 0.159000 system)
  [ Run times consist of 0.186 seconds GC time, and 7.914 seconds non-GC time. ]
  99.50% CPU
  19,489,953,348 processor cycles
  2,721,102,784 bytes consed
  
Evaluation took:
  10.753 seconds of real time
  10.705000 seconds of total run time (10.670000 user, 0.035000 system)
  [ Run times consist of 0.049 seconds GC time, and 10.656 seconds non-GC time. ]
  99.55% CPU
  25,740,552,591 processor cycles
  2,721,082,624 bytes consed
  
T

твою reduced-lcm не переопределял

@korvin_ · 25.11.2014, 09:31

Сообщение от transformator.t

твою reduced-lcm не переопределял

Гм, забавно... Это SBCL? Может в LispWorks reduce кривой. =/

Добавлено через 5 минут

Сообщение от castorsky

Это не простой проход

А какой?

Сообщение от castorsky

универсальная рекурсивная фвп

1) это просто свертка (fold);
2) сомневаюсь, что в CL она сделана рекурсивно, иначе LW уже бы выдал переполнение стека. Впрочем он умеет немного TCO, но сомневаюсь, что там не цикл внутри.

transformator.t · 25.11.2014, 10:11

korvin_, да, это sbcl

Bash

# eix -I sbcl
[I] dev-lisp/sbcl
     Available versions:  1.0.55-r1 (~)1.1.6-r3^m[1] (~)1.1.7^m[1] 1.1.18(0/1.1.18) (~)1.2.2(0/1.2.2) (~)1.2.4(0/1.2.4) {+asdf debug doc ldb pax_kernel source +threads +unicode zlib}
     Installed versions:  1.2.4(02:06:38 14.11.2014)(doc source threads unicode zlib -debug -pax_kernel)

@_sg 4699 / 4394 / 380 Регистрация: 12.05.2012 Сообщений: 3,096
		1
	Clojure Project Euler: Smallest multiple 23.11.2014, 19:51. Показов 1552. Ответов 16 Метки нет (Все метки) Project Euler: Smallest multiple 2520 - самое маленькое число, которое делится без остатка на все числа от 1 до 10. Какое самое маленькое число делится нацело на все числа от 1 до 20? 0

@castorsky 1978 / 1082 / 87 Регистрация: 29.11.2013 Сообщений: 3,353
	24.11.2014, 17:20	12
	Сообщение от korvin_ я думал на Project Euler Типовые, в первых местах конечно, дальше я не смотрел. Может хедхант, не знаю. 0

@korvin_ 4486 / 2721 / 485 Регистрация: 28.04.2012 Сообщений: 8,589
	25.11.2014, 09:31	16
	Сообщение от transformator.t твою reduced-lcm не переопределял Гм, забавно... Это SBCL? Может в LispWorks reduce кривой. =/ Добавлено через 5 минут Сообщение от castorsky Это не простой проход А какой? Сообщение от castorsky универсальная рекурсивная фвп 1) это просто свертка (fold); 2) сомневаюсь, что в CL она сделана рекурсивно, иначе LW уже бы выдал переполнение стека. Впрочем он умеет немного TCO, но сомневаюсь, что там не цикл внутри. 0