Wiki » 履歴 » バージョン 1
Noppi, 2026/05/11 08:44
| 1 | 1 | Noppi | [ホーム](https://redmine.noppi.jp) |
|---|---|---|---|
| 2 | # [[素数日]] |
||
| 3 | |||
| 4 | ```cl |
||
| 5 | ;; -*- coding: utf-8; -*- |
||
| 6 | |||
| 7 | (defconstant +start-day+ 20000101) |
||
| 8 | (defconstant +end-day+ 20991231) |
||
| 9 | (defconstant +day-elements+ (1+ +end-day+)) |
||
| 10 | |||
| 11 | (defparameter *calendar-number* |
||
| 12 | (make-array +day-elements+ :element-type 'boolean :initial-element t)) |
||
| 13 | |||
| 14 | (defun eratosthenes () |
||
| 15 | (setf (svref *calendar-number* 0) nil) |
||
| 16 | (setf (svref *calendar-number* 1) nil) |
||
| 17 | (do ((n1 2 (1+ n1))) |
||
| 18 | ((<= +end-day+ (* n1 n1))) |
||
| 19 | (when (svref *calendar-number* n1) |
||
| 20 | (do ((n2 (* n1 2) (+ n2 n1))) |
||
| 21 | ((< +end-day+ n2)) |
||
| 22 | (setf (svref *calendar-number* n2) nil))))) |
||
| 23 | |||
| 24 | (defun primes () |
||
| 25 | (eratosthenes) |
||
| 26 | (do ((n +start-day+ (1+ n)) |
||
| 27 | (result nil)) |
||
| 28 | ((< +end-day+ n) (reverse result)) |
||
| 29 | (when (svref *calendar-number* n) |
||
| 30 | (setf result (cons n result))))) |
||
| 31 | |||
| 32 | (defun leap-year-p (year) |
||
| 33 | ;; year % 4 == 0 && year % 100 != 0 || year % 400 == 0 |
||
| 34 | (or (and (zerop (mod year 4)) |
||
| 35 | (not (zerop (mod year 100)))) |
||
| 36 | (zerop (mod year 400)))) |
||
| 37 | |||
| 38 | (defun dayp (n) |
||
| 39 | (let ((yyyy (floor n 10000)) |
||
| 40 | (mm (floor (mod n 10000) 100)) |
||
| 41 | (dd (mod n 100))) |
||
| 42 | (case mm |
||
| 43 | ((1 3 5 7 8 10 12) |
||
| 44 | (<= 1 dd 31)) |
||
| 45 | ((4 6 9 11) |
||
| 46 | (<= 1 dd 30)) |
||
| 47 | (2 |
||
| 48 | (if (leap-year-p yyyy) |
||
| 49 | (<= 1 dd 29) |
||
| 50 | (<= 1 dd 28)))))) |
||
| 51 | |||
| 52 | (defun prime-days () |
||
| 53 | (remove-if-not #'dayp (primes))) |
||
| 54 | |||
| 55 | (defun prime-days-2026 () |
||
| 56 | (remove-if-not (lambda (yyyymmdd) |
||
| 57 | (= 2026 (floor yyyymmdd 10000))) |
||
| 58 | (prime-days))) |
||
| 59 | ``` |