Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Combining duplicates in list

9 REPLIES 9
Reply
Message 1 of 10
Anonymous
589 Views, 9 Replies

Combining duplicates in list

Hello everyone, I need a little help getting un-stuck..... I have a list such as this, where each item is a label and distance: (("25x19" "1500'")("50x19" "2500'")("25x19" "1000'")("6x19" "750'")("50x19" "3000'"))..... Without creating alot of (cond)'s for each possible label, how would I create a new list that combines duplicate labels and adds the distance?..... The result would look like this: (("25x19" "2500'")("50x19" "5500'")("6x19" "750'"))..... If it would make it easier, I can create the original list so that the distance is an integer..... Thanks for any help, Robert.....(using A2K)
9 REPLIES 9
Message 2 of 10
Anonymous
in reply to: Anonymous


Robert,


Refer to thread 'Sort a list numerically by first element' on 24 Oct '01.


I think it has something you could modify for your use.


M@

Message 3 of 10
Anonymous
in reply to: Anonymous

Do make the value an integer. It makes life a lot easier.


(defun c:qw (/ vl va)

(setq vl
'(("25x19" 1500)("50x19" 2500)("25x19" 1000)("6x19" 750)("50x19" 3000)
("25x19" 1500)("50x19" 2500)("25x19" 1000)("6x19" 750)("50x19" 3000)))

;;;MAKE VARIABLE NAME AND VALUE LISTS
(foreach v vl
(if (not (member (car v) va))
(setq va (cons (car v) va)))
(set (read (car v))
(cons (cadr v) (eval (read (car v))))))


;;;MAKE VARIABLE WITH NAME AND TOTAL VALUE
(and va
(foreach a va
(set (read a) (list a (apply '+ (eval (read a))))))))



You end up with a list !va that contains all of the sizes

Each size name is then made into a list. In the example above:

!50x19

returns;

("50x19" 11000)

-David


"rcunningham" wrote in message
news:f09572c.-1@WebX.maYIadrTaRb...
> Hello everyone, I need a little help getting un-stuck..... I have a list
such as this, where each item is a label and distance: (("25x19"
"1500'")("50x19" "2500'")("25x19" "1000'")("6x19" "750'")("50x19"
"3000'"))..... Without creating alot of (cond)'s for each possible label,
how would I create a new list that combines duplicate labels and adds the
distance?..... The result would look like this: (("25x19" "2500'")("50x19"
"5500'")("6x19" "750'"))..... If it would make it easier, I can create the
original list so that the distance is an integer..... Thanks for any help,
Robert.....(using A2K)
>
Message 4 of 10
Anonymous
in reply to: Anonymous

After a little more thought, all variables must be reset:

(setq vl
'(("25x19" 1500)("50x19" 2500)("25x19" 1000)("6x19" 750)("50x19" 3000)
("25x19" 1500)("50x19" 2500)("25x19" 1000)("6x19" 750)("50x19" 3000)))

;;; COMBINE LIST VALUES
;;; ARG -> LIST
;;; RET -> LIST
;;; USAGE = (comblist vl)

(defun comblist (vl / va vr)

;;;MAKE VARIABLE NAME LIST
(foreach v vl
(if (not (member (car v) va))
(setq va (cons (car v) va))))

;;RESET LISTS
(foreach a va
(if (eval (read a))
(set (read a) nil)))

;;;MAKE VARIABLE LIST
(foreach v vl
(set (read (car v))
(cons (cadr v) (eval (read (car v))))))

;;;MAKE VARIABLE WITH NAME AND TOTAL VALUE
(foreach a va
(set (read a) (list a (apply '+ (eval (read a))))))

;;;RECOMPILE LIST
(foreach a va
(setq vr (append vr (list (eval (read a)))))))


;|

Globals

!50x19

("50x19" 11000)

-David
Message 5 of 10
Anonymous
in reply to: Anonymous

Thanks David, This is what I was after. Robert
Message 6 of 10
Anonymous
in reply to: Anonymous

One way to approach this is to "sort out" things
into various groups and then apply a sum on each.

Use sort-out function, like I posted once here:

(setq vals '(("25x19" 1500)("50x19" 2500)("25x19" 1000)("6x19" 750)("50x19"
3000)))

(setq sorted nil)
(sort-out vals
'sorted ;; store under this variable
car ;; using car as a key
cadr ;; and cadr as value
)

(setq res
(mapcar
'(lambda(g)
(cons (car g)(apply '+ (cdr g))))
sorted))

so you can retrieve total size with (cdr(assoc "50x19" res)) ==> 5500

where

(defun sort-out (things container-sym keyfun valfun)
(foreach thing things
(store (valfun thing) (keyfun thing) container-sym))
container-sym)

(defun store (x k c / cv a)
(setq cv (vl-symbol-value c)) ; A2K and above
(if (setq a (assoc k cv))
(set c (subst (cons k (cons x (cdr a)))
a cv))
(set c (cons (list k x) cv))))


Cheers,
--
Have fun, 🙂
Vlad http://vnestr.tripod.com/
(define (average . ns)
(if ns (/ (apply '+ ns) (length ns))))



rcunningham wrote in message
news:f09572c.-1@WebX.maYIadrTaRb...
> Hello everyone, I need a little help getting un-stuck..... I have a list
such as this, where each item is a label and distance: (("25x19"
"1500'")("50x19" "2500'")("25x19" "1000'")("6x19" "750'")("50x19"
"3000'"))..... Without creating alot of (cond)'s for each possible label,
how would I create a new list that combines duplicate labels and adds the
distance?..... The result would look like this: (("25x19" "2500'")("50x19"
"5500'")("6x19" "750'"))..... If it would make it easier, I can create the
original list so that the distance is an integer..... Thanks for any help,
Robert.....(using A2K)
>
Message 7 of 10
Anonymous
in reply to: Anonymous

or to use Vladmir's inspired approach in a more specfic application:

(setq vals '(("25x19" 1500)("50x19" 2500) ("25x19" 1000)
("6x19" 750)("50x19" 3000)))

(defun collect (vals key val fun / out a n)
(foreach n vals
(if
(setq a (assoc (key n) out))
(setq out (subst
(cons (key n)
(cons (val n)
(cdr a)
))
a
out
))
(setq out (cons n out))
))
(mapcar '(lambda (n) (cons (car n) (apply 'fun (cdr n))))
out
)
)
;;Examples: (collect vals car cadr +) or (collect vals car cadr list)
;;
;;Thanks Vladimir for your excellent examples
;;Doug Broad
Message 8 of 10
Anonymous
in reply to: Anonymous

Doug Broad wrote in message
news:388922990B12E288D8AEEA8B193C7555@in.WebX.maYIadrTaRb...
> [.....]
> ;;Examples: (collect vals car cadr +) or (collect vals car cadr list)

Now _that's_ functional programming thinking! 🙂
Very, very interesting!

I took a liberty to change your code a little. The whole idea of
collecting is not to build the intermediary list, but rather apply
the result-building function while collecting, thus maintaining
the current result all the time.

That means we have to supply a function that will took two
arguments -- the interim result and the newly found value.
That also means that we have to have one more argument --
the initial value to be used on first call:

(setq vals '(("25x19" 1500)("50x19" 2500) ("25x19" 1000)
("6x19" 750)("50x19" 3000)("25x19" 1000)("25x19" 2000)))

(defun collect (vals key val add init-val / out a n)
(foreach n vals
(if (setq a (assoc (key n) out))
(setq out (subst (cons (key n)
(add (val n) (cdr a)))
a out))
(setq out (cons (cons (key n)
(add (val n) init-val))
out))))
out)

; Examples:
; (collect vals car cadr + 0)
; (collect vals car cadr cons nil)

The extra init-val argument is here because of language limitations.
We should've been able to define functions capable of taking
variable number of arguments and acting accordingly, for instance,

(+ 1 2) => 3
(+ 1 0) => 1
(+ ) => 0

so we would have defined new construct-list function so that

(conlst 1 '(2)) => (1 2)
(conlst 1 '()) => (1)
(conlst ) => ()

Then we could drop the init-val argument and just use (add) call
with no arguments instead to produce the function's "implied" value
on first-call. I think I saw something about these "implied" values
in SICP but dont recall exactly. I think they used different name for
this concept there. Anyway...


Enjoy, 🙂


P.S. By the same token (* 1 2 3) == (* 2 3) so (* ) should return 1.
Alisp mistakenly returns 0.
Message 9 of 10
Anonymous
in reply to: Anonymous

Thanks to all who replied! Although David's reply got me out of the mud, I really appreciate the follow up posts. They give me another perspective to solve my problem. Thanks again, Robert
Message 10 of 10
Anonymous
in reply to: Anonymous

Hi again,

Yes. I like the change. Much tighter. No need to tack on
the mapcar. Initial values aren't a bad idea even if you could
avoid them. It was also almost 30% faster. Great job.

(timer '(collect vals car cadr + 0) 20000)
11.2681

(timer '(collect vals car cadr +) 20000)
15.9639

Thanks again!

Doug

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Technology Administrators


AutoCAD Beta