Topic: Auditing a list of numerical string atoms

[David Bethel]

Good morning,

Dealing with items number bubble identifiers

I'm looking to audit a list of string values that :

• Should always be a string containing a positve INTeger
• Can have duplicate atoms in the list
• The order does not matter

Code: [Select]

(setq nl '("12" "13" "14" "1" "3" "4" "6" "7" "2" "8" "9" "10" "16" "17" "18" "22" "24" "26" "27" "20" "21" "19" "23" "15" "29" "34" "35" "36" "37" "29" "31" "32" "33" "30" "38" "39" "40" "41" "42" "43" "49" "44" "45" "46" "47" "48" "50" "50" "48" "5" "25" "28"))

I am looking to report :

•   Any if any of the atoms are strings that are not a positive INTeger
•   Any missing numbers in the sequence from the list's minimum value to the list's maximum value
•   Any number that is duplicated in the list ( the qty of duplicates is not important )
•   Any other info you can think of that would be helpful in finding errors or omissions

*** ( In Plain AutoLisp )

So far :

Code - Auto/Visual Lisp: [Select]

1. (defun anum (nl / il minn maxn i ml dl)
2.  
3. (setq il (mapcar 'atoi nl)
4.     minn (apply 'min il)
5.     maxn (apply 'max il)
6.        i minn)
7.  
8. (while (<= i maxn)
9.        (cond ((not (member i il))
10.               (setq ml (cons i ml)))
11.              ((and (member i (cdr (member i il)))
12.                    (not (member i dl)))
13.               (setq dl (cons i dl))))
14.        (setq i (1+ i)))
15.  
16. (princ "\nDuplicates : ")
17. (prin1 dl)
18. (princ "\nMissing : ")
19. (prin1 ml)
20. (prin1))
21.  

(member (member))  is a horrible test
I don't think (atoi) will return an error that can be captured

 Any suggestions to make this more robust ?

TIA  -David

[Grrr1337]

Hi David,

For the first report task:

Code - Auto/Visual Lisp: [Select]

1. _$ (mapcar
2.   '(lambda (x / n) (setq n (read x)) (or (minusp n) (eq 'REAL (type n))))
3.   '("1.1" "2" "3" "4" "5.6" "-6")
4. )
5. (T nil nil nil T T)
6. _$

For the second report task:
Use these:

Code - Auto/Visual Lisp: [Select]

1. (defun FindDifference ( nl / n L )
2.   (setq n 0)
3.   (repeat (fix (apply 'max (mapcar 'read nl)))
4.     (setq L (cons (itoa (setq n (1+ n))) L))
5.   )
6.   ; Start comparing:
7.   (LM:ListDifference
8.     (setq L (acad_strlsort L))
9.     (setq nl (acad_strlsort nl))
10.   )
11. ); defun FindDifference
12.  
13. ;; List Duplicates  -  Lee Mac
14. ;; Returns a list of items appearing more than once in a supplied list
15.  
16. (defun LM:ListDupes ( l )
17.   (if l
18.     (if (member (car l) (cdr l))
19.       (cons (car l) (LM:ListDupes (vl-remove (car l) (cdr l))))
20.       (LM:ListDupes (vl-remove (car l) (cdr l)))
21.     )
22.   )
23. )
24.  
25. ;;-------------------=={ List Difference }==------------------;;
26. ;;                                                            ;;
27. ;;  Returns items appearing exclusively in one list but not   ;;
28. ;;  another, i.e. the relative complement: l1 \ l2            ;;
29. ;;------------------------------------------------------------;;
30. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
31. ;;------------------------------------------------------------;;
32. ;;  Arguments:                                                ;;
33. ;;  l1,l2 - lists for which to return the difference          ;;
34. ;;------------------------------------------------------------;;
35. ;;  Returns:  List of items appearing exclusively in list l1  ;;
36. ;;------------------------------------------------------------;;
37.  
38. (defun LM:ListDifference ( l1 l2 )
39.   (if l1
40.     (if (member (car l1) l2)
41.       (LM:ListDifference (cdr l1) l2)
42.       (cons (car l1) (LM:ListDifference (cdr l1) l2))
43.     )
44.   )
45. )

Result:

Code - Auto/Visual Lisp: [Select]

1. (setq nl
2.   '("12" "13" "14" "1" "3" "4" "6" "7" "2" "8" "9" "10"
3.     "16" "17" "18" "22" "24" "26" "27" "20" "21" "19" "23"
4.     "15" "29" "34" "35" "36" "37" "29" "31" "32" "33" "30"
5.     "38" "39" "40" "41" "42" "43" "49" "44" "45" "46" "47"
6.     "48" "50" "50" "48" "5" "25" "28"
7.   )
8. )
9. _$ (FindDifference nl)
10. ("11") ; this means that eleven is missing
11. _$ (LM:ListDupes nl)
12. ("29" "48" "50") ; these occur more than once
13. _$

[David Bethel]

Thanks Grrr

I'll take  look, but I don't have access to any vl-  type calls, only plain autolisp.

-David

[Grrr1337]

Oops, sorry David!
I did not notice that LM:ListDupes uses (vl-remove) - my other thought is to create unique item counter, which should do something like:

Code: [Select]

'("A" "B" "C" "D" "D" "A") -> '(("A" . 2) ("B" . 1) ("C" . 1) ("D" . 2))And by that way the duplicates can be found.

[roy_043]

To check for 'pos. int string':

Code: [Select]

(wcmatch str "~*[~0-9]*")
You should do this before using atoi as that function will always return an integer.

[CAB]

A different approach, return numbers though

Code: [Select]

(defun anum (lst / lastitm neg missing)
  (foreach itm (vl-sort (mapcar 'atoi lst) '>)
    (cond
      ((minusp itm) (setq neg (cons itm neg)))
      ((null lastitm) (setq lastitm itm))
      (t (if (/= (1- lastitm) itm)
           (progn (while (/= (1- lastitm) itm)
             (setq missing (cons (1- lastitm) missing)
                 lastitm (1- lastitm)))(setq lastitm (1- lastitm)))
           (setq lastitm itm)
         )
       )
    )
  )
  (list neg missing)
)

[David Bethel]

A different approach, return numbers though

That is a bit different.  I'll have to dig into it.  I do roll your own sort routines so that's not a problem

Thanks All !  -David

[Lee Mac]

This avoids the (member (member)), but it's not particularly pretty:

Code - Auto/Visual Lisp: [Select]

1. (defun checklist ( lst / dun dup int inv mim mis mxm )
2.     (foreach itm lst
3.         (if (wcmatch itm "*[~0-9]*")
4.             (or (member itm inv) (setq inv (cons itm inv)))
5.             (setq int (cons itm int))
6.         )
7.     )
8.     (setq int (mapcar 'atoi int)
9.           mxm (apply  'max  int)
10.           mim (apply  'min  int)
11.     )
12.     (foreach itm int
13.         (and (<= mim mxm)
14.              (or (member mxm int)
15.                  (setq mis (cons (itoa mxm) mis))
16.              )
17.              (setq mxm (1- mxm))
18.         )
19.         (or (and (member itm dun)
20.                  (or (member (itoa itm) dup)
21.                      (setq dup (cons (itoa itm) dup))
22.                  )
23.             )
24.             (setq dun (cons itm dun))
25.         )
26.     )
27.     (while (<= mim mxm)
28.         (or (member mxm int)
29.             (setq mis (cons (itoa mxm) mis))
30.         )
31.         (setq mxm (1- mxm))
32.     )
33.     (princ "\nInvalid items: ")
34.     (prin1 inv)
35.     (princ "\nMissing items: ")
36.     (prin1 mis)
37.     (princ "\nDuplicate items: ")
38.     (prin1 dup)
39.     (princ)
40. )

[David Bethel]

I was heading towards adding a bad list also.

The list is normally less than 100 atoms so I guess (member) testing is not all that bad.

It does seem that there should be a simple solution.  But here accuracy is going to rule.  Thanks!  _David

[ronjonp]

..
The list is normally less than 100 atoms so I guess (member) testing is not all that bad.
..

You don't need to worry about performance then .. go for your own readability

[CAB]

Had a few minutes to make another run at this one with Gile's Sort

Code - Auto/Visual Lisp: [Select]

1. ;;;=============================================================
2. ;;;Gile's Insert Sort                                          
3. ;;;=============================================================
4. (defun G:InsertSort (lst / insert)
5.  
6.   (defun insert    (ele lst)
7.     (cond
8.       ((null lst) (list ele))
9.       ((> ele (car lst)) (cons ele lst))
10.       ((cons (car lst) (insert ele (cdr lst))))
11.     )
12.   )
13.  
14.   (if lst
15.     (insert (car lst) (G:InsertSort (cdr lst)))
16.   )
17. )
18.  
19.  
20.  
21. (defun anum (lst / lastitm neg missing doup)
22.   (foreach itm (G:InsertSort (mapcar 'atoi lst))
23.     (cond
24.       ((minusp itm) (setq neg (cons itm neg)))
25.       ((null lastitm) (setq lastitm itm))
26.       ((= lastitm itm) ; douplicates
27.            (setq doup (cons lastitm doup)
28.                  lastitm itm)
29.        )
30.       ((if (/= (1- lastitm) itm) ; missing from list
31.            (progn (while (/= (1- lastitm) itm)
32.              (setq missing (cons (1- lastitm) missing)
33.                  lastitm (1- lastitm)))(setq lastitm (1- lastitm)))
34.            (setq lastitm itm)
35.          )
36.        )
37.     )
38.   )
39.   (list neg missing doup)
40. )

[Lee Mac]

I like your method Alan - here is another variation, using the same process:

Code - Auto/Visual Lisp: [Select]

1. (defun checklist ( l / d i m r )
2.     (foreach x l
3.         (if (wcmatch x "*[~0-9]*")
4.             (or (member x i) (setq i (cons x i)))
5.             (setq r (cons (atoi x) r))
6.         )
7.     )
8.     (mapcar
9.        '(lambda ( a b )
10.             (cond
11.                 (   (= a b) (or (member (itoa a) d) (setq d (cons (itoa a) d))))
12.                 (   (< 1 (- b a))
13.                     (while (< (setq a (1+ a)) b) (setq m (cons (itoa a) m)))
14.                 )
15.             )
16.         )
17.         (setq r (qs r)) (cdr r)
18.     )
19.     (princ "\nInvalid items: ")
20.     (prin1 i)
21.     (princ "\nMissing items: ")
22.     (prin1 m)
23.     (princ "\nDuplicate items: ")
24.     (prin1 d)
25.     (princ)
26. )
27. (defun qs ( l )
28.     (   (lambda ( f ) (if l (f (car l) (cdr l))))
29.         (lambda ( x l / a b )
30.             (foreach y l
31.                 (if (< y x)
32.                     (setq a (cons y a))
33.                     (setq b (cons y b))
34.                 )
35.             )
36.             (append (qs a) (cons x (qs b)))
37.         )
38.     )
39. )
40. (princ)

[David Bethel]

Code: [Select]

(defun qs ( l )
    (   (lambda ( f ) (if l (f (car l) (cdr l))))
        (lambda ( x l / a b )
            (foreach y l
                (if (< y x)
                    (setq a (cons y a))
                    (setq b (cons y b))
                )
            )
            (append (qs a) (cons x (qs b)))
        )
    )
)


I must admit, that is 1 of the simplest sorting functions I've seen.  Nice

Thanks!  -David

[Lee Mac]

Thanks David! 

[CAB]

Nice job Lee