anchor.diff:                  :content))
           :boilerplate)))
   
  -(defun link-density (node)
  -  (if (typep node 'stp:text)
  -      0
  -      (let ((len (text-length node)))
  -        (if (zerop len)
  -            0
  -            (let ((anchors (css:query "a" node)))
  -              (float
  -               (/ (reduce #'+ anchors :key #'text-length) len)))))))
  +(defun compute-link-density (nodes)
  +  (let ((len 0)
  +        (anchor-len 0))
  +
  +    (dolist (node nodes)
  +      (incf len (text-length node))
  +      (unless (typep node 'stp:text)
  +        (incf anchor-len (reduce #'+ (css:query "a" node) :key #'text-length))))
  +
  +    (if (zerop len)
  +        0
  +        (/ anchor-len (float len)))))
   
   (defun text-length (node)
     (typecase node
  
positive.code:      (reduce #'+ (stp:list-children node) :key #'text-length))
      (t 0)))
  
  (defun text-density (node &key (width 80))
    (let ((col 0)
          (lines -1)
          (words 0))
      ;; A restrictive idea of words.
      (flet ((compute-density (text)
               (ppcre:do-scans (start end rs re "[a-zA-Z0-9]+" text)
                 (incf words)
                 (let ((len (- end start)))
                   (when (> (incf col len) width)
                     (incf lines 1)
                     (setf col len))))))
        (typecase node
          (stp:text (compute-density (stp:data node)))
          (stp:element
           (stp:do-recursively (n node)
             (when (typep n 'stp:text)
               (compute-density (stp:data n)))))))
  
      (float (/ words (max 1 lines)))))
  
negative.code: (in-package #:cl-boilerpipe)
  
  (defclass text-block ()
    ((offset :initarg :offset :accessor offset)
     (nodes :initarg :nodes :accessor nodes)
     (text-density :accessor text-density)
     (link-density :accessor link-density))
    (:default-initargs :nodes nil))
  
  (defmethod print-object ((self text-block) stream)
    (with-slots (offset text-density link-density) self
      (print-unreadable-object (self stream :type t)
        (format stream "~d td ~d ld ~d" offset text-density link-density))))
  
  (defun count-matches (re text &key start end)
    (let ((sum 0))
      (ppcre:do-matches (s e re text nil :start start :end end)
        (incf sum))
      sum))
  
  (define-compiler-macro count-matches (&whole decline
                                               &environment env
                                               re text &key start end)
    (if (constantp re env)
        `(count-matches (load-time-value (ppcre:create-scanner ,re)) ,text
                        ,@(when start `(:start ,start))
                        ,@(when end `(:end ,end)))
        decline))
  
  (defun strip-boilerplate (html)
    (-> html
        (chtml:parse (stp:make-builder))
        document->text-blocks
        filter-blocks
        blocks->document
        (stp:serialize (cxml:make-string-sink))))
  
  (defun filter-blocks (text-blocks)
    (let ((empty (make-instance 'text-block :offset -1)))
      (loop for prev = empty then curr
            for (curr . rest) on text-blocks
            for next = (if rest (first rest) empty)
            for class = (classify prev curr next)
            if (eql class :content)
              collect curr)))
  
  (defun blocks->document (text-blocks)
    (let ((root (stp:make-element "div")))
      (dolist (tb text-blocks)
        (let ((para (stp:make-element "p")))
          (setf (stp:attribute-value para "class") "text-block")
          (with-slots (nodes) tb
            (dolist (node nodes)
              (stp:append-child para node)))
          (stp:append-child root para)))
      (stp:make-document root)))
  
  (defun text-block-wc (text-block)
    (let ((sum 0))
      (map-text-block-nodes
       (lambda (node)
         (when (typep node 'stp:text)
           (let ((data (stp:data node)))
             (incf sum (wc data)))))
       text-block)
      sum))
  
  (defun wc (text)
    (max 0 (floor (count-matches "\\b" text) 2)))
  
  (defun text-block-contains-any-p (text-block strings)
    (block nil
      (map-text-block-nodes
       (lambda (node)
         (and (typep node 'stp:text)
              (let ((data (stp:data node)))
                (some (lambda (string)
                        (search (string string) data :test #'char-equal))
                      strings))
              (return t)))
       text-block)))
  
  (defun text-block-text (text-block)
    (with-output-to-string (s)
      (map-text-block-nodes
       (lambda (node)
         (when (typep node 'stp:text)
           (write-string (stp:data node) s)
           (write-char #\Space s)))
       text-block)))
  
  (defun map-text-block-nodes (fn tb)
    (with-slots (nodes) tb
      (dolist (node nodes)
        (stp:do-recursively (node node)
          (funcall fn node)))))
  
  (defmethod initialize-instance :after ((self text-block) &key nodes)
    (with-slots (text-density link-density) self
  