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

0 Members and 1 Guest are viewing this topic.

JohnK

  • Administrator
  • Seagull
  • Posts: 10140
[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 8) (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

  • Newt
  • Posts: 110
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.   (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

  • Seagull
  • Posts: 12696
  • London, England
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))

Lee Mac

  • Seagull
  • Posts: 12696
  • London, England
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.       (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
« Last Edit: February 25, 2022, 01:00:36 AM by pBe »

Lee Mac

  • Seagull
  • Posts: 12696
  • London, England
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!

JohnK

  • Administrator
  • Seagull
  • Posts: 10140
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

JohnK

  • Administrator
  • Seagull
  • Posts: 10140
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

JohnK

  • Administrator
  • Seagull
  • Posts: 10140
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

  • Newt
  • Posts: 110
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!) :-D

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.