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

(macrolet ((def-int (b)
             `(progn (deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))
                     (deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))))
           (defs (&rest bits) `(progn ,@(mapcar (lambda (b) `(def-int ,b)) bits))))
  (defs 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
(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"
  (declare #.cl-user::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))))))))

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

;;;
;;; Disjoint set by Union-Find algorithm over arbitrary monoid
;;;

;; not tested

(defpackage :cp/abstract-disjoint-set
  (:use :cl)
  (:export #:define-disjoint-set))
(in-package :cp/abstract-disjoint-set)

(defmacro define-disjoint-set (name &key (operation '#'+) (element-type 'fixnum) (union-by-size t) conc-name)
  (check-type name symbol)
  (let* ((conc-string (if conc-name
                          (symbol-name conc-name)
                          (format nil "~A-" (symbol-name name))))
         (constructor (intern (format nil "MAKE-~A" (symbol-name name))))
         (rooter (intern (format nil "~AROOT" conc-string)))
         (reffer (intern (format nil "~AREF" conc-string)))
         (uniter (intern (format nil "~AUNITE!" conc-string)))
         (connectivity-checker (intern (format nil "~ACONNECTED-P" conc-string)))
         (size-getter (intern (format nil "~ASIZE" conc-string)))
         (data-accessor (intern (format nil "~ADATA" conc-string)))
         (values-accessor (intern (format nil "~AVALUES" conc-string))))
    `(progn
       (defstruct (,name
                   (:constructor ,constructor
                       (size
                        &optional
                        (contents (make-array size :element-type ',element-type))
                        &aux
                        (values
                         (prog1 contents
                           (assert (= (length contents) size))))
                        (data (make-array size :element-type 'fixnum :initial-element -1))))
                   ,@(when conc-name `((:conc-name ,(intern conc-string)))))
         (data nil :type (simple-array fixnum (*)))
         (values nil :type (simple-array ,element-type (*))))
       
       (declaim (inline ,rooter)
                (ftype (function * (values (mod #.array-total-size-limit) &optional))
                       ,rooter))
       (defun ,rooter (,name x)
         "Returns the root of X."
         (declare ((mod #.array-total-size-limit) x))
         (let ((data (,data-accessor ,name)))
           (labels ((recur (x)
                      (if (< (aref data x) 0)
                          x
                          (setf (aref data x) (recur (aref data x))))))
             (recur x))))
       
       (declaim (inline ,reffer))
       (defun ,reffer (,name x)
         (aref (,values-accessor ,name)
               (,rooter ,name x)))
       
       (declaim (inline (setf ,reffer)))
       (defun (setf ,reffer) (new-value ,name x)
         (setf (aref (,values-accessor ,name)
                     (,rooter ,name x))
               new-value))
       
       (declaim (inline ,uniter))
       (defun ,uniter (,name x1 x2)
         "Destructively unites X1 and X2 and returns true iff X1 and X2 become
connected for the first time. (If UNION-BY-SIZE is disabled, X1 becomes root.)"
         (let ((root1 (,rooter ,name x1))
               (root2 (,rooter ,name x2)))
           (unless (= root1 root2)
             (let ((data (,data-accessor ,name))
                   (values (,values-accessor ,name)))
               ;; ensure the size of root1 >= the size of root2
               ,@(when union-by-size
                   '((when (> (aref data root1) (aref data root2))
                       (rotatef root1 root2))))
               (incf (aref data root1) (aref data root2))
               (setf (aref values root1)
                     (funcall ,operation (aref values root2) (aref values root1)))
               (setf (aref data root2) root1)))))

       (declaim (inline ,connectivity-checker))
       (defun ,connectivity-checker (,name x1 x2)
         "Returns true iff X1 and X2 have the same root."
         (= (,rooter ,name x1) (,rooter ,name x2)))

       (declaim (inline ,size-getter))
       (defun ,size-getter (,name x)
         "Returns the size of the connected component to which X belongs."
         (- (aref (,data-accessor ,name)
                  (,rooter ,name x)))))))

#+(or)
(define-disjoint-set disjoint-set
  :operation #'max
  :element-type fixnum
  :conc-name ds-
  :union-by-size nil)

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

;;;
;;; Body
;;;

(define-disjoint-set disjoint-set
  :operation #'+
  :element-type uint62
  :conc-name ds-)

(defun main ()
  (declare #.cl-user::opt)
  (let* ((n (read))
         (m (read))
         (xs (make-array n :element-type 'uint62 :initial-element 0))
         (as (make-array m :element-type 'uint31 :initial-element 0))
         (bs (make-array m :element-type 'uint31 :initial-element 0))
         (ys (make-array m :element-type 'uint31 :initial-element 0))
         (graph (make-array n :element-type 'list :initial-element nil)))
    (dotimes (i n)
      (setf (aref xs i) (read-fixnum)))
    (dotimes (i m)
      (let ((a (- (read-fixnum) 1))
            (b (- (read-fixnum) 1))
            (y (read-fixnum)))
        (when (> a b) (rotatef a b))
        (setf (aref as i) a
              (aref bs i) b
              (aref ys i) y)))
    (parallel-sort! ys #'< as bs)
    (dotimes (i m)
      (push i (aref graph (aref as i)))
      (push i (aref graph (aref bs i))))
    (let ((dset (make-disjoint-set n xs))
          (flags (make-array m :element-type 'bit :initial-element 0))
          (res (make-array m :element-type 'bit :initial-element 0)))
      (dotimes (i m)
        (let* ((a (aref as i))
               (b (aref bs i))
               (y (aref ys i)))
          (ds-unite! dset a b)
          (when (<= y (ds-ref dset a))
            (setf (aref flags i) 1))))
      (loop for i from (- m 1) downto 0
            for a = (aref as i)
            for max-y = (aref ys i)
            when (and (= 1 (aref flags i)) (= 0 (aref res i)))
            do (sb-int:named-let dfs ((v a))
                 (dolist (eidx (aref graph v))
                   (let* ((a (aref as eidx))
                          (b (aref bs eidx))
                          (y (aref ys eidx))
                          (next-v (if (= a v) b a)))
                     (when (and (= 0 (aref res eidx))
                                (<= y max-y))
                       (setf (aref res eidx) 1)
                       (dfs next-v))))))
      (println (- m (count 1 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)))

#-swank
(eval-when (:compile-toplevel)
  (when (and (boundp 'sb-c::*compiler-warning-count*)
             (> sb-c::*compiler-warning-count* 0))
    (sb-ext:quit :unix-status 1)))

;; To run: (5am:run! :sample)
#+swank
(it.bese.fiveam:test :sample
  (it.bese.fiveam:is
   (equal "2
"
          (run "4 4
2 3 5 7
1 2 7
1 3 9
2 3 12
3 4 18
" nil)))
  (it.bese.fiveam:is
   (equal "4
"
          (run "6 10
4 4 1 1 1 7
3 5 19
2 5 20
4 5 8
1 6 16
2 3 9
3 6 16
3 4 1
2 6 20
2 4 19
1 2 9
" nil)))
  (it.bese.fiveam:is
   (equal "8
"
          (run "10 9
81 16 73 7 2 61 86 38 90 28
6 8 725
3 10 12
1 4 558
4 9 615
5 6 942
8 9 918
2 7 720
4 7 292
7 10 414
" nil))))


Measured memory_bytes: 46860