Topic: [challenge] A28 : Ascending range lists

[JohnK]

Your challenge is to create a function that takes an *unsorted* (-i.e. not in ascending or distending order) list of integers and returns a list of lists of ascending ranges.

NOTE:
- This task can be done without "sorting" the initial list. -i.e. there is no need to use "sort '<" to complete this task.

(range-lists '(22 4 15 3 14 1 9 16 2 21 23))
> ((1 4) (9) (14 16) (21 23))

Explanation:
        (22 4 15 3 14 1 9 16 2 21 23)                        ; [initial] input
        => ((1 2 3 4) (9) (14 15 16) (21 22 23))        ; [intermediate] list of lists of int ranges
        => ((1 4) (9) (14 16) (21 23))                       ; [final] output

(range-lists '(1 3 2 6 0 8 -1 7 10 12 14 15 30 18 19 21 23 22 4 -5 31 32 33 40 35 39 42 43 44 45))
> ((-5) (-1 4) (6 (10) (12) (14 15) (18 19) (21 23) (30 33) (35) (39 40) (42 45))

NOTE:
- Reversing the list back from final output to intermediate phase should be an easy task.

[kirby]

Not the prettiest code...

Code - Auto/Visual Lisp: [Select]

1. (defun C:Test-A28 ( / )
2. ; Test function for 'range-lists-kirby'
3.  
4. ;(setq MyList (list 22 4 15 3 14 1 9 16 2 21 23))
5. (setq MyList (list 1 3 2 6 0 8 -1 7 10 12 14 15 30 18 19 21 23 22 4 -5 31 32 33 40 35 39 42 43 44 45))
6.  
7. (prompt "\nInput List = ")(princ MyList)(princ)
8.  
9. (setq Ans (range-lists-kirby MyList 1))
10.  
11. (prompt "\n  Ans = ")(princ Ans)(princ)
12. )
13.  
14.  
15.  
16. (defun range-lists-kirby (MyList Verbose /
17.                         OutList1 OutList2 OutList3 CNT1 CNT2 k1 k2 MyItem MyMin LastVal NextVal Found
18.                         )
19. ; Challenge A28 : Ascending range lists, no sorting allowed!
20. ; Input:
21. ;       MyList - (list) an unsorted simple (un-nested) list of integers.  Assume no duplicates.
22. ;       Verbose - (integer) code 0 or nil = supress feedback, 1 = show additional debugging deefback
23. ; Returns:
24. ;       list of lists, grouped into sublists in ascending order
25. ; Uses custom routines
26. ;       none!
27.  
28.  
29. ; default
30. (if (eq Verbose nil) (setq Verbose 0))
31.  
32.  
33. (setq OutList1 nil)
34. (setq OutList2 nil)
35.  
36. (if MyList
37.   (progn
38.         ; Report
39.         (if (eq Verbose 1)
40.           (progn
41.                 (prompt "\n  Initial List = ")(princ MyList)(princ)
42.           )
43.         )
44.  
45.         ; Find minimum and maximum
46.         (setq MyMin (nth 0 MyList))
47.         (setq MyMax MyMin)
48.        
49.         (setq CNT1 0)
50.         (repeat (length MyList)
51.                 (setq MyItem (nth CNT1 MyList))
52.                
53.                 (if (< MyItem MyMin)
54.                         (setq MyMin MyItem)
55.                 )      
56.  
57.                 (if (> MyItem MyMax)
58.                         (setq MyMax MyItem)
59.                 )      
60.  
61.  
62.                 (setq CNT1 (1+ CNT1))
63.         ) ; close repeat       
64.        
65.         ; Report
66.         (if (eq Verbose 1)
67.           (progn
68.                 (prompt "\n  Minumum Value = ")(princ MyMin)(prompt "  Maximum Value = ")(princ MyMax)(princ)
69.           )
70.         )
71.        
72.         ; Outer loop to find adjacent values in list
73.         (setq LastVal MyMin)                            ; initialize current value
74.         (setq OutList1 (cons LastVal OutList1))         ; initialize inner list
75.        
76.         (setq k1 1)
77.         (while k1
78.  
79.                 (setq NextVal (1+ LastVal))     ; next / adjacent value
80.  
81.                 (if (eq Verbose 1)
82.                   (progn
83.                         (prompt "\n  Searching for ")(princ NextVal)(princ)
84.                   )    
85.                 )
86.                
87.                 ; Inner loop to search list for next value
88.                 (setq CNT2 0)
89.                 (setq Found 0)
90.                 (setq k2 1)
91.                 (while k2
92.                         (setq MyItem (nth CNT2 MyList))
93.                         (if (eq MyItem NextVal)
94.                           (progn
95.                                 (setq OutList1 (cons MyItem OutList1))  ; add to 'inner' list
96.                                 (setq Found 1)                          ; tag as found
97.                                 (setq LastVal MyItem)                   ; reset search value   
98.  
99.                                 (if (eq Verbose 1)
100.                                   (progn
101.                                         (prompt "    <Found at position ")(princ CNT2)(prompt " >")(princ)
102.                                   )    
103.                                 )
104.  
105.                                 (setq k2 nil)                           ; stop loop
106.                           )
107.                         ) ; close if
108.        
109.                         (setq CNT2 (1+ CNT2))
110.  
111.                         (if (>= CNT2 (length MyList))
112.                                 (setq k2 nil)   ; out of data, stop loop
113.                         )
114.  
115.                 ) ; close while
116.        
117.                 ; Next value not found or reached maximum, build 'outer' output list
118.                 (if (or (eq Found 0) (eq NextVal MyMax))
119.                   (progn
120.                         (if (eq Verbose 1)
121.                           (progn
122.                                 (prompt "    <Not found>  Restarting search")
123.                           )    
124.                         )
125.                        
126.                         (setq LastVal NextVal)          ; reset last value
127.                        
128.                         (if OutList1
129.                           (progn
130.                                 (setq OutList2 (cons (reverse OutList1) OutList2))      ; build 'outer' list
131.                                 (setq OutList1 nil)                                     ; reset 'inner' list
132.                           )
133.                         )
134.                   )
135.                 ) ; close if
136.        
137.                
138.                 (if (>= LastVal MyMax)
139.                         (setq k1 nil)   ; out of data, stop loop
140.                 )
141.        
142.         ) ; close while
143.         (setq OutList2 (reverse OutList2))
144.  
145.         ; Report
146.         (if (eq Verbose 1)
147.           (progn
148.                 (prompt "\n  Intermediate List = ")(princ OutList2)(princ)
149.           )
150.         )
151.  
152.        
153.         (setq OutList3 nil)
154.  
155.         ; Weed interior values from each sublist
156.         (setq CNT1 0)
157.         (repeat (length OutList2)
158.                 (setq MyItem (nth CNT1 OutList2))
159.                 (if (member (length MyItem) (list 1 2))
160.                         (setq OutList1 MyItem)
161.                         (setq OutList1 (list (car MyItem) (nth (1- (length MyItem)) MyItem)))
162.                 )
163.                
164.                 (setq OutList3 (cons OutList1 OutList3))
165.                
166.                 (setq CNT1 (1+ CNT1))
167.         ) ; close repeat       
168.        
169.         (setq OutList3 (reverse OutList3))
170.  
171.         ; Report
172.         (if (eq Verbose 1)
173.           (progn       
174.                 (prompt "\n  Final List = ")(princ OutList3)(princ)
175.           )
176.         )
177.        
178.   )
179. ) ; close if
180.  
181. OutList3
182. )
183.  
184.  
185.  
186.  

[Lee Mac]

Good challenge - very similar to this thread (though, my solutions in that thread do involve sorting).

Here's my first attempt -

Code - Auto/Visual Lisp: [Select]

1. (defun ranges ( l / m n r x y )
2.     (repeat (- (setq m (apply 'max l)) (apply 'min l) -1)
3.         (setq x (cons m x)
4.               m (1- m)
5.         )
6.     )
7.     (while x
8.         (setq y (car x)
9.               x (cdr x)
10.               n nil
11.         )
12.         (while (and x (member (car x) l)) (setq n (car x) x (cdr x)))
13.         (setq r (cons (if n (list y n) (list y)) r))
14.         (while (and x (not (member (car x) l))) (setq x (cdr x)))
15.     )
16.     (reverse r)
17. )

Code - Auto/Visual Lisp: [Select]

1. _$ (ranges '(22 4 15 3 14 1 9 16 2 21 23))
2. ((1 4) (9) (14 16) (21 23))

[Lee Mac]

Actually, this is better -

Code - Auto/Visual Lisp: [Select]

1. (defun ranges ( l / m n r x )
2.     (setq m (apply 'max l)
3.           n (apply 'min l)
4.     )
5.     (while (<= n m)
6.         (setq x n n (1+ n))
7.         (while (member n l) (setq m n n (1+ n)))
8.         (setq r (cons (if m (list x m) (list x)) r))
9.         (while (and (<= n m) (not (member n l))) (setq n (1+ n)))
10.     )
11.     r
12. )

[pBe]

Oops I did it again.
As I was reading through the "Challenges", I came across this
"anything that starts with VL--is not allowed and would be disqualified.

Code - Auto/Visual Lisp: [Select]

1. (defun ranges   (l / a n)
2.   (if l
3.     (Cons
4.       (progn
5.         (Setq a (list (apply 'min l))
6.               l (vl-remove (Car a) l)
7.         )
8.         (while (vl-position (setq n (1+ (last a))) l)
9.           (setq a (list (car a) n)
10.                 l (vl-remove n l)
11.           )
12.         )
13.         a
14.       )
15.       (ranges l)
16.     )
17.   )
18. )

A quick rewrite to meet the specifications

Code - Auto/Visual Lisp: [Select]

1. (defun ranges (l / a n)
2.   (or vr  (setq vr (lambda (ls n l)
3.                  (append ls (cdr (member n (reverse l))))
4.                )
5.       )
6.   )
7.   (if l
8.     (Cons
9.       (progn
10.         (Setq a (list (apply 'min l))
11.               l (vr (cdr (member (car a) l)) (car a) l)
12.         )
13.         (while (setq f (member (setq n (1+ (last a))) l))
14.           (setq a (list (car a) n) l (vr (cdr f) n l))
15.                 )
16.         a
17.       )
18.       (ranges l)
19.     )
20.   )
21. )

Actually, this is better -

Code - Auto/Visual Lisp: [Select]

1.         (setq r (cons (if m (list x m) (list x) r)));<-- misplaced parenthesis here

It's really nice LM

[Lee Mac]

Actually, this is better -

Code - Auto/Visual Lisp: [Select]

1.         (setq r (cons (if m (list x m) (list x) r)));<-- misplaced parenthesis here

It's really nice LM

Thanks Patrick - not quite sure how that slipped through!

[JohnK]

mine:

Code - Auto/Visual Lisp: [Select]

1. (defun range-lists (lst / cntr alst tmp m
2.                          min? max? find-range
3.                          )
4.      (defun min? (lst)  (apply 'min lst))
5.      (defun max? (lst) (apply 'max lst))
6.      (defun find-range (lst x / cntr alst)
7.        (setq cntr 0)
8.        (while (member (+ x cntr) lst)
9.               (setq alst (cons (+ x cntr) alst)
10.                     cntr (1+ cntr)))
11.        (reverse alst)
12.        )
13.   (setq cntr (min? lst)
14.         m (max? lst))
15.   (while (< cntr m)
16.          (cond
17.            ((not (null (setq tmp (find-range lst cntr))))
18.             (setq alst (cons
19.                          (if (cdr tmp)
20.                            (list (car tmp) (last tmp))
21.                            tmp)
22. ;; ~:                           tmp
23.                          alst)
24.                   cntr (+ (last tmp) 2)))
25.            (T (setq cntr (1+ cntr))))
26.          )
27.   (reverse alst)
28.   )

[JohnK]

Not the prettiest code...
---->%

@Kirby
If I haven't said so already, I really like your notes/submissions; they drip with professionalism!

[JohnK]

Good challenge - very similar to this thread (though, my solutions in that thread do involve sorting).
--->%

Thanks. I did not see that thread; I am so busy doing things here, work, and at home I do not get to see/comment on threads as much as I would like.

Sorting is typically expensive and it should be the programmers first reaction to avoid using it if possible but unfortunately sorting seems to be the first thing most AutoLisp programmers do.

[kirby]

...they drip with professionalism!

(rather be called a drip than a wet blanket!)

Thanks, I try to format code so that I'll understand it in 10 years, and that my coworkers can understand/modify/debug.  It just means that its 3x longer than anyone else's code.