結果

問題 No.1054 Union add query
ユーザー sansaquasansaqua
提出日時 2020-05-15 22:13:21
言語 Common Lisp
(sbcl 2.3.8)
結果
AC  
実行時間 370 ms / 2,000 ms
コード長 24,498 bytes
コンパイル時間 1,621 ms
コンパイル使用メモリ 85,440 KB
実行使用メモリ 73,540 KB
最終ジャッジ日時 2023-10-19 14:42:24
合計ジャッジ時間 5,405 ms
ジャッジサーバーID
(参考情報)
judge14 / judge12
このコードへのチャレンジ
(要ログイン)

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 13 ms
31,628 KB
testcase_01 AC 12 ms
31,628 KB
testcase_02 AC 12 ms
31,628 KB
testcase_03 AC 356 ms
42,796 KB
testcase_04 AC 327 ms
73,540 KB
testcase_05 AC 275 ms
38,668 KB
testcase_06 AC 370 ms
51,008 KB
testcase_07 AC 267 ms
51,008 KB
testcase_08 AC 318 ms
48,960 KB
testcase_09 AC 270 ms
73,540 KB
testcase_10 AC 112 ms
71,488 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 19 OCT 2023 05:42:18 AM):

; file: /home/judge/data/code/Main.lisp
; in: DEFUN MAIN
;     (TREAP-UPDATE (AREF DP ROOT) B)
; --> BLOCK LABELS RECUR BLOCK WHEN IF IF LET IF OR LET IF NOT 
; ==>
;   1
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a FIXNUM, not a (INTEGER -16777216 16777216).
;   The second argument is a REAL, not a SINGLE-FLOAT.
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a FIXNUM, not a (OR SINGLE-FLOAT
;                                             (INTEGER -9007199254740992
;                                              9007199254740992)).
;   The second argument is a REAL, not a DOUBLE-FLOAT.

; --> BLOCK LABELS RECUR BLOCK WHEN IF IF LET IF IF OR LET IF FUNCALL 
; ==>
;   1
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a FIXNUM, not a (INTEGER -16777216 16777216).
;   The second argument is a REAL, not a SINGLE-FLOAT.
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a FIXNUM, not a (OR SINGLE-FLOAT
;                                             (INTEGER -9007199254740992
;                                              9007199254740992)).
;   The second argument is a REAL, not a DOUBLE-FLOAT.

;     (DOTIMES (_ Q)
;       (LET ((TYPE (READ-FIXNUM)) (A (READ-FIXNUM)) (B (READ-FIXNUM)))
;         (ECASE TYPE
;           (1
;            (DECF A)
;            (DECF B)
;            (LET #
;              #))
;           (2
;            (DECF A)
;            (LET #
;              #))
;           (3
;            (DECF A)
;            (LET #
;              #)))))
; --> BLOCK LET TAGBODY UNLESS IF >= 
; ==>
;   1
; 
; note: forced to do GENERIC-< (cost 10)
;       unable to do inline fixnum comparison (cost 4) because:
;       The first argument is a UNSIGNED-BYTE, not a FIXNUM.
;       The second argument is a INTEGER, not a FIXNUM.

; --> B

ソースコード

diff #

(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)
#-swank (disable-debugger) ; for CS Academy

;; BEGIN_INSERTED_CONTENTS
(declaim (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
  "NOTE: cannot read -2^62"
  (declare #.OPT)
  (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 by Union-Find algorithm
;;;

(defstruct (disjoint-set
            (:constructor make-disjoint-set
                (size &aux (data (make-array size :element-type 'fixnum :initial-element -1))))
            (:conc-name ds-))
  (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)))
        ;; ensure the size of root1 >= the size of root2
        (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))))

;;;
;;; Treap with explicit key
;;; Virtually it works like std::map, std::multiset, or java.util.TreeMap.
;;;

;; Tips to use this structure as a multiset: Just define OP as (defun op (x y)
;; (+ x y)) and insert each element by
;;
;; (treap-ensure-key <treap> <key> 1 :if-exists #'1+)
;;
;; instead of TREAP-INSERT.

;; TODO & NOTE: insufficient tests
;; TODO: introduce abstraction by macro

(declaim (inline op))
(defun op (x y)
  "Is the operator comprising a monoid"
  (min x y))

(defconstant +op-identity+ most-positive-fixnum
  "identity element w.r.t. OP")

(declaim (inline updater-op))
(defun updater-op (a b)
  "Is the operator to compute and update LAZY value."
  (+ a b))

(defconstant +updater-identity+ 0
  "identity element w.r.t. UPDATER-OP")

;; FIXME: Should the left and right end of the target interval be included?
(declaim (inline modifier-op))
(defun modifier-op (a b)
  "Is the operator to update ACCUMULATOR based on LAZY value."
  (+ a b))

(defstruct (treap (:constructor %make-treap (key priority value &key left right lazy))
                  (:copier nil)
                  (:conc-name %treap-))
  (key 0 :type fixnum)
  (value +op-identity+ :type fixnum)
  (lazy +updater-identity+ :type fixnum)
  (priority 0 :type (integer 0 #.most-positive-fixnum))
  (left nil :type (or null treap))
  (right nil :type (or null treap)))

(declaim (inline treap-key))
(defun treap-key (treap)
  "Returns the key of the (nullable) TREAP."
  (and treap (%treap-key treap)))

(declaim (inline force-down))
(defun force-down (treap)
  "Propagates down the information to children."
  (declare (treap treap))
  (unless (eql +updater-identity+ (%treap-lazy treap))
    (when (%treap-left treap)
      (setf (%treap-lazy (%treap-left treap))
            (updater-op (%treap-lazy (%treap-left treap))
                        (%treap-lazy treap))))
    (when (%treap-right treap)
      (setf (%treap-lazy (%treap-right treap))
            (updater-op (%treap-lazy (%treap-right treap))
                        (%treap-lazy treap))))
    (setf (%treap-value treap)
          (modifier-op (%treap-value treap)
                       (%treap-lazy treap)))
    (setf (%treap-lazy treap) +updater-identity+)))

(declaim (ftype (function * (values (or null treap) (or null treap) &optional)) treap-split))
(defun treap-split (treap key &key (order #'<))
  "Destructively splits the TREAP with reference to KEY and returns two treaps,
the smaller sub-treap (< KEY) and the larger one (>= KEY)."
  (declare (function order)
           ((or null treap) treap))
  (if (null treap)
      (values nil nil)
      (progn
        (force-down treap)
        (if (funcall order (%treap-key treap) key)
            (multiple-value-bind (left right)
                (treap-split (%treap-right treap) key :order order)
              (setf (%treap-right treap) left)
              (values treap right))
            (multiple-value-bind (left right)
                (treap-split (%treap-left treap) key :order order)
              (setf (%treap-left treap) right)
              (values left treap))))))

(declaim (inline treap-insert))
(defun treap-insert (treap key value &key (order #'<))
  "Destructively inserts KEY into TREAP and returns the resultant treap. You
cannot rely on the side effect. Use the returned value.

The behavior is undefined when duplicate keys are inserted."
  (declare ((or null treap) treap)
           (function order))
  (labels ((recur (node treap)
             (declare (treap node))
             (unless treap (return-from recur node))
             (force-down treap)
             (if (> (%treap-priority node) (%treap-priority treap))
                 (progn
                   (setf (values (%treap-left node) (%treap-right node))
                         (treap-split treap (%treap-key node) :order order))
                   node)
                 (progn
                   (if (funcall order (%treap-key node) (%treap-key treap))
                       (setf (%treap-left treap)
                             (recur node (%treap-left treap)))
                       (setf (%treap-right treap)
                             (recur node (%treap-right treap))))
                   treap))))
    (recur (%make-treap key (random most-positive-fixnum) value) treap)))

(declaim (inline treap-ensure-key))
(defun treap-ensure-key (treap key value &key (order #'<) if-exists)
  "IF-EXISTS := nil | function

Ensures that TREAP contains KEY and assigns VALUE to it if IF-EXISTS is
false. If IF-EXISTS is function and TREAP already contains KEY, TREAP-ENSURE-KEY
updates the value by the function instead of overwriting it with VALUE."
  (declare (function order)
           ((or null treap) treap))
  (labels ((find-and-update (treap)
             ;; Updates the value slot and returns T if KEY exists
             (unless treap (return-from find-and-update nil))
             (force-down treap)
             (cond ((funcall order key (%treap-key treap))
                    (when (find-and-update (%treap-left treap))
                      t))
                   ((funcall order (%treap-key treap) key)
                    (when (find-and-update (%treap-right treap))
                      t))
                   (t (setf (%treap-value treap)
                            (if if-exists
                                (funcall if-exists (%treap-value treap))
                                value))
                      t))))
    (if (find-and-update treap)
        treap
        (treap-insert treap key value :order order))))

(defun treap-merge (left right)
  "Destructively concatenates two treaps. Assumes that all keys of LEFT are
smaller (or larger, depending on the order) than those of RIGHT.

Note that this `merge' is different from CL:MERGE and rather close to
CL:CONCATENATE."
  (declare (optimize (speed 3))
           ((or null treap) left right))
  (cond ((null left) (when right (force-down right)) right)
        ((null right) (when left (force-down left)) left)
        (t (force-down left)
           (force-down right)
         (if (> (%treap-priority left) (%treap-priority right))
             (progn
               (setf (%treap-right left)
                     (treap-merge (%treap-right left) right))
               left)
             (progn
               (setf (%treap-left right)
                     (treap-merge left (%treap-left right)))
               right)))))

(defun treap-delete (treap key &key (order #'<))
  "Destructively deletes the KEY in TREAP and returns the resultant
treap. Returns the unmodified TREAP If KEY doesn't exist. You cannot rely on the
side effect. Use the returned value.

 (Note that this function deletes at most one node even if duplicated keys
exist.)"
  (declare ((or null treap) treap)
           (function order))
  (when treap
    (force-down treap)
    (cond ((funcall order key (%treap-key treap))
           (setf (%treap-left treap)
                 (treap-delete (%treap-left treap) key :order order))
           treap)
          ((funcall order (%treap-key treap) key)
           (setf (%treap-right treap)
                 (treap-delete (%treap-right treap) key :order order))
           treap)
          (t
           (treap-merge (%treap-left treap) (%treap-right treap))))))

(declaim (inline treap-map))
(defun treap-map (function treap)
  "Successively applies FUNCTION to TREAP[0], ..., TREAP[SIZE-1]. FUNCTION must
take two arguments: KEY and VALUE."
  (labels ((recur (treap)
             (when treap
               (force-down treap)
               (recur (%treap-left treap))
               (funcall function (%treap-key treap) (%treap-value treap))
               (recur (%treap-right treap)))))
    (recur treap)))

(defmethod print-object ((object treap) stream)
  (print-unreadable-object (object stream :type t)
    (let ((init t))
      (treap-map (lambda (key value)
                   (if init
                       (setf init nil)
                       (write-char #\  stream))
                   (format stream "<~A . ~A>" key value))
                 object))))

(defmacro do-treap ((key-var value-var treap &optional result) &body body)
  "Successively binds the key and value of INODE[0], ..., INODE[SIZE-1] to
KEY-VAR and VALUE-VAR and executes BODY."
  `(block nil
     (treap-map (lambda (,key-var ,value-var) ,@body) ,treap)
     ,result))

;; This function takes O(nlog(n)) time. It is just for debugging.
(defun treap (order &rest key-and-values)
  "Takes cons cells in the form of (<key> . <value>)."
  (loop with res = nil
        for (key . value) in key-and-values
        do (setf res (treap-insert res key value :order order))
        finally (return res)))

;; Reference: https://cp-algorithms.com/data_structures/treap.html
;; TODO: take a sorted list as the argument
(declaim (inline make-treap))
(defun make-treap (sorted-vector)
  "Makes a treap using each key of the given SORTED-VECTOR in O(n) time. Note
that this function doesn't check if the SORTED-VECTOR is actually sorted
w.r.t. your intended order. The values are filled with the identity element."
  (declare (vector sorted-vector))
  (labels ((heapify (top)
             (when top
               (let ((prioritized-node top))
                 (when (and (%treap-left top)
                            (> (%treap-priority (%treap-left top))
                               (%treap-priority prioritized-node)))
                   (setq prioritized-node (%treap-left top)))
                 (when (and (%treap-right top)
                            (> (%treap-priority (%treap-right top))
                               (%treap-priority prioritized-node)))
                   (setq prioritized-node (%treap-right top)))
                 (unless (eql prioritized-node top)
                   (rotatef (%treap-priority prioritized-node)
                            (%treap-priority top))
                   (heapify prioritized-node)))))
           (build (l r)
             (declare ((integer 0 #.most-positive-fixnum) l r))
             (if (= l r)
                 nil
                 (let* ((mid (ash (+ l r) -1))
                        (node (%make-treap (aref sorted-vector mid)
                                           (random most-positive-fixnum)
                                           +op-identity+)))
                   (setf (%treap-left node) (build l mid))
                   (setf (%treap-right node) (build (+ mid 1) r))
                   (heapify node)
                   node))))
    (build 0 (length sorted-vector))))

(declaim (inline treap-update))
(defun treap-update (treap x &key left right (order #'<))
  "Updates TREAP[KEY] := (OP TREAP[KEY] X) for all KEY in [l, r). L and/or R can
be NIL, then it is regarded as the (negative or positive) infinity."
  (assert (not (and left right (funcall order right left))))
  (labels ((recur (treap l r)
             (when treap
               (if (and (null l) (null r))
                   (progn
                     (setf (%treap-lazy treap)
                           (updater-op (%treap-lazy treap) x))
                     (force-down treap))
                   (let ((key (%treap-key treap)))
                     (force-down treap)
                     (if (or (null l) (not (funcall order key l))) ; L <= KEY
                         (if (or (null r) (funcall order key r)) ; KEY < R
                             (progn
                               (recur (%treap-left treap) l nil)
                               (setf (%treap-value treap)
                                     (modifier-op (%treap-value treap) x))
                               (recur (%treap-right treap) nil r))
                             (recur (%treap-left treap) l r))
                         (recur (%treap-right treap) l r)))))))
    (recur treap left right)
    treap))

#|
;; Below is a simpler but somewhat slower variant.
(declaim (inline treap-update))
(defun treap-update (treap x left right &key (order #'<))
  "Updates TREAP[KEY] := (OP TREAP[KEY] X) for all KEY in [l, r)"
  (assert (not (funcall order right left)))
  (multiple-value-bind (treap-0-l treap-l-n)
      (treap-split treap left :order order)
    (multiple-value-bind (treap-l-r treap-r-n)
        (treap-split treap-l-n right :order order)
      (when treap-l-r
        (setf (%treap-lazy treap-l-r)
              (updater-op (%treap-lazy treap-l-r) x)))
      (treap-merge treap-0-l (treap-merge treap-l-r treap-r-n)))))
;|#

(declaim (inline treap-ref))
(defun treap-ref (treap key &key (order #'<))
  (declare ((or null treap) treap))
  (labels ((recur (treap)
             (when treap
               (force-down treap)
               (cond ((funcall order key (%treap-key treap))
                      (recur (%treap-left treap)))
                     ((funcall order (%treap-key treap) key)
                      (recur (%treap-right treap)))
                     (t (%treap-value treap))))))
    (recur treap)))

;;;
;;; Bisection search for key
;;;

;; NOTE: These functions intentionally don't return the assigned value. That is
;; for efficiency, because thereby they don't need to execute lazy propagation.

(defun treap-find (treap key &key (order #'<))
  "Finds the key that satisfies (AND (NOT (FUNCALL ORDER KEY (%TREAP-KEY
<sub-treap>))) (NOT (FUNCALL ORDER (%TREAP-KEY <sub-treap>) KEY))) and returns
KEY if it exists, otherwise returns NIL."
  (declare (optimize (speed 3))
           (function order)
           ((or null treap) treap))
  (cond ((null treap) nil)
        ((funcall order key (%treap-key treap))
         (treap-find (%treap-left treap) key :order order))
        ((funcall order (%treap-key treap) key)
         (treap-find (%treap-right treap) key :order order))
        (t key)))

(declaim (inline treap-bisect-left))
(defun treap-bisect-left (treap key &key (order #'<))
  "Returns the smallest key equal to or larger than KEY. Returns NIL if KEY is
larger than any keys in TREAP."
  (declare ((or null treap) treap)
           (function order))
  (labels ((recur (treap)
             (unless treap (return-from recur nil))
             (if (funcall order (%treap-key treap) key)
                 (recur (%treap-right treap))
                 (or (recur (%treap-left treap))
                     treap))))
    (treap-key (recur treap))))

(declaim (inline treap-bisect-left))
(defun treap-bisect-right (treap key &key (order #'<))
  "Returns the smallest key larger than KEY. Returns NIL if KEY is equal to or
larger than any keys in TREAP."
  (declare ((or null treap) treap)
           (function order))
  (labels ((recur (treap)
             (unless treap (return-from recur nil))
             (if (funcall order key (%treap-key treap))
                 (or (recur (%treap-left treap))
                     treap)
                 (recur (%treap-right treap)))))
    (treap-key (recur treap))))

(declaim (inline treap-bisect-left-1))
(defun treap-bisect-left-1 (treap key &key (order #'<))
  "Returns the largest key smaller than KEY. Returns NIL if KEY is equal to or
smaller than any keys in TREAP."
  (declare ((or null treap) treap)
           (function order))
  (labels ((recur (treap)
             (unless treap (return-from recur nil))
             (if (funcall order (%treap-key treap) key)
                 (or (recur (%treap-right treap))
                     treap)
                 (recur (%treap-left treap)))))
    (treap-key (recur treap))))

(declaim (inline treap-bisect-right-1))
(defun treap-bisect-right-1 (treap key &key (order #'<))
  "Returns the largest key equal to or smaller than KEY. Returns NIL if KEY is
smaller than any keys in TREAP."
  (declare ((or null treap) treap)
           (function order))
  (labels ((recur (treap)
             (unless treap (return-from recur nil))
             (if (funcall order key (%treap-key treap))
                 (recur (%treap-left treap))
                 (or (recur (%treap-right treap))
                     treap))))
    (treap-key (recur treap))))

(declaim (inline treap-unite))
(defun treap-unite (treap1 treap2 &key (order #'<))
  "Merges two treaps with keeping the order."
  (labels
      ((recur (l r)
         (cond ((null l) (when r (force-down r)) r)
               ((null r) (when l (force-down l)) l)
               (t (force-down l)
                  (when (< (%treap-priority l) (%treap-priority r))
                    (rotatef l r))
                  (multiple-value-bind (lchild rchild)
                      (treap-split r (%treap-key l) :order order)
                    (setf (%treap-left l) (recur (%treap-left l) lchild)
                          (%treap-right l) (recur (%treap-right l) rchild))
                    l)))))
    (recur treap1 treap2)))
(in-package :cl-user)

(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)))

(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)

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

(defconstant +mod+ 1000000007)

;;;
;;; Body
;;;

(defun main ()
  (declare #.OPT)
  (let* ((n (read))
         (q (read))
         (dp (make-array n :element-type t))
         (dset (make-disjoint-set n)))
    (dotimes (i n)
      (setf (aref dp i) (%make-treap i (random most-positive-fixnum) 0)))
    (write-string
     (with-output-to-string (*standard-output* nil :element-type 'base-char)
       (dotimes (_ q)
         (let ((type (read-fixnum))
               (a (read-fixnum))
               (b (read-fixnum)))
           (ecase type
             (1 (decf a) (decf b)
              (let ((root1 (ds-root dset a))
                    (root2 (ds-root dset b)))
                (unless (= root1 root2)
                  (ds-unite! dset a b)
                  (let ((root (ds-root dset a)))
                    (setf (aref dp root)
                          (treap-unite (aref dp root1) (aref dp root2)))))))
             (2 (decf a)
              (let ((root (ds-root dset a)))
                (setf (aref dp root)
                      (treap-update (aref dp root) b))))
             (3 (decf a)
              (let ((root (ds-root dset a)))
                (println (treap-ref (aref dp root) a)))))))))))

#-swank (main)

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

#+swank
(defun io-equal (in-string out-string &key (function #'main) (test #'equal))
  "Passes IN-STRING to *STANDARD-INPUT*, executes FUNCTION, and returns true if
the string output to *STANDARD-OUTPUT* is equal to OUT-STRING."
  (labels ((ensure-last-lf (s)
             (if (eql (uiop:last-char s) #\Linefeed)
                 s
                 (uiop:strcat s uiop:+lf+))))
    (funcall test
             (ensure-last-lf out-string)
             (with-output-to-string (out)
               (let ((*standard-output* out))
                 (with-input-from-string (*standard-input* (ensure-last-lf in-string))
                   (funcall function)))))))

#+swank
(defun get-clipbrd ()
  (with-output-to-string (out)
    (run-program "powershell.exe" '("-Command" "Get-Clipboard") :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* out))
    (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))))))

#+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
   (common-lisp-user::io-equal "3 9
2 1 10
3 1 0
1 1 2
2 2 20
1 1 3
2 2 40
3 1 0
3 2 0
3 3 0
"
    "10
70
60
40
"))
  (it.bese.fiveam:is
   (common-lisp-user::io-equal "8 28
2 3 17
2 7 25
1 3 8
2 5 11
1 1 7
2 7 35
3 7 0
3 8 0
1 4 2
2 2 42
2 3 34
3 8 0
3 4 0
3 2 0
1 5 1
1 1 6
1 6 5
2 6 53
1 6 7
1 6 2
2 4 11
3 1 0
1 4 6
3 7 0
1 3 7
2 1 50
3 8 0
3 3 0
"
    "60
0
34
42
42
99
124
84
101
"))
  (it.bese.fiveam:is
   (common-lisp-user::io-equal "1 3
3 1 0
2 1 10
3 1 0
"
    "0
10
")))
0