結果

問題 No.1207 グラフX
ユーザー sansaquasansaqua
提出日時 2020-08-30 13:35:15
言語 Common Lisp
(sbcl 2.3.8)
結果
AC  
実行時間 353 ms / 2,000 ms
コード長 19,652 bytes
コンパイル時間 892 ms
コンパイル使用メモリ 70,212 KB
実行使用メモリ 91,432 KB
最終ジャッジ日時 2023-08-09 11:53:38
合計ジャッジ時間 14,505 ms
ジャッジサーバーID
(参考情報)
judge12 / judge14
外部呼び出し有り
このコードへのチャレンジ
(要ログイン)

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 271 ms
44,032 KB
testcase_01 AC 277 ms
46,120 KB
testcase_02 AC 265 ms
45,768 KB
testcase_03 AC 273 ms
44,188 KB
testcase_04 AC 264 ms
44,152 KB
testcase_05 AC 324 ms
91,432 KB
testcase_06 AC 327 ms
89,772 KB
testcase_07 AC 326 ms
89,640 KB
testcase_08 AC 246 ms
37,872 KB
testcase_09 AC 242 ms
45,728 KB
testcase_10 AC 338 ms
69,588 KB
testcase_11 AC 353 ms
89,572 KB
testcase_12 AC 241 ms
39,984 KB
testcase_13 AC 186 ms
33,916 KB
testcase_14 AC 268 ms
44,108 KB
testcase_15 AC 246 ms
39,988 KB
testcase_16 AC 171 ms
31,816 KB
testcase_17 AC 203 ms
43,684 KB
testcase_18 AC 159 ms
38,052 KB
testcase_19 AC 239 ms
33,856 KB
testcase_20 AC 272 ms
44,100 KB
testcase_21 AC 54 ms
27,760 KB
testcase_22 AC 203 ms
37,952 KB
testcase_23 AC 210 ms
43,708 KB
testcase_24 AC 144 ms
37,928 KB
testcase_25 AC 265 ms
44,188 KB
testcase_26 AC 220 ms
40,112 KB
testcase_27 AC 256 ms
44,184 KB
testcase_28 AC 252 ms
41,980 KB
testcase_29 AC 237 ms
45,860 KB
testcase_30 AC 151 ms
37,476 KB
testcase_31 AC 176 ms
33,472 KB
testcase_32 AC 119 ms
35,856 KB
testcase_33 AC 134 ms
33,776 KB
testcase_34 AC 241 ms
40,056 KB
testcase_35 AC 52 ms
29,696 KB
testcase_36 AC 239 ms
42,064 KB
testcase_37 AC 223 ms
41,712 KB
testcase_38 AC 77 ms
33,404 KB
testcase_39 AC 132 ms
33,836 KB
testcase_40 AC 156 ms
29,796 KB
testcase_41 AC 209 ms
37,684 KB
testcase_42 AC 20 ms
25,316 KB
testcase_43 AC 21 ms
28,504 KB
testcase_44 AC 20 ms
28,592 KB
testcase_45 AC 261 ms
44,112 KB
testcase_46 AC 258 ms
44,120 KB
testcase_47 AC 260 ms
44,092 KB
testcase_48 AC 259 ms
48,012 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 09 AUG 2023 11:53:23 AM):
; processing (UNLESS (MEMBER :CHILD-SBCL ...) ...)
; processing (IN-PACKAGE :CL-USER)
; processing (SB-INT:DEFCONSTANT-EQX OPT ...)
; processing (SET-DISPATCH-MACRO-CHARACTER #\# ...)
; processing (DEFMACRO DEFINE-INT-TYPES ...)
; processing (DEFINE-INT-TYPES 2 ...)
; processing (DEFCONSTANT +MOD+ ...)
; processing (DEFMACRO DBG ...)
; processing (DECLAIM (INLINE PRINTLN))
; processing (DEFUN PRINTLN ...)
; processing (DEFPACKAGE :CP/BORUVKA ...)
; processing (IN-PACKAGE :CP/BORUVKA)
; processing (DEFCONSTANT +INF-COST+ ...)
; processing (DECLAIM (INLINE FIND-MST) ...)
; processing (DEFUN FIND-MST ...)
; processing (DEFPACKAGE :CP/MOD-POWER ...)
; processing (IN-PACKAGE :CP/MOD-POWER)
; processing (DECLAIM (INLINE MOD-POWER))
; processing (DEFUN MOD-POWER ...)
; processing (DEFPACKAGE :CP/MOD-OPERATIONS ...)
; processing (IN-PACKAGE :CP/MOD-OPERATIONS)
; processing (DEFMACRO DEFINE-MOD-OPERATIONS ...)
; processing (DEFPACKAGE :CP/READ-FIXNUM ...)
; processing (IN-PACKAGE :CP/READ-FIXNUM)
; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN READ-FIXNUM ...)
; processing (DEFPACKAGE :CP/DISJOINT-SET ...)
; processing (IN-PACKAGE :CP/DISJOINT-SET)
; processing (DEFSTRUCT (DISJOINT-SET # ...) ...)
; processing (DECLAIM (INLINE DS-ROOT))
; processing (DEFUN DS-ROOT ...)
; processing (DECLAIM (INLINE DS-UNITE!))
; processing (DEFUN DS-UNITE! ...)
; processing (DECLAIM (INLINE DS-CONNECTED-P))
; processing (DEFUN DS-CONNECTED-P ...)
; processing (DECLAIM (INLINE DS-SIZE))
; processing (DEFUN DS-SIZE ...)
; processing (DEFPACKAGE :CP/PARALLEL-SORT ...)
; processing (IN-PACKAGE :CP/PARALLEL-SORT)
; processing (DECLAIM (INLINE %MEDIAN3))
; processing (DEFUN %MEDIAN3 ...)
; processing (DEFUN PARALLEL-SORT! ...)
; processing (SB-C:DEFINE-SOURCE-TRANSFORM PARALLEL-SORT! ...)
; processing (USE-PACKAGE :CP/PARALLEL-SORT ...)
; processing (USE-PACKAGE :CP/DISJOINT-SET ...)
; processing (USE-PA

ソースコード

diff #

#-swank
(unless (member :child-sbcl *features*)
  (quit
   :unix-status
   (process-exit-code
    (run-program *runtime-pathname*
                 `("--control-stack-size" "128MB"
                   "--noinform" "--disable-ldb" "--lose-on-corruption" "--end-runtime-options"
                   "--eval" "(push :child-sbcl *features*)"
                   "--script" ,(namestring *load-pathname*))
                 :output t :error t :input t))))
(in-package :cl-user)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:defconstant-eqx opt
    #+swank '(optimize (speed 3) (safety 2))
    #-swank '(optimize (speed 3) (safety 0) (debug 0))
    #'equal)
  #+swank (ql:quickload '(:cl-debug-print :fiveam) :silent t)
  #-swank (set-dispatch-macro-character
           #\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t)))))
#+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)

(defmacro define-int-types (&rest bits)
  `(progn
     ,@(mapcar (lambda (b) `(deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))) bits)
     ,@(mapcar (lambda (b) `(deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))) bits)))
(define-int-types 2 4 7 8 15 16 31 32 62 63 64)

(defconstant +mod+ 1000000007)

(defmacro dbg (&rest forms)
  #+swank (if (= (length forms) 1)
              `(format *error-output* "~A => ~A~%" ',(car forms) ,(car forms))
              `(format *error-output* "~A => ~A~%" ',forms `(,,@forms)))
  #-swank (declare (ignore forms)))

(declaim (inline println))
(defun println (obj &optional (stream *standard-output*))
  (let ((*read-default-float-format* 'double-float))
    (prog1 (princ obj stream) (terpri stream))))

;; BEGIN_INSERTED_CONTENTS
;;;
;;; Minimum spanning tree (Boruvka's algorithm, O(ElogV))
;;;
;;; Reference:
;;; Ahuja, Magnanti, Orlin. Network Flows: Theory, Algorithms, and Applications.
;;;

(defpackage :cp/boruvka
  (:use :cl)
  (:export #:find-mst))
(in-package :cp/boruvka)

(defconstant +inf-cost+ most-positive-fixnum)

;; Here I express each connected component as a cycle with singly-linked list,
;; though Ahuja's book adopts doubly-linked list. I learned about this technique
;; in noshi91's article: http://noshi91.hatenablog.com/entry/2019/07/19/180606
;; (Japanese)

(declaim (inline find-mst)
         (ftype (function * (values (simple-array fixnum (*))
                                    (simple-array fixnum (*))
                                    (simple-array fixnum (*))
                                    &optional))
                find-mst))
(defun find-mst (graph &key (vertex-key #'car) (cost-key #'cdr) maximize)
  "Computes an MST by Boruvka's algorithm. Returns three values: a vector that
stores each cost of the edges, two vectors that store each end of the edges. If
GRAPH is not connected, this function computes MST for each connected component.

GRAPH := vector of adjacency lists
MAXIMIZE := if true, solve maximization problem instead"
  (declare (vector graph))
  (let* ((n (length graph))
         (roots (make-array n :element-type 'fixnum))
         ;; next node in a connected component
         (nexts (make-array n :element-type 'fixnum))
         (min-costs (make-array n :element-type 'fixnum))
         (min-srcs (make-array n :element-type 'fixnum))
         (min-dests (make-array n :element-type 'fixnum))
         (edge-count 0)
         (res-costs (make-array (max 0 (- n 1)) :element-type 'fixnum))
         (res-srcs (make-array (max 0 (- n 1)) :element-type 'fixnum))
         (res-dests (make-array (max 0 (- n 1)) :element-type 'fixnum)))
    (dotimes (i n)
      (setf (aref roots i) i
            (aref nexts i) i))
    (labels ((%add (src dest cost)
               "Adds a new edge to the (unfinished) MST."
               (declare (fixnum src dest cost))
               (when (> src dest) (rotatef src dest))
               (setf (aref res-srcs edge-count) src
                     (aref res-dests edge-count) dest
                     (aref res-costs edge-count) (if maximize (- cost) cost)
                     edge-count (+ edge-count 1)))
             (%merge (root1 root2)
               "Merges ROOT2 into ROOT1."
               (loop for v = (aref nexts root2) then (aref nexts v)
                     until (= v root2)
                     do (setf (aref roots v) root1)
                     finally (setf (aref roots v) root1))
               ;; meld two cycles
               (rotatef (aref nexts root1) (aref nexts root2))))
      (loop for updated = nil
            while (< edge-count (- n 1))
            do (fill min-costs +inf-cost+)
               ;; detect minimum cost edge starting from each connected component
               (dotimes (u n)
                 (let ((root (aref roots u)))
                   (dolist (edge (aref graph u))
                     (let ((v (funcall vertex-key edge))
                           (cost (funcall cost-key edge)))
                       (declare (fixnum v cost))
                       (when maximize (setq cost (- cost)))
                       (when (and (/= root (aref roots v))
                                  (<= cost (aref min-costs root)))
                         (setf (aref min-costs root) cost
                               (aref min-srcs root) u
                               (aref min-dests root) v))))))
               ;; merge all the pairs of connected components linked with above
               ;; enumerated edges
               (dotimes (v n)
                 (let* ((root (aref roots v))
                        (src (aref min-srcs root))
                        (dest (aref min-dests root))
                        (cost (aref min-costs root)))
                   (unless (= cost +inf-cost+) ; can be true if GRAPH is not connected
                     (loop for root2 = (aref roots dest)
                           until (= root root2)
                           do (setq updated t)
                              (%add src dest cost)
                              (%merge root root2)
                              (setq src (aref min-srcs root2)
                                    dest (aref min-dests root2)
                                    cost (aref min-costs root2))))))
            while updated)
      (values (adjust-array res-costs edge-count)
              (adjust-array res-srcs edge-count)
              (adjust-array res-dests edge-count)))))

(defpackage :cp/mod-power
  (:use :cl)
  (:export #:mod-power))
(in-package :cp/mod-power)

(declaim (inline mod-power))
(defun mod-power (base power modulus)
  "Returns BASE^POWER mod MODULUS. Note: 0^0 = 1.

BASE := integer
POWER, MODULUS := non-negative fixnum"
  (declare ((integer 0 #.most-positive-fixnum) modulus power)
           (integer base))
  (let ((base (mod base modulus))
        (res (mod 1 modulus)))
    (declare ((integer 0 #.most-positive-fixnum) base res))
    (loop while (> power 0)
          when (oddp power)
          do (setq res (mod (* res base) modulus))
          do (setq base (mod (* base base) modulus)
                   power (ash power -1)))
    res))


;;;
;;; Arithmetic operations with static modulus
;;;

(defpackage :cp/mod-operations
  (:use :cl)
  (:export #:define-mod-operations))
(in-package :cp/mod-operations)

;; NOTE: Currently MOD* and MOD+ doesn't apply MOD when the number of
;; parameters is one. For simplicity I won't fix it for now.
(defmacro define-mod-operations (divisor)
  (let ((mod* (intern "MOD*"))
        (mod+ (intern "MOD+"))
        (incfmod (intern "INCFMOD"))
        (decfmod (intern "DECFMOD"))
        (mulfmod (intern "MULFMOD")))
    `(progn
       (defun ,mod* (&rest args)
         (reduce (lambda (x y) (mod (* x y) ,divisor)) args))

       (defun ,mod+ (&rest args)
         (reduce (lambda (x y) (mod (+ x y) ,divisor)) args))

       #+sbcl
       (eval-when (:compile-toplevel :load-toplevel :execute)
         (locally (declare (sb-ext:muffle-conditions warning))
           (sb-c:define-source-transform ,mod* (&rest args)
             (if (null args)
                 1
                 (reduce (lambda (x y) `(mod (* ,x ,y) ,',divisor)) args)))
           (sb-c:define-source-transform ,mod+ (&rest args)
             (if (null args)
                 0
                 (reduce (lambda (x y) `(mod (+ ,x ,y) ,',divisor)) args)))))

       (define-modify-macro ,incfmod (delta)
         (lambda (x y) (mod (+ x y) ,divisor)))

       (define-modify-macro ,decfmod (delta)
         (lambda (x y) (mod (- x y) ,divisor)))

       (define-modify-macro ,mulfmod (multiplier)
         (lambda (x y) (mod (* x y) ,divisor))))))

(defpackage :cp/read-fixnum
  (:use :cl)
  (:export #:read-fixnum))
(in-package :cp/read-fixnum)

(declaim (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
  "NOTE: cannot read -2^62"
  (macrolet ((%read-byte ()
               `(the (unsigned-byte 8)
                     #+swank (char-code (read-char in nil #\Nul))
                     #-swank (sb-impl::ansi-stream-read-byte in nil #.(char-code #\Nul) nil))))
    (let* ((minus nil)
           (result (loop (let ((byte (%read-byte)))
                           (cond ((<= 48 byte 57)
                                  (return (- byte 48)))
                                 ((zerop byte) ; #\Nul
                                  (error "Read EOF or #\Nul."))
                                 ((= byte #.(char-code #\-))
                                  (setq minus t)))))))
      (declare ((integer 0 #.most-positive-fixnum) result))
      (loop
        (let* ((byte (%read-byte)))
          (if (<= 48 byte 57)
              (setq result (+ (- byte 48)
                              (* 10 (the (integer 0 #.(floor most-positive-fixnum 10))
                                         result))))
              (return (if minus (- result) result))))))))

;;;
;;; Disjoint set (union by size & path compression)
;;;

(defpackage :cp/disjoint-set
  (:use :cl)
  (:export #:disjoint-set #:make-disjoint-set #:ds-data
           #:ds-root #:ds-unite! #:ds-connected-p #:ds-size))
(in-package :cp/disjoint-set)

(defstruct (disjoint-set
            (:constructor make-disjoint-set
                (size &aux (data (make-array size :element-type 'fixnum :initial-element -1))))
            (:conc-name ds-)
            (:predicate nil)
            (:copier nil))
  (data nil :type (simple-array fixnum (*))))

(declaim (inline ds-root))
(defun ds-root (disjoint-set x)
  "Returns the root of X."
  (declare ((mod #.array-total-size-limit) x))
  (let ((data (ds-data disjoint-set)))
    (labels ((recur (x)
               (if (< (aref data x) 0)
                   x
                   (setf (aref data x)
                         (recur (aref data x))))))
      (recur x))))

(declaim (inline ds-unite!))
(defun ds-unite! (disjoint-set x1 x2)
  "Destructively unites X1 and X2 and returns true iff X1 and X2 become
connected for the first time."
  (let ((root1 (ds-root disjoint-set x1))
        (root2 (ds-root disjoint-set x2)))
    (unless (= root1 root2)
      (let ((data (ds-data disjoint-set)))
        ;; NOTE: If you want X1 to always be root, just delete this form. (Time
        ;; complexity becomes worse, however.)
        (when (> (aref data root1) (aref data root2))
          (rotatef root1 root2))
        (incf (aref data root1) (aref data root2))
        (setf (aref data root2) root1)))))

(declaim (inline ds-connected-p))
(defun ds-connected-p (disjoint-set x1 x2)
  "Returns true iff X1 and X2 have the same root."
  (= (ds-root disjoint-set x1) (ds-root disjoint-set x2)))

(declaim (inline ds-size))
(defun ds-size (disjoint-set x)
  "Returns the size of the connected component to which X belongs."
  (- (aref (ds-data disjoint-set)
           (ds-root disjoint-set x))))

;;;
;;; Sort multiple vectors
;;;

(defpackage :cp/parallel-sort
  (:use :cl)
  (:export #:parallel-sort!))
(in-package :cp/parallel-sort)

;; TODO: throw an error if there are two ore more identical vectors in the given
;; vectors

(declaim (inline %median3))
(defun %median3 (x y z order)
  (if (funcall order x y)
      (if (funcall order y z)
          y
          (if (funcall order z x)
              x
              z))
      (if (funcall order z y)
          y
          (if (funcall order x z)
              x
              z))))

(defun parallel-sort! (vector order &rest vectors)
  "Destructively sorts VECTOR w.r.t. ORDER and applies the same permutation to
all the vectors in VECTORS.

Note: not randomized; shuffle the inputs if necessary"
  (declare (vector vector))
  (labels
      ((recur (left right)
         (when (< left right)
           (let* ((l left)
                  (r right)
                  (pivot (%median3 (aref vector l)
                                   (aref vector (ash (+ l r) -1))
                                   (aref vector r)
                                   order)))
             (declare ((integer 0 #.most-positive-fixnum) l r))
             (loop (loop while (funcall order (aref vector l) pivot)
                         do (incf l 1))
                   (loop while (funcall order pivot (aref vector r))
                         do (decf r 1))
                   (when (>= l r)
                     (return))
                   (rotatef (aref vector l) (aref vector r))
                   (dolist (v vectors)
                     (rotatef (aref v l) (aref v r)))
                   (incf l 1)
                   (decf r 1))
             (recur left (- l 1))
             (recur (+ r 1) right)))))
    (recur 0 (- (length vector) 1))
    vector))

#+sbcl
(eval-when (:compile-toplevel :load-toplevel :execute)
  (locally (declare (sb-ext:muffle-conditions warning))
    (sb-c:define-source-transform parallel-sort! (vector order &rest vectors)
      (let ((vec (gensym))
            (vecs (loop for _ in vectors collect (gensym))))
        `(let ((,vec ,vector)
               ,@(loop for v in vectors
                       for sym in vecs
                       collect `(,sym ,v)))
           (labels
               ((recur (left right)
                  (when (< left right)
                    (let* ((l left)
                           (r right)
                           (pivot (%median3 (aref ,vec l)
                                            (aref ,vec (ash (+ l r) -1))
                                            (aref ,vec r)
                                            ,order)))
                      (declare ((integer 0 #.most-positive-fixnum) l r))
                      (loop (loop while (funcall ,order (aref ,vec l) pivot)
                                  do (incf l 1))
                            (loop while (funcall ,order pivot (aref ,vec r))
                                  do (decf r 1))
                            (when (>= l r)
                              (return))
                            (rotatef (aref ,vec l) (aref ,vec r))
                            ,@(loop for sym in vecs
                                    collect `(rotatef (aref ,sym l) (aref ,sym r)))
                            (incf l 1)
                            (decf r 1))
                      (recur left (- l 1))
                      (recur (+ r 1) right)))))
             (recur 0 (- (length ,vec) 1))
             ,vec))))))

;; BEGIN_USE_PACKAGE
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/parallel-sort :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/disjoint-set :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/read-fixnum :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/mod-operations :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/mod-power :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/boruvka :cl-user))
(in-package :cl-user)

;;;
;;; Body
;;;

(define-mod-operations +mod+)
(defun main ()
  (let* ((n (read))
         (m (read))
         (x (read))
         (us (make-array m :element-type 'uint31 :initial-element 0))
         (vs (make-array m :element-type 'uint31 :initial-element 0))
         (zs (make-array m :element-type 'uint31 :initial-element 0))
         (res 0))
    (declare (uint31 n m x res))
    (dotimes (i m)
      (let ((x (- (read-fixnum) 1))
            (y (- (read-fixnum) 1))
            (z (read-fixnum)))
        (setf (aref us i) x
              (aref vs i) y
              (aref zs i) z)))
    (parallel-sort! zs #'< us vs)
    (let ((dset (make-disjoint-set n))
          (graph (make-array n :element-type 'list :initial-element nil))
          (sizes (make-array n :element-type 'uint31 :initial-element 0)))
      (loop for u across us
            for v across vs
            for z across zs
            for cost = (mod-power x z +mod+)
            when (ds-unite! dset u v)
            do (push (cons u cost) (aref graph v))
               (push (cons v cost) (aref graph u)))
      (sb-int:named-let dfs ((v 0) (parent -1))
        (let ((value 1))
          (loop for (child . cost) in (aref graph v)
                unless (= child parent)
                do (dfs child v)
                   (incf value (aref sizes child)))
          (setf (aref sizes v) value)))
      #>sizes
      (sb-int:named-let dfs ((v 0) (parent -1))
        (loop for (child . cost) of-type (uint31 . uint31) in (aref graph v)
              for size1 = (aref sizes child)
              for size2 of-type uint31 = (- n size1)
              unless (= child parent)
              do (incfmod res (mod* cost size1 size2))
                 (dfs child v))))
    (println res)))

#-swank (main)

;;;
;;; Test and benchmark
;;;

#+swank
(defun get-clipbrd ()
  (with-output-to-string (out)
    #+os-windows (run-program "powershell.exe" '("-Command" "Get-Clipboard") :output out :search t)
    #+os-unix (run-program "xsel" '("-b" "-o") :output out :search t)))

#+swank (defparameter *this-pathname* (uiop:current-lisp-file-pathname))
#+swank (defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *this-pathname*))

#+swank
(defun run (&optional thing (out *standard-output*))
  "THING := null | string | symbol | pathname

null: run #'MAIN using the text on clipboard as input.
string: run #'MAIN using the string as input.
symbol: alias of FIVEAM:RUN!.
pathname: run #'MAIN using the text file as input."
  (let* ((*standard-output* (or out (make-string-output-stream)))
         (res (etypecase thing
                (null
                 (with-input-from-string (*standard-input* (delete #\Return (get-clipbrd)))
                   (main)))
                (string
                 (with-input-from-string (*standard-input* (delete #\Return thing))
                   (main)))
                (symbol (5am:run! thing))
                (pathname
                 (with-open-file (*standard-input* thing)
                   (main))))))
    (if out res (get-output-stream-string *standard-output*))))

#+swank
(defun gen-dat ()
  (uiop:with-output-file (out *dat-pathname* :if-exists :supersede)
    (format out "")))

#+swank
(defun bench (&optional (out (make-broadcast-stream)))
  (time (run *dat-pathname* out)))

;; To run: (5am:run! :sample)
#+swank
(it.bese.fiveam:test :sample
  (it.bese.fiveam:is
   (equal "8
"
          (run "3 2 3
1 2 0
2 3 1
" nil)))
  (it.bese.fiveam:is
   (equal "2660500
"
          (run "5 5 5
1 4 3
2 4 4
3 5 7
2 3 8
2 3 10
" nil)))
  (it.bese.fiveam:is
   (equal "524978526
"
          (run "6 8 1000000
2 6 10
3 5 11
4 6 23
1 3 26
1 6 30
5 6 48
3 5 88
3 6 100
" nil))))
0