(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
;;;
;;; Disjoint set by Union-Find algorithm over arbitrary monoid
;;;

;; not tested

(defmacro define-disjoint-set (name &key (operation '#'+) (element-type 'fixnum) 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 (ftype (function * (values (mod #.array-total-size-limit) &optional))
                       ,rooter))
       (defun ,rooter (,name x)
         "Returns the root of X."
         (declare (optimize (speed 3))
                  ((mod #.array-total-size-limit) x))
         (let ((data (,data-accessor ,name)))
           (if (< (aref data x) 0)
               x
               (setf (aref data x) (,rooter ,name (aref data 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."
         (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 (> (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)))))))


(define-disjoint-set disjoint-set
  :operation #'max
  :element-type fixnum
  :conc-name ds-)

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

(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 ()
  (let* ((n (read))
         (m (read))
         (hs (make-array n :element-type 'fixnum :initial-element 0))
         (res (make-array n :element-type 'bit :initial-element 1)))
    (dotimes (i n)
      (setf (aref hs i) (read-fixnum)))
    (dotimes (i m)
      (let* ((a (- (read-fixnum) 1))
             (b (- (read-fixnum) 1))
             (h1 (aref hs a))
             (h2 (aref hs b)))
        (cond ((> h1 h2)
               (setf (aref res b) 0))
              ((< h1 h2)
               (setf (aref res a) 0))
              (t (setf (aref res a) 0
                       (aref res b) 0)))))
    (println (count 1 res))))

#-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 "4 3
1 2 3 4
1 3
2 3
2 4
"
    "2
"))
  (it.bese.fiveam:is
   (common-lisp-user::io-equal "6 5
8 6 9 1 2 1
1 3
4 2
4 3
4 6
4 6
"
    "3
")))


Measured memory_bytes: 26312