### Author Topic: [challenge] A28 : Ascending range lists  (Read 739 times)

0 Members and 1 Guest are viewing this topic. ##### [challenge] A28 : Ascending range lists
« on: February 24, 2022, 01:15:35 PM »
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.
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

#### kirby ##### Re: [challenge] A28 : Ascending range lists
« Reply #1 on: February 24, 2022, 03:40:01 PM »
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.         ; Report
38.         (if (eq Verbose 1)
39.                 (prompt "\n  Initial List = ")(princ MyList)(princ)
40.           )
41.         )
42.
43.         ; Find minimum and maximum
44.         (setq MyMin (nth 0 MyList))
45.         (setq MyMax MyMin)
46.
47.         (setq CNT1 0)
48.         (repeat (length MyList)
49.                 (setq MyItem (nth CNT1 MyList))
50.
51.                 (if (< MyItem MyMin)
52.                         (setq MyMin MyItem)
53.                 )
54.
55.                 (if (> MyItem MyMax)
56.                         (setq MyMax MyItem)
57.                 )
58.
59.
60.                 (setq CNT1 (1+ CNT1))
61.         ) ; close repeat
62.
63.         ; Report
64.         (if (eq Verbose 1)
65.                 (prompt "\n  Minumum Value = ")(princ MyMin)(prompt "  Maximum Value = ")(princ MyMax)(princ)
66.           )
67.         )
68.
69.         ; Outer loop to find adjacent values in list
70.         (setq LastVal MyMin)                            ; initialize current value
71.         (setq OutList1 (cons LastVal OutList1))         ; initialize inner list
72.
73.         (setq k1 1)
74.         (while k1
75.
76.                 (setq NextVal (1+ LastVal))     ; next / adjacent value
77.
78.                 (if (eq Verbose 1)
79.                         (prompt "\n  Searching for ")(princ NextVal)(princ)
80.                   )
81.                 )
82.
83.                 ; Inner loop to search list for next value
84.                 (setq CNT2 0)
85.                 (setq Found 0)
86.                 (setq k2 1)
87.                 (while k2
88.                         (setq MyItem (nth CNT2 MyList))
89.                         (if (eq MyItem NextVal)
90.                                 (setq OutList1 (cons MyItem OutList1))  ; add to 'inner' list
91.                                 (setq Found 1)                          ; tag as found
92.                                 (setq LastVal MyItem)                   ; reset search value
93.
94.                                 (if (eq Verbose 1)
95.                                         (prompt "    <Found at position ")(princ CNT2)(prompt " >")(princ)
96.                                   )
97.                                 )
98.
99.                                 (setq k2 nil)                           ; stop loop
100.                           )
101.                         ) ; close if
102.
103.                         (setq CNT2 (1+ CNT2))
104.
105.                         (if (>= CNT2 (length MyList))
106.                                 (setq k2 nil)   ; out of data, stop loop
107.                         )
108.
109.                 ) ; close while
110.
111.                 ; Next value not found or reached maximum, build 'outer' output list
112.                 (if (or (eq Found 0) (eq NextVal MyMax))
113.                         (if (eq Verbose 1)
115.                           )
116.                         )
117.
118.                         (setq LastVal NextVal)          ; reset last value
119.
120.                         (if OutList1
121.                                 (setq OutList2 (cons (reverse OutList1) OutList2))      ; build 'outer' list
122.                                 (setq OutList1 nil)                                     ; reset 'inner' list
123.                           )
124.                         )
125.                   )
126.                 ) ; close if
127.
128.
129.                 (if (>= LastVal MyMax)
130.                         (setq k1 nil)   ; out of data, stop loop
131.                 )
132.
133.         ) ; close while
134.         (setq OutList2 (reverse OutList2))
135.
136.         ; Report
137.         (if (eq Verbose 1)
138.                 (prompt "\n  Intermediate List = ")(princ OutList2)(princ)
139.           )
140.         )
141.
142.
143.         (setq OutList3 nil)
144.
145.         ; Weed interior values from each sublist
146.         (setq CNT1 0)
147.         (repeat (length OutList2)
148.                 (setq MyItem (nth CNT1 OutList2))
149.                 (if (member (length MyItem) (list 1 2))
150.                         (setq OutList1 MyItem)
151.                         (setq OutList1 (list (car MyItem) (nth (1- (length MyItem)) MyItem)))
152.                 )
153.
154.                 (setq OutList3 (cons OutList1 OutList3))
155.
156.                 (setq CNT1 (1+ CNT1))
157.         ) ; close repeat
158.
159.         (setq OutList3 (reverse OutList3))
160.
161.         ; Report
162.         (if (eq Verbose 1)
163.                 (prompt "\n  Final List = ")(princ OutList3)(princ)
164.           )
165.         )
166.
167.   )
168. ) ; close if
169.
170. OutList3
171. )
172.
173.
174.
175. ##### Re: [challenge] A28 : Ascending range lists
« Reply #2 on: February 24, 2022, 06:38:31 PM »
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)) ##### Re: [challenge] A28 : Ascending range lists
« Reply #3 on: February 24, 2022, 06:45:39 PM »
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. )
« Last Edit: February 25, 2022, 06:05:17 AM by Lee Mac »

#### pBe

• Bull Frog
• Posts: 401 ##### Re: [challenge] A28 : Ascending range lists
« Reply #4 on: February 24, 2022, 08:34:56 PM »
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.         (Setq a (list (apply 'min l))
5.               l (vl-remove (Car a) l)
6.         )
7.         (while (vl-position (setq n (1+ (last a))) l)
8.           (setq a (list (car a) n)
9.                 l (vl-remove n l)
10.           )
11.         )
12.         a
13.       )
14.       (ranges l)
15.     )
16.   )
17. )

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.         (Setq a (list (apply 'min l))
10.               l (vr (cdr (member (car a) l)) (car a) l)
11.         )
12.         (while (setq f (member (setq n (1+ (last a))) l))
13.           (setq a (list (car a) n) l (vr (cdr f) n l))
14.                 )
15.         a
16.       )
17.       (ranges l)
18.     )
19.   )
20. )
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
« Last Edit: February 25, 2022, 01:00:36 AM by pBe » ##### Re: [challenge] A28 : Ascending range lists
« Reply #5 on: February 25, 2022, 06:05:47 AM »
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! ##### Re: [challenge] A28 : Ascending range lists
« Reply #6 on: February 25, 2022, 07:54:37 AM »
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.   )
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org ##### Re: [challenge] A28 : Ascending range lists
« Reply #7 on: February 25, 2022, 09:09:25 AM »
Not the prettiest code...
---->%
@Kirby
If I haven't said so already, I really like your notes/submissions; they drip with professionalism!
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org ##### Re: [challenge] A28 : Ascending range lists
« Reply #8 on: February 25, 2022, 10:17:55 AM »
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.
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

#### kirby ##### Re: [challenge] A28 : Ascending range lists
« Reply #9 on: February 25, 2022, 01:22:51 PM »
Quote
...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.