Path: ...!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp,comp.lang.scheme
Subject: Re: Homework question: LOOP
Date: Thu, 12 Sep 2024 10:12:05 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 45
Message-ID: <vbuepk$6veu$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Thu, 12 Sep 2024 12:12:06 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="0068c9cac97edf80ad7dcfbe07391a5a";
	logging-data="228830"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1/wnsLKBT1hmUwbX60o7rpA"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:iYqTXJ7cfarbQxOK2Nz9jt6uOW0=
Bytes: 2260

Kenny Tilton wrote:

> (defun prior-sib-if (self list &optional (test-fn #'true-that))
>    "Find nearest preceding sibling passing TEST-FN"
>    (labels ((check-priors (sibs)
>               (if (eql self (first sibs))
>                   nil
>                 (or (check-priors (rest sibs))
>                   (when (funcall test-fn (first sibs))
>                     (first sibs))))))
>      (check-priors list)))

Peter Seibel wrote:

> Ah, I missed that bit in the maze of twisty, recursive passages, all
> alike. How about this bit of double loop delight:
> 
>   (defun prior-sib-if (self list &optional (test-fn #'true-that))
>     "Find nearest preceding sibling passing TEST-FN"
>     (loop with candidates = nil
>         for node in list
>         until (eql node self) do (push node candidates)
>         finally (return (loop for c in candidates when (funcall test-fn c) retur
> n c))))

Gauche Scheme

(use srfi-1) ;; take-while

(define (prior-sib-if self the-list test-fn)
  (find test-fn
    (reverse (take-while (^x (not (equal? self x))) the-list))))

gosh> (prior-sib-if 8 '(0 2 3 4 5 6 8 2 8) even?)
6
gosh> (prior-sib-if 8 '(0 2 3 4 5 6 8 2 8) odd?)
5

Another way:

(define (prior-sib-if self the-list test-fn)
  (let go ((lst the-list) (seen '()))
    (if (equal? self (car lst))
      (find test-fn seen)
      (go (cdr lst) (cons (car lst) seen)))))