Jump to content

Recommended Posts

Posted

Hi,

 

I want to calculate a percentage value when itterating a List


Each item in the list has 2 elements:

  • ID (e.g. H601_000001)
  • TRUE or FALSE


The ID element is split in 2 parts where the underscore is the divider:

  • H601 is a location (the amount of Locations will always vary)
  • 00001 is serial number  (the amount of serial numbers will always vary per Location)

 

Each item of the list also has a TRUE or FALSE element.


Below is an example List of 3 Locations ( H601, H602 and H603)

 

((H601_000001 TRUE)(H601_000002 TRUE)(H601_000003 TRUE)(H601_000004 TRUE)(H601_000005 TRUE)(H601_000006 TRUE)(H601_000007 TRUE)(H601_000008 TRUE)(H601_000009 TRUE)(H601_000010 TRUE)(H601_000011 TRUE)(H601_000012 TRUE)(H601_000013 TRUE)(H601_000014 TRUE)(H601_000015 TRUE)(H601_000016 TRUE)(H601_000017 TRUE)(H601_000018 TRUE)(H601_000019 TRUE)(H601_000020 TRUE)(H601_000021 TRUE)(H601_000022 TRUE)(H601_000023 TRUE)(H601_000024 TRUE)(H601_000025 TRUE)(H601_000026 TRUE)(H601_000027 TRUE)(H601_000028 TRUE)(H601_000029 TRUE)(H601_000030 TRUE)(H601_000031 TRUE)(H601_000032 TRUE)(H602_000001 TRUE)(H602_000002 TRUE)(H602_000003 TRUE)(H602_000004 TRUE)(H602_000005 TRUE)(H602_000006 TRUE)(H602_000007 TRUE)(H602_000008 TRUE)(H602_000009 TRUE)(H602_000010 TRUE)(H602_000011 TRUE)(H602_000012 TRUE)(H602_000013 TRUE)(H602_000014 TRUE)(H602_000015 TRUE)(H602_000016 TRUE)(H602_000017 TRUE)(H602_000018 TRUE)(H602_000019 TRUE)(H602_000020 TRUE)(H602_000021 TRUE)(H602_000022 TRUE)(H602_000023 TRUE)(H602_000024 TRUE)(H602_000025 TRUE)(H602_000026 TRUE)(H602_000027 TRUE)(H602_000028 TRUE)(H602_000029 TRUE)(H602_000030 TRUE)(H602_000031 TRUE)(H602_000032 TRUE)(H603_000001 TRUE)(H603_000002 TRUE)(H603_000003 TRUE)(H603_000004 TRUE)(H603_000005 TRUE)(H603_000006 TRUE)(H603_000007 TRUE)(H603_000008 TRUE)(H603_000009 TRUE)(H603_000010 TRUE)(H603_000011 TRUE)(H603_000012 TRUE)(H603_000013 TRUE)(H603_000014 TRUE)(H603_000015 TRUE)(H603_000016 TRUE)(H603_000017 TRUE)(H603_000018 TRUE)(H603_000019 TRUE)(H603_000020 TRUE)(H603_000021 TRUE)(H603_000021 FALSE)(H603_000022 TRUE)(H603_000022 FALSE)(H603_000023 TRUE)(H603_000023 FALSE)(H603_000024 TRUE)(H603_000024 FALSE)(H603_000025 TRUE)(H603_000025 FALSE)(H603_000026 TRUE)(H603_000026 FALSE)(H603_000027 TRUE)(H603_000027 FALSE)(H603_000028 TRUE)(H603_000028 FALSE)(H603_000029 TRUE)(H603_000029 FALSE)(H603_000030 TRUE)(H603_000030 FALSE)(H603_000031 TRUE)(H603_000031 FALSE)(H603_000032 TRUE)(H603_000032 FALSE))

 

I want to calulate foreach Location the percentage of the amount of TRUE values and store this in a new List e.g.:
 

((H601 100) (H602 83) (H603 51))

 

What is the best approach for this?

 

Posted (edited)

probably could do this easier with lambda but this gets the job done.

 

(defun LIST-COUNT (lst match / lst-match result)
  (vl-load-com)
  (foreach x lst                                                              ;for each item in list
    (if (eq (vl-symbol-name (cadr x)) match)                                  ;if 2nd item in mini list match what your looking for
      (setq lst-match (cons (substr (vl-symbol-name (car x)) 1 4) lst-match)) ;add first item in mini list first 4 letters to a new list
    )
  )
  (foreach x lst-match                                                        ;step thought each match and count them
    (setq Result
      (if (setq Item (assoc x Result))                                        ;if match is in results list
        (subst (cons x (1+ (cdr Item))) Item Result)                          ;1+ to the count
        (cons (cons x 1) Result)                                              ;add new item to the results list with a count of 1
      )
    )
  )
  Result
)

 

Results

(list-count list-name "TRUE")
(("H601" . 32) ("H602" . 32) ("H603" . 32))

(list-count list-name "FALSE")
(("H603" . 12))

 

--edit

O you want whats the % off true in the list. will take a little more calculations one sec.

Edited by mhupp
  • Like 1
Posted (edited)

This will get your %

 

(defun LIST% (lst find / x a b lst-match lst-base item base match result)
  (vl-load-com)
  (foreach x lst                                                              
    (setq lst-base (cons (substr (vl-symbol-name (car x)) 1 4) lst-base))     
  )
  (foreach x lst                                                              
    (if (eq (vl-symbol-name (cadr x)) find)                                  
      (setq lst-match (cons (substr (vl-symbol-name (car x)) 1 4) lst-match)) 
    )
  )
  (foreach x lst-base                                                       
    (setq base
      (if (setq item (assoc x base))                                        
        (subst (cons x (1+ (cdr item))) item base)                          
        (cons (cons x 1) base)                                              
      )
    )
  )
  (foreach x lst-match                                                       
    (setq match
      (if (setq item (assoc x match))                                        
        (subst (cons x (1+ (cdr item))) item match)                          
        (cons (cons x 1) match)                                              
      )
    )
  )
  (foreach x base       
    (setq a (car x))
    (setq b (atof (rtos (cdr x) 2 1))) ;better way?          
    (setq result
      (if (setq item (assoc a match))                        
        (cons (cons a (fix (* (/ (cdr item) b) 100))) result)
      )
    )
  )
  (reverse result)
)

 

results

(LIST% list-name "TRUE")
(("H603" . 72) ("H602" . 100) ("H601" . 100))

 

--edit

0% won't show

Edited by mhupp
Posted

Thanx man, this works!

 

I have changed the code a bit because I got an error on "vl-symbol-name" and (substr (vl-symbol-name (car x)) 1 4) is not always 4, but there is always an underscore in the string
 

(defun SplitStr ( s d / p )
    (if (setq p (vl-string-search d s))
    (cons (substr s 1 p) (SplitStr (substr s (+ p 1 (strlen d))) d))
    (list s)
    )
)

(defun classify (lst find / x int a b lst-match lst-base item base match result)
  (vl-load-com)
  (foreach x lst
    (setq lst-base (cons (car (SplitStr (car x) "_")) lst-base))     
  )
  (foreach x lst                                                              
    (if (eq (cadr x) find)                                  
      (setq lst-match (cons (car (SplitStr (car x) "_")) lst-match)) 
    )
  )
  (foreach x lst-base                                                       
    (setq base
      (if (setq item (assoc x base))                                        
        (subst (cons x (1+ (cdr item))) item base)                          
        (cons (cons x 1) base)                                              
      )
    )
  )
  (foreach x lst-match                                                       
    (setq match
      (if (setq item (assoc x match))                                        
        (subst (cons x (1+ (cdr item))) item match)                          
        (cons (cons x 1) match)                                              
      )
    )
  )
  (foreach x base       
    (setq a (car x))
    (setq b (atof (rtos (cdr x) 2 1))) ;better way?          
    (setq result
      (if (setq item (assoc a match))                        
        (cons (cons a (fix (* (/ (cdr item) b) 100))) result)
      )
    )
  )
  (reverse result)
)

 

  • Like 1
Posted

Nice Mhupp was looking for (vl-symbol-name (car x)) not sure why list is not (("H601_000001" "TRUE")("H601_000002" "TRUE")

 

I am looking at different method sorting all in list and count duplicates, used this in up to 5 items in each sub list.

 

Like lots of testing not behaving but in full code works perfect. 

 

Gsc nice to know about "_" will include if get working.

 

 

  • Agree 1
Posted
17 hours ago, gsc said:

Thanx man, this works!

 

I have changed the code a bit because I got an error on "vl-symbol-name" and (substr (vl-symbol-name (car x)) 1 4) is not always 4, but there is always an underscore in the string

 

 

1. Yeah like BIGAL said your list wasn't strings so had to use vl-symbol-name for it to work for me.

2. about not always being 4 long but having a underscore updated code to trim right of underscore.

 

(defun LIST% (lst find / x a b lst-match item base match result)
  (vl-load-com)
  (foreach x lst
    (setq x (cons (vl-string-right-trim "_" (car x)) lst-base))
    (if (setq item (assoc x base))
      (subst (cons x (1+ (cdr item))) item base)
      (cons (cons x 1) base)
    )
  )
  (foreach x lst
    (if (eq (cadr x) find)
      (setq lst-match (cons (vl-string-right-trim "_" (car x)) lst-match))
    )
  )
  (foreach x lst-match
    (setq match
      (if (setq item (assoc x match))
        (subst (cons x (1+ (cdr item))) item match)
        (cons (cons x 1) match)
      )
    )
  )
  (foreach x base
    (setq a (car x))
    (setq b (atof (rtos (cdr x) 2 1)))  ;better way?
    (setq result
      (if (setq item (assoc a match))
        (cons (cons a (fix (* (/ (cdr item) b) 100))) result)
      )
    )
  )
  (reverse result)
)

 

Posted

Yeah sorry, I just typed a list but forgot they are both string elements
@mhupp like your update, more efficient

I have one other issue. There is no result if all ID's of 1 location are FALSE
Then the percentage should be 0
I solved this with below code....is there a better way to do this?

 

  (foreach x base       
    (setq a (car x))
    (setq b (atof (rtos (cdr x) 2 1))) ;better way?          
    (setq result
      (if (setq item (assoc a match))                        
        (progn 
            (cons (cons a (fix (* (/ (cdr item) b) 100))) result)
        ) ;added a progn!
        (cons (cons a 0) result) ;added this line!
      )
    )
  )
  (reverse result)

 

  • Like 1
Posted

looks good but progn isn't needed unless you are running multiple lines of code

 

(setq result
      (if (setq item (assoc a match))                        
        (cons (cons a (fix (* (/ (cdr item) b) 100))) result)
        (cons (cons a 0) result) ;added this line!
      )
)

 

Posted

Maybe something like this?

(defun f ( l / n r y )
    (foreach x l
        (setq n (if (= "true" (strcase (cadr x) t)) 1 0)
              x (car x)
        )
        (if (setq y (vl-some '(lambda ( y ) (if (wcmatch x (strcat (car y) "*")) y)) r))
            (setq r (subst (list (car y) (+ n (cadr y)) (1+ (caddr y))) y r))
            (setq r (cons  (list (substr x 1 (vl-string-position 95 x)) n 1.0) r))
        )
    )
    (mapcar '(lambda ( x ) (list (car x) (apply '/ (cdr x)))) r)
)
_$ (f lst)
(("H603" 0.727273) ("H602" 1.0) ("H601" 1.0))

 

  • Like 3
Posted

(╯°□°)╯︵ ┻━┻    No really I'm in aw hopefully one day ill get there.

 

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...