[lnkForumImage]
TotalShareware - Download Free Software
Confronta i prezzi di migliaia di prodotti.
Asp Forum
 Home | Login | Register | Search 


 

Forums >

comp.lang.lisp

Re: My LOOP is ugly

William James

8/8/2015 11:24:00 AM

Kenny Tilton wrote:

> (defun p2b (pairs &key ((:test test) #'eql))
> "((A 1) (A 2) (B 2) (C 2) (C 3)) ==> ((A 1 2) (B 2) (C 2 3))"
> (loop with bunch = nil
> for (one two) in pairs
> do (push two (cdr (or (assoc one bunch :test test)
> (car (push (list one) bunch)))))
> finally (return bunch)))

Gauche Scheme:

(define (p2b pairs)
(let1 h (make-hash-table)
(for-each (cut apply hash-table-push! h <>) pairs)
(hash-table->alist h)))

(p2b '((A 1) (A 2) (B 2) (C 2) (C 3)))
===>
((A 2 1) (B 2) (C 3 2))

--
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
2 Answers

William James

5/27/2016 9:24:00 PM

0

WJ wrote:

> Kenny Tilton wrote:
>
> > (defun p2b (pairs &key ((:test test) #'eql))
> > "((A 1) (A 2) (B 2) (C 2) (C 3)) ==> ((A 1 2) (B 2) (C 2 3))"
> > (loop with bunch = nil
> > for (one two) in pairs
> > do (push two (cdr (or (assoc one bunch :test test)
> > (car (push (list one) bunch)))))
> > finally (return bunch)))
>
> Gauche Scheme:
>
> (define (p2b pairs)
> (let1 h (make-hash-table)
> (for-each (cut apply hash-table-push! h <>) pairs)
> (hash-table->alist h)))
>
> (p2b '((A 1) (A 2) (B 2) (C 2) (C 3)))
> ===>
> ((A 2 1) (B 2) (C 3 2))

OCaml:

open List ;;

let p2b pairs =
let h = Hashtbl.create 99 in
iter
(fun (k,v) -> Hashtbl.add h k v)
pairs ;
map
(fun k -> k, Hashtbl.find_all h k)
(sort_uniq compare (map fst pairs)) ;;

p2b ["A",1; "A",2; "B",2; "C",2; "C",3] ;;
===>
[("A", [2; 1]); ("B", [2]); ("C", [3; 2])]

--
Jewish Communists consistently opposed Polish nationalist aspirations, and ...
liquidated Polish nationalists and undermined the role of the Catholic Church
while simultaneously establishing secular Jewish economic and social
structures. --- Kevin MacDonald; "The Frankfurt School of Social Research and
the Pathologization of Gentile Group Allegiances"

Kaz Kylheku

5/27/2016 10:55:00 PM

0

On 2016-05-27, WJ <w_a_x_man@yahoo.com> wrote:
> WJ wrote:
>
>> Kenny Tilton wrote:
>>
>> > (defun p2b (pairs &key ((:test test) #'eql))
>> > "((A 1) (A 2) (B 2) (C 2) (C 3)) ==> ((A 1 2) (B 2) (C 2 3))"
>> > (loop with bunch = nil
>> > for (one two) in pairs
>> > do (push two (cdr (or (assoc one bunch :test test)
>> > (car (push (list one) bunch)))))
>> > finally (return bunch)))
>>
>> Gauche Scheme:
>>
>> (define (p2b pairs)
>> (let1 h (make-hash-table)
>> (for-each (cut apply hash-table-push! h <>) pairs)
>> (hash-table->alist h)))
>>
>> (p2b '((A 1) (A 2) (B 2) (C 2) (C 3)))
>> ===>
>> ((A 2 1) (B 2) (C 3 2))
>
> OCaml:
>
> open List ;;
>
> let p2b pairs =
> let h = Hashtbl.create 99 in
> iter
> (fun (k,v) -> Hashtbl.add h k v)
> pairs ;
> map
> (fun k -> k, Hashtbl.find_all h k)
> (sort_uniq compare (map fst pairs)) ;;
>
> p2b ["A",1; "A",2; "B",2; "C",2; "C",3] ;;
> ===>
> [("A", [2; 1]); ("B", [2]); ("C", [3; 2])]

That's not even the correct output. "A" looks like a string
and it's not on the same level of nesting as 2 and 1.

This is the TXR Lisp interactive listener of TXR 141.
Use the :quit command or type Ctrl-D on empty line to exit.
1> (hash-alist
(hash-update [group-by first '((A 1) (A 2) (B 2) (C 2) (C 3))]
(op mapcar second)))
((C 2 3) (B 2) (A 1 2))

How about:

2> (mapcar [juxt caar (op mapcar cadr)]
[partition-by car '((A 1) (A 2) (B 2) (C 2) (C 3))])
((A (1 2)) (B (2)) (C (2 3)))

Close, and more so than the OCaml. callf should help us here:

3> (mapcar [callf cons caar (op mapcar cadr)]
[partition-by car '((A 1) (A 2) (B 2) (C 2) (C 3))])
((A 1 2) (B 2) (C 2 3))

Bingo.