(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 (set-dispatch-macro-character #\# #\> #'cl-debug-print:debug-print-reader)

(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
;;;
;;; Strongly connected components of directed graph, 2-SAT
;;;

(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))
  (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)
  (declare (optimize (speed 3))
           (vector graph))
  (let* ((n (length graph))
         (ord 0)
         (ords (make-array n :element-type 'fixnum :initial-element -1)) ; in-order
         ;; store the lowest in-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))
                 (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 sizes 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)
      (setf (aref condensed i) (make-hash-table :test #'eql)))
    (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))

;;;
;;; 2-SAT
;;;

;; NOTE: use LOGNOT for negation

(defpackage :cp/2sat
  (:use :cl :cp/scc)
  (:export #:2sat #:make-2sat #:2sat-p
           #:add-implication #:add-disjunction #:2sat-solve))
(in-package :cp/2sat)

(defstruct (2sat (:constructor make-2sat
                     (size
                      &aux
                      (graph (make-array (* 2 size) :element-type 'list :initial-element nil))))
                 (:copier nil))
  (size 0 :type (integer 0 #.most-positive-fixnum))
  (graph nil :type (simple-array list (*)))
  (scc nil :type (or null scc)))

(declaim (inline %add-implication))
(defun %add-implication (2sat p q)
  (declare (fixnum p q))
  (let ((size (2sat-size 2sat))
        (graph (2sat-graph 2sat)))
    (when (< p 0)
      (setq p (+ size (lognot p))))
    (when (< q 0)
      (setq q (+ size (lognot q))))
    (push q (aref graph p))
    2sat))

(defun add-implication (2sat p q)
  (declare (fixnum p q))
  (%add-implication 2sat p q)
  (%add-implication 2sat (lognot q) (lognot p))
  2sat)

(declaim (inline add-disjunction))
(defun add-disjunction (2sat p q)
  "Adds `P or Q' to 2SAT."
  (declare (fixnum p q))
  (%add-implication 2sat (lognot p) q)
  (%add-implication 2sat (lognot q) p)
  2sat)

(declaim (inline 2sat-solve))
(defun 2sat-solve (2sat)
  "Solves 2-SAT and returns a simple bit vector expressing the boolean of each
variable if it is feasible, otherwise returns NIL."
  (let* ((size (2sat-size 2sat))
         (graph (2sat-graph 2sat))
         (scc (make-scc graph))
         (components (scc-components scc))
         (result (make-array size :element-type 'bit :initial-element 0)))
    (setf (2sat-scc 2sat) scc)
    (loop for v below size
          for v-comp = (aref components v)
          for neg-comp = (aref components (+ v size))
          do (cond ((> v-comp neg-comp)
                    (setf (sbit result v) 1))
                   ((= v-comp neg-comp)
                    (return-from 2sat-solve nil))))
    result))


;; BEGIN_USE_PACKAGE
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/2sat :cl-user))
(in-package :cl-user)

;;;
;;; Body
;;;

(defun main ()
  (let* ((n (read))
         (d (read))
         (xs (make-array n :element-type 'uint31 :initial-element 0))
         (ys (make-array n :element-type 'uint31 :initial-element 0)))
    (declare (uint31 n d))
    (dotimes (i n)
      (setf (aref xs i) (read)
            (aref ys i) (read)))
    (let ((2sat (make-2sat n)))
      (dotimes (i1 n)
        (let ((x1 (aref xs i1))
              (y1 (aref ys i1)))
          (loop for i2 from (+ i1 1) below n
                for x2 = (aref xs i2)
                for y2 = (aref ys i2)
                when (< (abs (- x1 x2)) d)
                do (add-disjunction 2sat (lognot i1) (lognot i2))
                when (< (abs (- x1 y2)) d)
                do (add-disjunction 2sat (lognot i1) i2)
                when (< (abs (- y1 x2)) d)
                do (add-disjunction 2sat i1 (lognot i2))
                when (< (abs (- y1 y2)) d)
                do (add-disjunction 2sat i1 i2))))
      (let ((res (2sat-solve 2sat)))
        (if res
            (write-string
             (with-output-to-string (*standard-output* nil :element-type 'base-char)
               (write-line "Yes")
               (dotimes (i n)
                 (println (aref (if (zerop (aref res i)) ys xs) i)))))
            (write-line "No"))))))

#-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 "Yes
4
2
0
"
          (run "3 2
1 4
2 5
0 6
" nil)))
  (it.bese.fiveam:is
   (equal "No
"
          (run "3 3
1 4
2 5
0 6
" nil))))


Measured memory_bytes: 27268