Pascal Bourguignon wrote:

> > Hello, I'm trying to imitate the behaviour of the pivot-table in excel
> > where you take a list of items and another list of their values and
> > you sum similar ones together (see toy example below). I have a list
> > of 30000 items and their associated values and in excel using a pivot-
> > table the computation is done instantaneously (less than 2 seconds)
> > while the procedure I wrote in lisp will take about 12 hours !(I give
> > an example of only 15 items below, this goes fast of course because
> > only 15 items, but the 30,000 will take an estimate of about 12 hours;
> > I never reached that far because around 5 hours I give up). Do you
> > know why? Is there a way to enhance the procedure and make it as fast
> > as the pivot table? Thanks
>
>
> ;; Tabulate like the pivot table.
> (time
> (let ((ls (vector "a" "b" "c" "b" "a" "f" "e" "g"
> "h" "k" "z" "k" "r" "u" "f"))
> (counter (vector 1 5 8 7 14 8 3 7 9 4 3 21 5 7 9))
> (i 0))
> (loop while (< i (length ls)) do
> (let ((j (+ i 1)))
> (loop while (< j (length ls)) do
> (when (and (equal (elt ls i) (elt ls j))
> (not (equal (elt ls j) 'indic)))
> (incf (elt counter i) (elt counter j))
> (setf (elt ls j) 'indic
> (elt counter j) 'indic))
> (incf j)))
> (incf i))
> (values (delete 'indic ls)
> (delete 'indic counter))))
>
> Real time: 0.009765 sec.
> Run time: 0.012 sec.
> Space: 102408 Bytes
> #("a" "b" "c" "f" "e" "g" "h" "k" "z" "r" "u") ;
> #(15 12 8 17 3 7 9 25 3 5 7)

Gauche Scheme

(use srfi-13) ;; string<
(use srfi-43) ;; vector-binary-search

(define (string-cmp a b)
(cond ((string< a b) -1)
((string= a b) 0)
(else 1)))

(define (do-the-pivot keys counts)
(let* ((unique-keys
(sort (delete-duplicates (vector->list keys)) string<))
(pivot-keys (list->vector unique-keys))
(pivot-counts (make-vector (vector-length pivot-keys) 0)))
(vector-for-each
(lambda (_ k n)
(let ((i (vector-binary-search pivot-keys k string-cmp)))
(vector-set! pivot-counts i
(+ n (vector-ref pivot-counts i)))))
keys
counts)
(values pivot-keys pivot-counts)))

(do-the-pivot
#("a" "b" "c" "b" "a" "f" "e" "g" "h" "k" "z" "k" "r" "u" "f")
#(1 5 8 7 14 8 3 7 9 4 3 21 5 7 9))

===>
#("a" "b" "c" "e" "f" "g" "h" "k" "r" "u" "z")
#(15 12 8 3 17 7 9 25 5 7 3)

On 2024-06-17, B. Pym <No_spamming@noWhere_7073.org> wrote:
> Pascal Bourguignon wrote:
>
>> > Hello, I'm trying to imitate the behaviour of the pivot-table in excel
>> > where you take a list of items and another list of their values and
>> > you sum similar ones together (see toy example below). I have a list
>> > of 30000 items and their associated values and in excel using a pivot-
>> > table the computation is done instantaneously (less than 2 seconds)
>> > while the procedure I wrote in lisp will take about 12 hours !(I give
>> > an example of only 15 items below, this goes fast of course because
>> > only 15 items, but the 30,000 will take an estimate of about 12 hours;
>> > I never reached that far because around 5 hours I give up). Do you
>> > know why? Is there a way to enhance the procedure and make it as fast
>> > as the pivot table? Thanks
>>
>>
>> ;; Tabulate like the pivot table.
>> (time
>> (let ((ls (vector "a" "b" "c" "b" "a" "f" "e" "g"
>> "h" "k" "z" "k" "r" "u" "f"))
>> (counter (vector 1 5 8 7 14 8 3 7 9 4 3 21 5 7 9))
>> (i 0))
>> (loop while (< i (length ls)) do
>> (let ((j (+ i 1)))
>> (loop while (< j (length ls)) do
>> (when (and (equal (elt ls i) (elt ls j))
>> (not (equal (elt ls j) 'indic)))
>> (incf (elt counter i) (elt counter j))
>> (setf (elt ls j) 'indic
>> (elt counter j) 'indic))
>> (incf j)))
>> (incf i))
>> (values (delete 'indic ls)
>> (delete 'indic counter))))
>>
>> Real time: 0.009765 sec.
>> Run time: 0.012 sec.
>> Space: 102408 Bytes
>> #("a" "b" "c" "f" "e" "g" "h" "k" "z" "r" "u") ;
>> #(15 12 8 17 3 7 9 25 3 5 7)
>
> Gauche Scheme
>
> (use srfi-13) ;; string<
> (use srfi-43) ;; vector-binary-search
>
> (define (string-cmp a b)
> (cond ((string< a b) -1)
> ((string= a b) 0)
> (else 1)))
>
> (define (do-the-pivot keys counts)
> (let* ((unique-keys
> (sort (delete-duplicates (vector->list keys)) string<))
> (pivot-keys (list->vector unique-keys))
> (pivot-counts (make-vector (vector-length pivot-keys) 0)))
> (vector-for-each
> (lambda (_ k n)
> (let ((i (vector-binary-search pivot-keys k string-cmp)))
> (vector-set! pivot-counts i
> (+ n (vector-ref pivot-counts i)))))
> keys
> counts)
> (values pivot-keys pivot-counts)))
>
> (do-the-pivot
> #("a" "b" "c" "b" "a" "f" "e" "g" "h" "k" "z" "k" "r" "u" "f")
> #(1 5 8 7 14 8 3 7 9 4 3 21 5 7 9))
>
> ===>
> #("a" "b" "c" "e" "f" "g" "h" "k" "r" "u" "z")
> #(15 12 8 3 17 7 9 25 5 7 3)

This is the TXR Lisp interactive listener of TXR 294.
Quit with :quit or Ctrl-D on an empty line. Ctrl-X ? for cheatsheet.
TXR is light and portable; take it camping, or to the Bahamas.
1> (defun pivot (k v)
(flow (list k v)
transpose
(sort-group @1 car)
(mapcar [juxt caar (op sum @1 cadr)])
transpose))
pivot
2> (pivot
#("a" "b" "c" "b" "a" "f" "e" "g" "h" "k" "z" "k" "r" "u" "f")
#(1 5 8 7 14 8 3 7 9 4 3 21 5 7 9))
(("a" "b" "c" "e" "f" "g" "h" "k" "r" "u" "z") (15 12 8 3 17 7 9 25 5 7 3))

Using group-reduce:

3> (defun pivot (k v)
(flow (list k v)
transpose
(group-reduce (hash) first [mapf + use second] @1 0)
hash-pairs
(sort @1 : first)
transpose))
pivot
4> (pivot
#("a" "b" "c" "b" "a" "f" "e" "g" "h" "k" "z" "k" "r" "u" "f")
#(1 5 8 7 14 8 3 7 9 4 3 21 5 7 9))
(("a" "b" "c" "e" "f" "g" "h" "k" "r" "u" "z") (15 12 8 3 17 7 9 25 5 7 3))

Nicer with group-map:

5> (defun pivot (k v)
(flow (list k v)
transpose
(group-map first (op sum @1 second))
hash-pairs
(sort @1 : first)
transpose))
pivot
6> (pivot
#("a" "b" "c" "b" "a" "f" "e" "g" "h" "k" "z" "k" "r" "u" "f")
#(1 5 8 7 14 8 3 7 9 4 3 21 5 7 9))
(("a" "b" "c" "e" "f" "g" "h" "k" "r" "u" "z") (15 12 8 3 17 7 9 25 5 7 3))

--
TXR Programming Language: http://nongnu.org/txr
Cygnal: Cygwin Native Application Library: http://kylheku.com/cygnal
Mastodon: @Kazinator@mstdn.ca