Интересная задача с сайта lisp.ru: заменить в списке положительные числа ближайшим отрицательным (справа или слева)

(defun negative-positions (xs)
  (loop :for x :in xs
        :for i :upfrom 0
        :when (< x 0)
        :collect (cons i x)))
 
(defun find-nearest (i indexed-list)
  (when indexed-list
    (do ((ys indexed-list (cdr ys)))
        ((null (cdr ys)) (cdar indexed-list))
      (destructuring-bind ((j1 . y1) (j2 . y2) &rest _) ys
        (declare (ignore _))
        (when (< j1 i j2)
          (return-from find-nearest
            (if (< (- i j1)
                   (- j2 i))
                y1 y2)))))))
 
(defun replace-positive-by-nearest-negative-or-null (xs)
  (let ((nps (negative-positions xs)))
    (loop :for x :in xs
          :for i :upfrom 0
          :collect (if (> x 0) (find-nearest i nps) x))))
 
(defun test-one (list)
  (format t "~&## ~{~4d~}~%-> ~{~4d~}~%~%" list 
          (replace-positive-by-nearest-negative-or-null list))
  (values))
 
(defun test ()
  (test-one '(1 2 3 4))
  (test-one '(-1 1 2 -2 3 4 5 6 -6)))

CL-USER 4 > (test)
##    1   2   3   4
->  NIL NIL NIL NIL
 
##   -1   1   2  -2   3   4   5   6  -6
->   -1  -1  -2  -2  -2  -2  -6  -6  -6
 
 
CL-USER 5 >

;; Поиск пары ближайших отрицательных
 
(defun pair-neg (lst n &optional left right (c 0))
  (cond ((null lst) (list left right))
        ((< c n)
         (cond ((< (car lst) 0) (pair-neg (cdr lst) n (list c (car lst)) right (+ c 1)))
               (t (pair-neg (cdr lst) n left right (+ c 1)))))
        ((= c n) (pair-neg (cdr lst) n left right (+ c 1)))
        (t (cond ((< (car lst) 0) (list left (list c (car lst))))
                 (t (pair-neg (cdr lst) n left right (+ c 1)))))))
 
;; вычисление ближайшего отрицательного
 
(defun nneg (lst k)
  (cond ((And (null (car lst)) (null (cadr lst))) Nil)
        ((null (car lst)) (cadr (cadr lst)))
        ((null (cadr lst)) (cadr (car lst))) 
        (t (let ((p1 (caar lst))
                 (q1 (cadar lst))
                 (p2 (car (cadr lst)))
                 (q2 (cadr (cadr lst))))
                 (if (< (- k p1) (- p2 k)) q1 q2)))))
 
;; решение
 
(defun solve (lst &optional (c 0) (sav lst))
  (cond ((null lst) nil)
        ((< (car lst) 0) (cons (car lst) (solve (cdr lst) (+ c 1) sav)))
        (t (cons (nneg (pair-neg sav c) c) (solve (cdr lst) (+ c 1) sav)))))
 
==> solve
 
(solve '( 1 -2 3 -4 -5 6 7 8))
 
==> (-2 -2 -4 -4 -5 -5 -5 -5)

(defun neighbors (w &optional ac &aux (a (car w)) (d (cdr w)))
  (cond ((null w) nil)
        ((plusp a) (if (some #'minusp d)
                       (cons (find-if #'minusp d) (neighbors d ac))
                       (if (some #'minusp ac)
                           (cons (find-if #'minusp ac) (neighbors d ac))
                           (cons nil (neighbors d ac)))))
        ((cons a (neighbors d (cons a ac))))))
 
> (neighbors '( 1 -2 3 -4 -5 6 7 8))
(-2 -2 -4 -4 -5 -5 -5 -5)

(defun neighbors (w &optional ac &aux (a (car w)) (d (cdr w)))
  (when w (if (plusp a)
              (if (some #'minusp d)
                  (cons (find-if #'minusp d) (neighbors d ac))
                  (if (some #'minusp ac)
                      (cons (find-if #'minusp ac) (neighbors d ac))
                      (cons nil (neighbors d ac))))
              (cons a (neighbors d (cons a ac))))))
 
> (neighbors '( 1 -2 3 -4 -5 6 7 8))
(-2 -2 -4 -4 -5 -5 -5 -5)

CL-USER 3 > (neighbors '( 1 -2 3 -4 -5 6 7 7 7 -2 8))
(-2 -2 -4 -4 -5 -2 -2 -2 -2 -2 -2)

(solve '( 1 -2 3 -4 -5 6 7 7 7 -2 8))
 
==> (-2 -2 -4 -4 -5 -5 -5 -2 -2 -2 -2)

(defun mi (w) (find-if #'minusp w))
 
(defun neighbors (w &optional ac &aux (a (car w)) (d (cdr w)))
  (when w
    (if (plusp a)
        (cond ((and (some #'minusp ac) (some #'minusp d))
               (if (< (position-if #'minusp ac) (position-if #'minusp d))
                   (cons (mi ac) (neighbors d (cons a ac)))
                   (cons (mi d) (neighbors d (cons a ac)))))
              ((some #'minusp d) (cons (mi d) (neighbors d (cons a ac))))
              ((some #'minusp ac) (cons (mi ac) (neighbors d (cons a ac))))
              ((cons nil (neighbors d (cons a ac)))))
        (cons a (neighbors d (cons a ac))))))
 
> (neighbors '(1 -2 3 -4 -5 6 7 7 7 -2 8))
(-2 -2 -4 -4 -5 -5 -5 -2 -2 -2 -2)

(defun mi (w) (find-if #'minusp w))
 
(defun sm (w) (some #'minusp w))
 
(defun ps (w) (position-if #'minusp w))
 
(defun ne (w a v) (neighbors w (cons a v)))
 
(defun neighbors (w &optional ac &aux (a (car w)) (d (cdr w)))
  (when w (if (plusp a)
              (cond ((and (sm ac) (sm d))
                     (if (< (ps ac) (ps d))
                         (cons (mi ac) (ne d a ac))
                         (cons (mi d) (ne d a ac))))
                    ((sm d) (cons (mi d) (ne d a ac)))
                    ((sm ac) (cons (mi ac) (ne d a ac)))
                    ((cons nil (ne d a ac))))
              (cons a (ne d a ac)))))
 
> (neighbors '(1 -2 3 -4 -5 6 7 7 7 -2 8))
(-2 -2 -4 -4 -5 -5 -5 -2 -2 -2 -2)

;; список позиций отрицательных
 
(defun pos-neg (lst)
 (let ((lstn nil))
   (iter (for i in lst) (for c from 0 to (- (length lst) 1))
         (when (< i 0) (collecting c into lstn)))
   lstn
 ))
 
;; Ближайшее отрицательное
 
(defun nearest-neg (p lstneg)
  (cond ((< p (car lstneg)) (car lstneg))
        ((> p (last lstneg)) (last lstneg))
        (t (iter (for i in lstneg) (for j in (cdr lstneg)) 
                 (when (and (> p i) (< p j)) 
                       (return (if (< (- p i) (- j p)) i j)))))))
 
;; Решение:
 
(defun solve (lst)
  (let ((posneg (pos-neg lst)) (res nil))
    (iter (for c in lst) (for i from 0 to (- (length lst) 1))
        (if (< c 0) (collecting c into res)
                    (collecting (car (subseq lst (nearest-neg i posneg))) into res)))
    res))
    
 
==> solve
 
(solve '(1 -2 3 -4 -5 6 7 7 7 -2 8))
 
==> (-2 -2 -4 -4 -5 -5 -5 -2 -2 -2 -2)