[lnkForumImage]
TotalShareware - Download Free Software

Confronta i prezzi di migliaia di prodotti.
Asp Forum
 Home | Login | Register | Search 


 

Forums >

comp.lang.lisp

Re: Homework question: LOOP

William James

7/31/2015 8:07:00 AM

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:

(define (prior-sib-if self items test-fn)
(let1 candidates '()
(while (and (pair? items) (not (eqv? self (car items))))
(push! candidates (pop! items)))
(and (pair? candidates) (pair? items)
(find test-fn candidates))))

--
In Stockholm ... 20 Muslim men ... began to assault the children, ripping their
swimsuits off.... [T]he men cornered one of the [11-year-old] girls in a
grotto in the bathhouse and gang-raped her. The police refused to press any
charges. www.liveleak.com/view?i=807_1369627137
Sahlin [stressed] that her compatriots must accept that the new Sweden is
multi-cultural.... "Like it or not, this is the new Sweden."
fjordman.blogspot.ca/2005/05/is-swedish-democracy-collapsing.html
1 Answer

William James

2/28/2016 7:52:00 AM

0

WJ wrote:

> 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:
>
> (define (prior-sib-if self items test-fn)
> (let1 candidates '()
> (while (and (pair? items) (not (eqv? self (car items))))
> (push! candidates (pop! items)))
> (and (pair? candidates) (pair? items)
> (find test-fn candidates))))

SML:

fun prior_sib_if item list test =
let
fun aux sib [] = NONE
| aux sib (h::t) =
if h=item then sib
else aux (if (test h) then (SOME h) else sib) t
in aux NONE list
end;

fun prior_sib item list = prior_sib_if item list (fn _ => true);

prior_sib 9 [0,2,3,4,5,8,9] ;
===>
SOME 8

prior_sib 707 [0,2,3,4,5,8,9] ;
===>
NONE

prior_sib_if 9 [0,2,3,4,5,8,9] (fn n => 1=n mod 2);
===>
SOME 5

prior_sib_if 9 [0,2,4,8,9] (fn n => 1=n mod 2);
===>
NONE


--
When the Israeli bombers and torpedo-planes were sent to attack and destroy the
ship, the Jewish commander, seeing that it was an American vessel, had
misgivings and reported to the High Command, which simply repeated the orders
to attack and sink the Liberty. www.revilo-oliver.com/rpo/Bit_of_Good_News.html