fork download
copy 
  1. (defparameter *implementations*
  2.   (list
  3.    ;; ideone.com/g6m1EK
  4.    (defun find-second-smallest-number-r1 (list)
  5.      (loop for n in list
  6.            for second = n then (if (< first n second) n second)
  7.            minimize n into first
  8.            finally (return (if (> second first) second nil))))
  9.  
  10.    (defun find-second-smallest-number-r2-UNIQ-AND-SORT (list)
  11.      (let ((result (if (null list)
  12.                        nil
  13.                        (nth 1 (sort (remove-duplicates list) #'<)))))
  14.        ;; sort 函数によって比較函数 < が適用されることで、数以外を含む
  15.        ;; ときはエラーとなることを期待したが、要素が一つだけのときは比
  16.        ;; 較されないためエラーも起きない。
  17.        (when (and (eq result nil)
  18.                   (not (null list))
  19.                   (not (subtypep (type-of (first list)) 'real)))
  20.          (error 'type-error :expected-type 'real :datum (first list)))
  21.        result))
  22.  
  23.    (defun find-second-smallest-number-r3 (list)
  24.      (when (eq (nth 1 list) nil)
  25.        ;; (nth 1 list) の値が nil のとき、LIST は空リストであるか、要
  26.        ;; 素数が 1 であるか、または先頭から二つ目の要素が nil である。
  27.        ;; このとき LIST の要素に大小比較可能な数以外の要素が含まれる場
  28.        ;; 合はコンディション type-error を送出する。
  29.        (loop for x in list
  30.              unless (subtypep (type-of x) 'real)
  31.                do (error 'type-error :expected-type 'real :datum x)))
  32.      (loop for n in list
  33.            for 2nd = nil then (if (= n 1st)
  34.                                   2nd
  35.                                   (if (null 2nd)
  36.                                       (max n 1st)
  37.                                       (if (< n 1st)
  38.                                           (max n 1st)
  39.                                           (min n 2nd))))
  40.            minimize n into 1st
  41.            finally (return 2nd)))))
  42.  
  43. (defparameter *test-cases*
  44.   (let ((N 100000)
  45.         (type-error (make-condition 'type-error :datum nil :expected-type t)))
  46.     `(((4 5 1 7 1 2 8 9 2 7) 2)
  47.       ((2 2 2 2 2 2 2 2 2 2) nil)
  48.       ((1) nil)
  49.       ((2 1) 2)
  50.       ((1 2) 2)
  51.       ((3 2 1) 2)
  52.       ((1/2 1/3 1/42) 1/3)
  53.       ((,pi 3.14) ,pi)
  54.       ((3.141592653589793d0 ,(log #c(-1 0))) ,type-error)
  55.       ((0) nil)
  56.       (() nil)
  57.       ((t) ,type-error)
  58.       ((1 nil) ,type-error)
  59.       ((1 2 3 nil) ,type-error)
  60.       (,(cons 2 (make-list N :initial-element 1)) 2)
  61.       (,(cons 2 (make-list N :initial-element nil)) ,type-error))))
  62.  
  63. (defun run-tests (fn test-cases &optional (detailed-output-p t))
  64.   (flet ((test (expected result)
  65.            (if (and detailed-output-p (subtypep (type-of expected) 'condition))
  66.                (subtypep (type-of result) (type-of expected))
  67.                (eql result expected))))
  68.     (loop with *print-length* = 10
  69.           with *print-right-margin* = 5000
  70.           for (arg expected) in test-cases
  71.           for result = (handler-case (funcall fn arg)
  72.                          (error (condition)
  73.                            (if detailed-output-p
  74.                                condition
  75.                                (class-name (class-of condition)))))
  76.           for all-tests-passed-p = (test expected result)
  77.             then (and all-tests-passed-p (test expected result))
  78.           do (format t (if detailed-output-p
  79.                            "~:[❌~;✓~] ~:S → ~S~%"
  80.                            "~*~:S → ~A~%")
  81.                      (test expected result)
  82.                      arg
  83.                      result)
  84.           finally (return all-tests-passed-p))))
  85.  
  86. (defun make-string-sink ()
  87.   (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))
  88. (defun clear-string-sink (sink)
  89.   (setf (fill-pointer sink) 0))
  90.  
  91. (let ((debug nil))
  92.   (let ((fn (car (last *implementations*))))
  93.     (run-tests fn *test-cases* nil))
  94.   (format t "~%~50@{=~}~2%" t)
  95.   (let ((tests-output (make-string-sink))
  96.         all-tests-passed-p)
  97.     (dolist (fn *implementations*)
  98.       #+clisp (format t "~2%")
  99.       (format t "Testing ‘~(~A~)’... " fn)
  100.       (with-output-to-string (*standard-output* tests-output)
  101.         (setq all-tests-passed-p (run-tests fn *test-cases*)))
  102.       (format t "~:[FAILED~;OK~]~%" all-tests-passed-p)
  103.       (if all-tests-passed-p
  104.           ;; テストを通過したら速度も計測。
  105.           (time (loop repeat 100000 do (funcall fn (caar *test-cases*))))
  106.           (if debug
  107.               (write-line tests-output)
  108.               (terpri)))
  109.       (clear-string-sink tests-output))))
  110.  
Success #stdin #stdout 0.14s 42692KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(4 5 1 7 1 2 8 9 2 7) → 2
(2 2 2 2 2 2 2 2 2 2) → NIL
(1) → NIL
(2 1) → 2
(1 2) → 2
(3 2 1) → 2
(1/2 1/3 1/42) → 1/3
(3.141592653589793d0 3.14) → 3.141592653589793d0
(3.141592653589793d0 #C(0.0 3.1415927)) → TYPE-ERROR
(0) → NIL
() → NIL
(T) → TYPE-ERROR
(1 NIL) → TYPE-ERROR
(1 2 3 NIL) → TYPE-ERROR
(2 1 1 1 1 1 1 1 1 1 ...) → 2
(2 NIL NIL NIL NIL NIL NIL NIL NIL NIL ...) → TYPE-ERROR

==================================================

Testing ‘find-second-smallest-number-r1’... FAILED

Testing ‘find-second-smallest-number-r2-uniq-and-sort’... OK
Evaluation took:
  0.084 seconds of real time
  0.082834 seconds of total run time (0.081273 user, 0.001561 system)
  [ Run times consist of 0.006 seconds GC time, and 0.077 seconds non-GC time. ]
  98.81% CPU
  292,018,202 processor cycles
  11,205,600 bytes consed
  
Testing ‘find-second-smallest-number-r3’... OK
Evaluation took:
  0.013 seconds of real time
  0.012678 seconds of total run time (0.012678 user, 0.000000 system)
  100.00% CPU
  44,498,694 processor cycles
  0 bytes consed
https://ideone.com/Bct7bC
language:
Common Lisp (sbcl 1.4.16)
created:
260 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!