結果

問題 No.1364 [Renaming] Road to Cherry from Zelkova
ユーザー sansaquasansaqua
提出日時 2021-01-22 22:13:52
言語 Common Lisp
(sbcl 2.3.8)
結果
AC  
実行時間 220 ms / 2,500 ms
コード長 27,262 bytes
コンパイル時間 1,124 ms
コンパイル使用メモリ 89,068 KB
実行使用メモリ 62,652 KB
最終ジャッジ日時 2023-08-28 11:02:26
合計ジャッジ時間 8,325 ms
ジャッジサーバーID
(参考情報)
judge12 / judge14
外部呼び出し有り
このコードへのチャレンジ(β)

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 20 ms
27,896 KB
testcase_01 AC 18 ms
25,408 KB
testcase_02 AC 20 ms
27,876 KB
testcase_03 AC 19 ms
27,904 KB
testcase_04 AC 20 ms
29,144 KB
testcase_05 AC 21 ms
27,884 KB
testcase_06 AC 20 ms
29,496 KB
testcase_07 AC 19 ms
31,560 KB
testcase_08 AC 24 ms
31,448 KB
testcase_09 AC 27 ms
27,844 KB
testcase_10 AC 22 ms
27,836 KB
testcase_11 AC 23 ms
31,344 KB
testcase_12 AC 27 ms
31,664 KB
testcase_13 AC 105 ms
38,160 KB
testcase_14 AC 161 ms
41,900 KB
testcase_15 AC 134 ms
43,972 KB
testcase_16 AC 101 ms
36,068 KB
testcase_17 AC 60 ms
37,852 KB
testcase_18 AC 182 ms
42,260 KB
testcase_19 AC 184 ms
45,896 KB
testcase_20 AC 185 ms
42,220 KB
testcase_21 AC 186 ms
44,280 KB
testcase_22 AC 193 ms
42,260 KB
testcase_23 AC 52 ms
30,080 KB
testcase_24 AC 53 ms
29,884 KB
testcase_25 AC 113 ms
38,576 KB
testcase_26 AC 167 ms
48,316 KB
testcase_27 AC 126 ms
40,012 KB
testcase_28 AC 86 ms
36,880 KB
testcase_29 AC 121 ms
37,000 KB
testcase_30 AC 84 ms
37,828 KB
testcase_31 AC 67 ms
34,024 KB
testcase_32 AC 101 ms
34,024 KB
testcase_33 AC 154 ms
45,904 KB
testcase_34 AC 152 ms
46,340 KB
testcase_35 AC 151 ms
46,200 KB
testcase_36 AC 142 ms
45,012 KB
testcase_37 AC 107 ms
34,132 KB
testcase_38 AC 200 ms
36,112 KB
testcase_39 AC 220 ms
36,096 KB
testcase_40 AC 195 ms
36,104 KB
testcase_41 AC 202 ms
39,896 KB
testcase_42 AC 180 ms
39,720 KB
testcase_43 AC 89 ms
62,652 KB
testcase_44 AC 51 ms
38,164 KB
testcase_45 AC 67 ms
60,676 KB
testcase_46 AC 24 ms
31,968 KB
testcase_47 AC 18 ms
27,892 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 28 AUG 2023 11:02:15 AM):
; processing (UNLESS (MEMBER :CHILD-SBCL ...) ...)
; processing (IN-PACKAGE :CL-USER)
; processing (DEFPARAMETER *OPT* ...)
; processing (SET-DISPATCH-MACRO-CHARACTER #\# ...)
; processing (SETQ *RANDOM-STATE* ...)
; processing (DEFINE-INT-TYPES 2 ...)
; processing (DEFCONSTANT +MOD+ ...)
; processing (DEFMACRO DBG ...)
; processing (DECLAIM (INLINE PRINTLN))
; processing (DEFUN PRINTLN ...)
; processing (DEFPACKAGE :CP/SCC ...)
; processing (IN-PACKAGE :CP/SCC)
; processing (DEFSTRUCT (SCC # ...) ...)
; processing (DEFUN MAKE-SCC ...)
; file: /home/judge/data/code/Main.lisp
; in: DEFUN MAKE-SCC
;     (AREF CP/SCC::GRAPH CP/SCC::V)
; 
; note: unable to
;   optimize
; because:
;   Upgraded element type of array is not known at compile time.

; processing (DECLAIM (FTYPE # ...))
; processing (DEFUN MAKE-CONDENSED-GRAPH ...)
; file: /home/judge/data/code/Main.lisp
; in: DEFUN MAKE-CONDENSED-GRAPH
;     (AREF CP/SCC::GRAPH CP/SCC::I)
; 
; note: unable to
;   optimize
; because:
;   Upgraded element type of array is not known at compile time.

; processing (DEFPACKAGE :CP/WITH-CACHE ...)
; processing (IN-PACKAGE :CP/WITH-CACHE)
; processing (DECLAIM (TYPE # ...))
; processing (DEFPARAMETER *RECURSION-DEPTH* ...)
; processing (DEFUN %ENCLOSE-WITH-TRACE ...)
; processing (DEFUN %EXTRACT-DECLARATIONS ...)
; processing (DEFUN %PARSE-CACHE-FORM ...)
; processing (DEFMACRO WITH-CACHE ...)
; processing (DEFMACRO WITH-CACHES ...)
; 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 (USE-PACKAGE :CP/READ-FIXNUM ...)
; processing (USE-PACKAGE :CP/MOD-OPERATIONS ...)
; processing (USE-PACKAGE :CP/WITH-CACHE ...)
; processing (USE-PACKAG

ソースコード

diff #

#-swank
(unless (member :child-sbcl *features*)
  (quit
   :unix-status
   (process-exit-code
    (run-program *runtime-pathname*
                 `("--control-stack-size" "256MB"
                   "--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)
  (defparameter *opt*
    #+swank '(optimize (speed 3) (safety 2))
    #-swank '(optimize (speed 3) (safety 0) (debug 0)))
  #+swank (ql:quickload '(:cl-debug-print :fiveam :cp/util) :silent t)
  #+swank (use-package :cp/util :cl-user)
  #-swank (set-dispatch-macro-character
           #\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t))))
  #+sbcl (setq *random-state* (seed-random-state (nth-value 1 (get-time-of-day)))))
#-swank (eval-when (:compile-toplevel)
          (setq *break-on-signals* '(and warning (not style-warning))))
#+swank (set-dispatch-macro-character #\# #\> #'cl-debug-print:debug-print-reader)

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

(defconstant +mod+ 1000000007)

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

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

;; BEGIN_INSERTED_CONTENTS
;;;
;;; Strongly connected components of directed graph
;;;

(defpackage :cp/scc
  (:use :cl)
  (:export #:scc #:scc-graph #:scc-components #:scc-sizes #:scc-count
           #:scc-p #:make-scc #:make-condensed-graph))
(in-package :cp/scc)

(defstruct (scc (:constructor %make-scc (graph components sizes count))
                (:copier nil)
                (:predicate nil))
  (graph nil :type vector)
  ;; components[i] := strongly connected component of the i-th vertex
  (components nil :type (simple-array (integer 0 #.most-positive-fixnum) (*)))
  ;; sizes[k] := size of the k-th strongly connected component
  (sizes nil :type (simple-array (integer 0 #.most-positive-fixnum) (*)))
  ;; the total number of strongly connected components
  (count 0 :type (integer 0 #.most-positive-fixnum)))

;; Tarjan's algorithm
;; Reference: http://www.prefield.com/algorithm/graph/strongly_connected_components.html
;; (Kosaraju's algorithm is put in the test file)
(defun make-scc (graph &key (key #'identity))
  (declare (optimize (speed 3))
           (vector graph)
           (function key))
  (let* ((n (length graph))
         (ord 0)
         (ords (make-array n :element-type 'fixnum :initial-element -1)) ; pre-order
         ;; store the lowest pre-order number as the representative element of a
         ;; strongly connected component
         (lowlinks (make-array n :element-type 'fixnum))
         (components (make-array n :element-type '(integer 0 #.most-positive-fixnum)))
         (comp-index 0) ; index number of component
         (sizes (make-array n :element-type '(integer 0 #.most-positive-fixnum)
                              :initial-element 0))
         (stack (make-array n :element-type '(integer 0 #.most-positive-fixnum)))
         (end 0) ; stack pointer
         (in-stack (make-array n :element-type 'bit :initial-element 0)))
    (declare ((integer 0 #.most-positive-fixnum) ord end comp-index))
    (labels ((%push (v)
               (setf (aref stack end) v
                     (aref in-stack v) 1)
               (incf end))
             (%pop ()
               (decf end)
               (let ((v (aref stack end)))
                 (setf (aref in-stack v) 0)
                 v))
             (visit (v)
               (setf (aref ords v) ord
                     (aref lowlinks v) ord)
               (incf ord)
               (%push v)
               (dolist (next (aref graph v))
                 (let ((next (funcall key next)))
                   (cond ((= -1 (aref ords next))
                          (visit next)
                          (setf (aref lowlinks v)
                                (min (aref lowlinks v) (aref lowlinks next))))
                         ((= 1 (aref in-stack next))
                          (setf (aref lowlinks v)
                                (min (aref lowlinks v) (aref ords next)))))))
               (when (= (aref lowlinks v) (aref ords v))
                 (loop for size of-type (integer 0 #.most-positive-fixnum) from 1
                       for w = (%pop)
                       do (setf (aref components w) comp-index)
                       until (= v w)
                       finally (setf (aref sizes comp-index) size)
                               (incf comp-index)))))
      (dotimes (v n)
        (when (= -1 (aref ords v))
          (visit v)))
      ;; Reverse the order of strongly connected components, because now
      ;; everything is in the reversed topological order
      (dotimes (v n)
        (setf (aref components v)
              (- comp-index (aref components v) 1)))
      (dotimes (i (ash comp-index -1))
        (rotatef (aref sizes i) (aref sizes (- comp-index i 1))))
      (%make-scc graph components (adjust-array sizes comp-index) comp-index))))

;; FIXME: Constant factor of this implementation is too large. Can we avoid
;; hash-table?
(declaim (ftype (function * (values (simple-array t (*)) &optional))
                make-condensed-graph))
(defun make-condensed-graph (scc)
  "Does graph condensation. This function is non-destructive."
  (declare (optimize (speed 3)))
  (let* ((graph (scc-graph scc))
         (n (length graph))
         (comp-n (scc-count scc))
         (components (scc-components scc))
         (condensed (make-array comp-n :element-type t)))
    (dotimes (i comp-n)
      ;; Resorting to EQ is substandard, though I use it here for efficiency.
      (setf (aref condensed i) (make-hash-table :test #'eq)))
    (dotimes (i n)
      (let ((i-comp (aref components i)))
        (dolist (neighbor (aref graph i))
          (let ((neighbor-comp (aref components neighbor)))
            (unless (= i-comp neighbor-comp)
              (setf (gethash neighbor-comp (aref condensed i-comp)) t))))))
    (dotimes (i comp-n)
      (setf (aref condensed i)
            (loop for x being each hash-key of (aref condensed i)
                  collect x)))
    condensed))

;;;
;;; Memoization macro
;;;

(defpackage :cp/with-cache
  (:use :cl)
  (:export #:with-cache #:with-caches))
(in-package :cp/with-cache)

;; FIXME: *RECURSION-DEPTH* should be included within the macro.
(declaim (type (integer 0 #.most-positive-fixnum) *recursion-depth*))
(defparameter *recursion-depth* 0)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun %enclose-with-trace (fname args form)
    (let ((value (gensym)))
      `(progn
         (format t "~&~A~A: (~A ~{~A~^ ~}) =>"
                 (make-string *recursion-depth*
                              :element-type 'base-char
                              :initial-element #\ )
                 *recursion-depth*
                 ',fname
                 (list ,@args))
         (let ((,value (let ((*recursion-depth* (1+ *recursion-depth*)))
                         ,form)))
           (format t "~&~A~A: (~A ~{~A~^ ~}) => ~A"
                   (make-string *recursion-depth*
                                :element-type 'base-char
                                :initial-element #\ )
                   *recursion-depth*
                   ',fname
                   (list ,@args)
                   ,value)
           ,value))))

  (defun %extract-declarations (body)
    (remove-if-not (lambda (form) (and (consp form) (eql 'declare (car form))))
                   body))

  (defun %parse-cache-form (cache-specifier)
    (let ((cache-type (car cache-specifier))
          (cache-attribs (cdr cache-specifier)))
      (assert (member cache-type '(:hash-table :array)))
      (let* ((dims-with-* (when (eql cache-type :array) (first cache-attribs)))
             (dims (remove '* dims-with-*))
             (rank (length dims))
             (rest-attribs (ecase cache-type
                             (:hash-table cache-attribs)
                             (:array (cdr cache-attribs))))
             (key (prog1 (getf rest-attribs :key) (remf rest-attribs :key)))
             (trace-p (prog1 (getf rest-attribs :trace) (remf rest-attribs :trace)))
             (cache-form (case cache-type
                           (:hash-table `(make-hash-table ,@rest-attribs))
                           (:array `(make-array (list ,@dims) ,@rest-attribs))))
             (initial-element (when (eql cache-type :array)
                                (assert (member :initial-element rest-attribs))
                                (getf rest-attribs :initial-element))))
        (let ((cache (gensym "CACHE"))
              (value (gensym))
              (present-p (gensym))
              (args-lst (gensym))
              (indices (loop repeat rank collect (gensym))))
          (labels
              ((make-cache-querier (cache-type name args)
                 (let ((res (case cache-type
                              (:hash-table
                               `(let ((,args-lst (funcall ,(or key '#'list) ,@args)))
                                  (multiple-value-bind (,value ,present-p)
                                      (gethash ,args-lst ,cache)
                                    (if ,present-p
                                        ,value
                                        (setf (gethash ,args-lst ,cache)
                                              (,name ,@args))))))
                              (:array
                               (assert (= (length args) (length dims-with-*)))
                               (let ((memoized-args (loop for dimension in dims-with-*
                                                          for arg in args
                                                          unless (eql dimension '*)
                                                          collect arg)))
                                 (if key
                                     `(multiple-value-bind ,indices
                                          (funcall ,key ,@memoized-args)
                                        (let ((,value (aref ,cache ,@indices)))
                                          (if (eql ,initial-element ,value)
                                              (setf (aref ,cache ,@indices)
                                                    (,name ,@args))
                                              ,value)))
                                     `(let ((,value (aref ,cache ,@memoized-args)))
                                        (if (eql ,initial-element ,value)
                                            (setf (aref ,cache ,@memoized-args)
                                                  (,name ,@args))
                                            ,value))))))))
                   (if trace-p
                       (%enclose-with-trace name args res)
                       res)))
               (make-reset-form (cache-type)
                 (case cache-type
                   (:hash-table `(setf ,cache (make-hash-table ,@rest-attribs)))
                   (:array `(prog1 nil
                              ;; TODO: portable fill
                              (fill (sb-ext:array-storage-vector ,cache) ,initial-element)))))
               (make-reset-name (name)
                 (intern (format nil "RESET-~A" (symbol-name name)))))
            (values cache cache-form cache-type
                    #'make-reset-name
                    #'make-reset-form
                    #'make-cache-querier)))))))

(defmacro with-cache ((cache-type &rest cache-attribs) def-form)
  "CACHE-TYPE := :HASH-TABLE | :ARRAY.
DEF-FORM := definition form with DEFUN, LABELS, FLET, or SB-INT:NAMED-LET.

Basic usage:

\(with-cache (:hash-table :test #'equal :key #'cons)
  (defun add (a b)
    (+ a b)))

This function caches the returned values for already passed combinations of
arguments. In this case ADD stores the key (CONS A B) and the returned value to
a hash-table when (ADD A B) is evaluated for the first time. When it is called
with the same arguments (w.r.t. EQUAL) again, ADD will return the stored value
instead of recomputing it.

The storage for cache can be hash-table or array. Let's see an example for
array:

\(with-cache (:array (10 20 30) :initial-element -1 :element-type 'fixnum)
  (defun foo (a b c) ... ))

This form stores the value returned by FOO in an array, which was created
by (make-array (list 10 20 30) :initial-element -1 :element-type 'fixnum). Note
that INITIAL-ELEMENT must always be given here as it is used as the flag
expressing `not yet stored'. (Therefore INITIAL-ELEMENT should be a value FOO
never takes.)

If you want to ignore some arguments, you can put `*' in dimensions:

\(with-cache (:array (10 10 * 10) :initial-element -1)
  (defun foo (a b c d) ...)) ; then C is ignored when querying or storing cache

Available definition forms in WITH-CACHE are DEFUN, LABELS, FLET, and
SB-INT:NAMED-LET.

You can trace a memoized function by :TRACE option:

\(with-cache (:array (10 10) :initial-element -1 :trace t)
  (defun foo (x y) ...))

Then FOO is traced as with CL:TRACE.
"
  (multiple-value-bind (cache-symbol cache-form cache-type
                        make-reset-name make-reset-form
                        make-cache-querier)
      (%parse-cache-form (cons cache-type cache-attribs))
    (ecase (car def-form)
      ((defun)
       (destructuring-bind (_ name args &body body) def-form
         (declare (ignore _))
         `(let ((,cache-symbol ,cache-form))
            (defun ,(funcall make-reset-name name) ()
              ,(funcall make-reset-form cache-type))
            (defun ,name ,args
              ,@(%extract-declarations body)
              (flet ((,name ,args ,@body))
                (declare (inline ,name))
                ,(funcall make-cache-querier cache-type name args))))))
      ((labels flet)
       (destructuring-bind (_ definitions &body labels-body) def-form
         (declare (ignore _))
         (destructuring-bind (name args &body body) (car definitions)
           `(let ((,cache-symbol ,cache-form))
              (,(car def-form)
               ((,(funcall make-reset-name name) ()
                 ,(funcall make-reset-form cache-type))
                (,name ,args
                       ,@(%extract-declarations body)
                       (flet ((,name ,args ,@body))
                         (declare (inline ,name))
                         ,(funcall make-cache-querier cache-type name args)))
                ,@(cdr definitions))
               (declare (ignorable #',(funcall make-reset-name name)))
               ,@labels-body)))))
      ((nlet #+sbcl sb-int:named-let)
       (destructuring-bind (_ name bindings &body body) def-form
         (declare (ignore _))
         `(let ((,cache-symbol ,cache-form))
            (,(car def-form) ,name ,bindings
             ,@(%extract-declarations body)
             ,(let ((args (mapcar (lambda (x) (if (atom x) x (car x))) bindings)))
                `(flet ((,name ,args ,@body))
                   (declare (inline ,name))
                   ,(funcall make-cache-querier cache-type name args))))))))))

(defmacro with-caches (cache-specs def-form)
  "DEF-FORM := definition form by LABELS or FLET.

\(with-caches (cache-spec1 cache-spec2)
  (labels ((f (x) ...) (g (y) ...))))
is equivalent to the line up of
\(with-cache cache-spec1 (labels ((f (x) ...))))
and
\(with-cache cache-spec2 (labels ((g (y) ...))))

This macro will be useful to do mutual recursion between memoized local
functions."
  (assert (member (car def-form) '(labels flet)))
  (let (cache-symbol-list cache-form-list cache-type-list make-reset-name-list make-reset-form-list make-cache-querier-list)
    (dolist (cache-spec (reverse cache-specs))
      (multiple-value-bind (cache-symbol cache-form cache-type
                            make-reset-name make-reset-form make-cache-querier)
          (%parse-cache-form cache-spec)
        (push cache-symbol cache-symbol-list)
        (push cache-form cache-form-list)
        (push cache-type cache-type-list)
        (push make-reset-name make-reset-name-list)
        (push make-reset-form make-reset-form-list)
        (push make-cache-querier make-cache-querier-list)))
    (labels ((def-name (def) (first def))
             (def-args (def) (second def))
             (def-body (def) (cddr def)))
      (destructuring-bind (_ definitions &body labels-body) def-form
        (declare (ignore _))
        `(let ,(loop for cache-symbol in cache-symbol-list
                     for cache-form in cache-form-list
                     collect `(,cache-symbol ,cache-form))
           (,(car def-form)
            (,@(loop for def in definitions
                     for cache-type in cache-type-list
                     for make-reset-name in make-reset-name-list
                     for make-reset-form in make-reset-form-list
                     collect `(,(funcall make-reset-name (def-name def)) ()
                               ,(funcall make-reset-form cache-type)))
             ,@(loop for def in definitions
                     for cache-type in cache-type-list
                     for make-cache-querier in make-cache-querier-list
                     collect `(,(def-name def) ,(def-args def)
                               ,@(%extract-declarations (def-body def))
                               (flet ((,(def-name def) ,(def-args def) ,@(def-body def)))
                                 (declare (inline ,(def-name def)))
                                 ,(funcall make-cache-querier cache-type (def-name def) (def-args def))))))
            (declare (ignorable ,@(loop for def in definitions
                                        for make-reset-name in make-reset-name-list
                                        collect `#',(funcall make-reset-name
                                                             (def-name def)))))
            ,@labels-body))))))

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

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

(defmacro define-mod-operations
    (divisor &optional (package #+sbcl (sb-int:sane-package) #-sbcl *package*))
  (let ((mod* (intern "MOD*" package))
        (mod+ (intern "MOD+" package))
        (mod- (intern "MOD-" package))
        (incfmod (intern "INCFMOD" package))
        (decfmod (intern "DECFMOD" package))
        (mulfmod (intern "MULFMOD" package)))
    `(progn
       (defun ,mod* (&rest args)
         (cond ((cdr args) (reduce (lambda (x y) (mod (* x y) ,divisor)) args))
               (args (mod (car args) ,divisor))
               (t 1)))
       (defun ,mod+ (&rest args)
         (cond ((cdr args) (reduce (lambda (x y) (mod (+ x y) ,divisor)) args))
               (args (mod (car args) ,divisor))
               (t 0)))
       (defun ,mod- (&rest args)
         (if (cdr args)
             (reduce (lambda (x y) (mod (- x y) ,divisor)) args)
             (mod (- (car args)) ,divisor)))

       #+sbcl
       (eval-when (:compile-toplevel :load-toplevel :execute)
         (locally (declare (sb-ext:muffle-conditions warning))
           (sb-c:define-source-transform ,mod* (&rest args)
             (case (length args)
               (0 1)
               (1 `(mod ,(car args) ,',divisor))
               (otherwise (reduce (lambda (x y) `(mod (* ,x ,y) ,',divisor)) args))))
           (sb-c:define-source-transform ,mod+ (&rest args)
             (case (length args)
               (0 0)
               (1 `(mod ,(car args) ,',divisor))
               (otherwise (reduce (lambda (x y) `(mod (+ ,x ,y) ,',divisor)) args))))
           (sb-c:define-source-transform ,mod- (&rest args)
             (case (length args)
               (0 (values nil t))
               (1 `(mod (- ,(car args)) ,',divisor))
               (otherwise (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))))))))

;; BEGIN_USE_PACKAGE
(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/with-cache :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/scc :cl-user))
(in-package :cl-user)

;;;
;;; Body
;;;

(define-mod-operations +mod+)
(defun main ()
  (let* ((n (read))
         (m (read))
         (graph (make-array (+ n 1) :element-type 'list :initial-element nil))
         (revgraph (make-array (+ n 1) :element-type 'list :initial-element nil))
         (us (make-array m :element-type 'uint31 :initial-element 0))
         (vs (make-array m :element-type 'uint31 :initial-element 0))
         (ls (make-array m :element-type 'uint31 :initial-element 0))
         (as (make-array m :element-type 'uint31 :initial-element 0)))
    (dotimes (i m)
      (setf (aref us i) (read-fixnum)
            (aref vs i) (read-fixnum)
            (aref ls i) (read-fixnum)
            (aref as i) (read-fixnum))
      (push i (aref graph (aref us i)))
      (push i (aref revgraph (aref vs i))))
    (labels ((make-reach-p (graph tos start)
               (let ((marked (make-array (+ n 1) :element-type 'bit :initial-element 0)))
                 (sb-int:named-let dfs ((v start))
                   (setf (aref marked v) 1)
                   (dolist (ei (aref graph v))
                     (let ((next (aref tos ei)))
                       (when (zerop (aref marked next))
                         (dfs next)))))
                 marked)))
      (let* ((reach0-p (make-reach-p graph vs 0))
             (reachn-p (make-reach-p revgraph us n))
             (scc (make-scc graph :key (lambda (ei) (aref vs ei))))
             (comps (scc-components scc))
             (sizes (scc-sizes scc)))
        #>graph
        #>scc
        (dotimes (i (+ n 1))
          (when (and (= 1 (aref reach0-p i))
                     (= 1 (aref reachn-p i))
                     (> (aref sizes (aref comps i)) 1))
            (write-line "INF")
            (return-from main)))
        #>graph
        (with-caches ((:array (100001) :element-type 'uint31 :initial-element #x7fffffff)
                      (:array (100001) :element-type 'uint31 :initial-element #x7fffffff))
          (labels ((calc-in (v)
                     (if (= 0 v)
                         1
                         (let ((res 0))
                           (declare (uint31 res))
                           (dolist (ei (aref revgraph v))
                             (let ((prev (aref us ei))
                                   (a (aref as ei)))
                               (when (= 1 (aref reach0-p prev))
                                 (incfmod res (mod* a (calc-in prev))))))
                           res)))
                   (calc-out (v)
                     (if (= n v)
                         1
                         (let ((res 0))
                           (declare (uint31 res))
                           (dolist (ei (aref graph v))
                             (let ((next (aref vs ei))
                                   (a (aref as ei)))
                               (when (= 1 (aref reachn-p next))
                                 (incfmod res (mod* a (calc-out next))))))
                           res))))
            (let ((res 0))
              (dotimes (ei m)
                (let ((u (aref us ei))
                      (v (aref vs ei))
                      (l (aref ls ei))
                      (a (aref as ei)))
                  (when (and (= 1 (aref reach0-p u) (aref reachn-p v)))
                    (incfmod res (mod* l a (calc-in u) (calc-out v))))))
              (println res))))))))

#-swank (main)

;;;
;;; Test
;;;

#+swank
(progn
  (defparameter *lisp-file-pathname* (uiop:current-lisp-file-pathname))
  (setq *default-pathname-defaults* (uiop:pathname-directory-pathname *lisp-file-pathname*))
  (uiop:chdir *default-pathname-defaults*)
  (defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *lisp-file-pathname*))
  (defparameter *problem-url* "https://yukicoder.me/problems/no/1364"))

#+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)))

#+(and sbcl (not swank))
(eval-when (:compile-toplevel)
  (when sb-c::*undefined-warnings*
    (error "undefined warnings: ~{~A~^ ~}" sb-c::*undefined-warnings*)))

;; To run: (5am:run! :sample)
#+swank
(5am:test :sample
  (5am:is
   (equal "10
"
          (run "3 4
0 1 2 1
1 2 1 1
2 3 3 1
0 3 4 1
" nil)))
  (5am:is
   (equal "INF
"
          (run "3 4
0 1 1 1
1 2 1 1
2 1 1 1
2 3 1 1
" nil)))
  (5am:is
   (equal "18
"
          (run "1 2
0 1 3 2
0 1 4 3
" nil))))
0