(defun word-char-p (ch)
  (or (alphanumericp ch) (char= ch #\_)))

(defun word-tokens (s)
  (let ((tokens '())
        (n (length s))
        (i 0))
    (loop while (< i n)
          do (if (word-char-p (char s i))
                 (let ((start i))
                   (loop while (and (< i n) (word-char-p (char s i)))
                         do (incf i))
                   (push (subseq s start i) tokens))
                 (incf i)))
    (nreverse tokens)))

(defun numeric-token-p (tok)
  (and (> (length tok) 0) (every #'digit-char-p tok)))

(defun boundary-replace (str token replacement)
  (let ((out (make-string-output-stream))
        (tlen (length token))
        (n (length str))
        (i 0))
    (loop while (< i n)
          do (let ((pos (search token str :start2 i)))
               (cond
                 ((null pos)
                  (write-string str out :start i :end n)
                  (setf i n))
                 ((and (> pos 0) (not (word-char-p (char str (1- pos)))))
                  (write-string str out :start i :end pos)
                  (write-string replacement out)
                  (setf i (+ pos tlen)))
                 (t
                  (write-string str out :start i :end (1+ pos))
                  (setf i (1+ pos))))))
    (get-output-stream-string out)))

(defun plagiarism-check (code1 code2)
  (let ((c1 (format nil "~{~A~^ ~}" code1))
        (c2 (format nil "~{~A~^ ~}" code2)))
    (if (string= c1 c2)
        nil
        (let ((d1 (word-tokens c1))
              (d2 (word-tokens c2))
              (r-cand (make-hash-table :test 'equal))
              (r-order '()))
          (loop for v in d1
                for w in d2
                do (when (and (not (string= v w)) (not (numeric-token-p v)))
                     (unless (nth-value 1 (gethash v r-cand))
                       (push v r-order))
                     (setf (gethash v r-cand) w)))
          (setf r-order (nreverse r-order))
          (dolist (orig r-order)
            (setf c1 (boundary-replace c1 orig (concatenate 'string "PLACEHOLDER" orig))))
          (dolist (orig r-order)
            (setf c1 (boundary-replace c1 (concatenate 'string "PLACEHOLDER" orig) (gethash orig r-cand))))
          (string= c1 c2)))))