Programming Challenge 3/22 - Ranges

[john.uhden]

Your challenge is to create a function that takes an unsorted list of integers, say

'(22 4 15 3 14 1 9 16 2 21 23)

and turn it into an ascending list of ranges, i.e.

'((1 4)(9)(14 16)(21 23))

THEN create a function that turns the ranges into a string, i.e.

"1-4, 9, 14-16, 21-23"

AND THEN create a function that turns the string back into a list of ascendingly sorted integers (not ranges).

<BTW, I hope my examples are correct 'cause i created them only by eye.>

Note that the value of turning the string into a list might be very handy in the context of a dialog by allowing the user to enter ranges of numbers rather than one after another after another (and there might not otherwise be enough room).

Sure, Lee Mac and/or Kent Cooper have probably already published all this, but if you submit their work, they get the credit, not you.  Though imitation is a form of flattery, we would like to see original work.  Besides, yours will be better anyway, right?

[CodeDing · Accepted solution]

@john.uhden ,

Fun!

EDIT (2nd Time):

Ok, code works correctly now!

Sample return (I edited your original list a little bit):

((1 4) (9) (14 16) (21 23) (25 26) (29))
"1-4, 9, 14-16, 21-23, 25-26, 29"
(1 2 3 4 9 14 15 16 21 22 23 25 26 29)

Code:

(defun lst2rng (l / bools pairs ranges)
  (setq l (vl-sort l '<))
  (setq bools (cons nil (mapcar '= (mapcar '1- (cdr l)) l)))
  (foreach x (mapcar 'cons l bools)
    (if (cdr x)
      (setq pairs (cons (car x) pairs))
      (setq ranges (cons pairs ranges) pairs (list (car x)))
    );if
  );foreach
  (if (null (last bools)) (setq ranges (cons pairs ranges)))
  (mapcar
    '(lambda (x)
      (setq len (length x))
      (cond ((< len 3) x) ((list (car x) (last x))))
    );lambda
    (mapcar 'reverse (cdr (reverse ranges)))
  );mapcar
);defun

(defun rng2str (r / stringy)
  (setq r (mapcar '(lambda (x) (mapcar 'itoa x)) r))
  (setq stringy
    (lambda (y)
      (if (> (length y) 1)
        (strcat (car y) "-" (last y))
        (car y)
      );if
    );lambda
  );setq
  (strcat
    (stringy (car r))
    (apply 'strcat (mapcar '(lambda (z) (strcat ", " (stringy z))) (cdr r)))
  );strcat
);defun

(defun str2rng (s / )
  (apply 'append
    (mapcar
      '(lambda (x / tmp first cnt)
        (setq tmp '() first (car x))
        (if (and (> (length x) 1) (> (setq cnt (- (last x) first)) 1))
          (repeat (setq cnt (1+ cnt))
            (setq cnt (1- cnt) tmp (cons (+ first cnt) tmp))
          );repeat
          x
        );if
      );lambda
      (read (strcat "((" (vl-string-translate " -," "( )"  s) "))"))
    );mapcar
  );apply
);defun

(defun c:TEST ( / l r s r2)
  (setq l '(22 1 26 25 29 4 15 3 14 1 9 16 2 21 23))
  (terpri) (print (setq r (lst2rng l)))
  (terpri) (print (setq s (rng2str r)))
  (terpri) (print (setq r2 (str2rng s)))
  (prompt "\nTEST Complete.")
  (princ)
);defun

Best,

~DD

[hak_vz · Accepted solution]

Modified according to @john.uhden updates

(defun hak_vz:to_ranges (lst / a b ret)
	(setq lst(vl-sort lst '<))
	(while lst
		(setq a (car lst) b a lst (cdr lst))
		(while (member (setq b(1+ b)) lst)(setq lst (cdr lst)))
		(setq b (1- b))
		(if (= a b) 
			(setq ret (cons (list a) ret))
			(setq ret (cons (list a b) ret))
		)
	)
	(reverse ret)
)
(defun hak_vz:ranges_to_string (lst / str e)
	(setq str "")
	(while lst
		(setq e (car lst) lst (cdr lst))
		(cond 
			((= (length e) 1)
				(setq str (strcat str "," (itoa (car e))))
			)
			((= (length e) 2)
				(setq str (strcat str "," (itoa (car e))"_"(itoa (cadr e))))
			)
		) 
	)
	(substr str 2)
)
(defun hak_vz:string_to_ranges (str / lst string_to_list a b e ret)
	(defun string_to_list ( str del / pos )
			(if (setq pos (vl-string-search del str))
				(cons (substr str 1 pos) (string_to_list (substr str (+ pos 1 (strlen del))) del))
				(list str)
			)
	)
	(setq lst (string_to_list str ","))
	(while lst
		(setq 
			e (mapcar 'atoi(string_to_list (car lst) "_"))
			lst (cdr lst)
		)
		(cond 
			((= (length e) 1) (setq ret(cons (car e) ret)))
			((= (length e) 2)
				(setq a (1-(car e)) b (cadr e))
				(while (<= (setq a (1+ a)) b) (setq ret(cons a ret)))
			)
		) 
	)
	(reverse ret)
) 

(defun hak_vz:string_to_list(str / lst string_to_list a b e ret)
	(defun string_to_list ( str del / pos )
			(if (setq pos (vl-string-search del str))
				(cons (substr str 1 pos) (string_to_list (substr str (+ pos 1 (strlen del))) del))
				(list str)
			)
	)
	(mapcar 'atoi(apply 'append(mapcar '(lambda (x)(string_to_list x "_")) (string_to_list str ","))))
)



(defun TEST ( l /  r s r2) 
	(terpri) (print l)
	(terpri) (print (setq r (hak_vz:to_ranges l)))
	(terpri) (print (setq s (hak_vz:ranges_to_string r)))
	(terpri) (print (setq r2 (hak_vz:string_to_ranges s)))
	(terpri) (print (setq r3 (hak_vz:string_to_list s)))
	(princ)
)

Command: (test l)
(22 1 26 25 29 4 15 3 14 1 9 16 2 21 23)
((1 4) (9) (14 16) (21 23) (25 26) (29))
"1_4,9,14_16,21_23,25_26,29"
(1 2 3 4 9 14 15 16 21 22 23 25 26 29)
(1 4 9 14 16 21 23 25 26 29)

It can also handle negative ranges and duplicates

Command: (test l)
(10 -8 13 19 -5 16 12 0 2 3 2 4 -6 -9 -10 11 5 7 12)
((-10 -8) (-6 -5) (0) (2 5) (7) (10 13) (16) (19))
"-10_-8,-6_-5,0,2_5,7,10_13,16,19"
(-10 -9 -8 -6 -5 0 2 3 4 5 7 10 11 12 13 16 19)
(-10 -8 -6 -5 0 2 5 7 10 13 16 19)

[john.kaulB9QW2]

Looks sort of fun. I'll see if I can find time to participate.

You shouldn't need to "sort" that initial list to grab the ranges of numbers.

(defun find-range (lst x / cntr alst)
  ;; A simple iterative approach to
  ;; finding a range within an
  ;; unsorted list of ints.
  (setq	cntr 0	alst '())	 ; make sure we have clean variables
  (while (member (+ x cntr) lst) ; member returns nil when a value isnt found.
    (setq alst (cons (+ x cntr) alst))
    (setq cntr (1+ cntr))
  )
  (reverse alst)
)

[john.uhden]

@CodeDing 

I'm sure glad someone is having fun this time around.

Wow, are you fast.  I'm just working my way along verbosely on the first step.  It works, but it's ugly.

I will not read your code until I am done because I want to fail all on my own, thank you.

I guess I wasn't clear.  I would like the string turned back into the complete list, not a list of ranges.

Obviously not the original list, because it was unsorted.

There should be three (3) separate functions.  Don't take these names literally.  Use any names you like...

1.  list->range

2.  range->range_string

3.  range_string->list

If your name is Vinnie Lombardi or Vernon Lund or Vladimir Lupinski, you could prefix them with vl- and make them look official.  😬

[john.uhden]

@john.kaulB9QW2 and @hak_vz ,

As I told @CodeDing , I am not checking or even looking at your code until I have failed on my own.

But that you have responded so rapidly is not only a sign of eagerness and good work but also a sign of fun, I hope.

Fear not.  @Sea-Haven will "borrow" the best of your collective code and present something that doesn't work anyway.  🤕

But it will be sure to blink and squirt water, probably blinking squirts.

[john.uhden · Accepted solution]

I think this will all work.

(defun @list2range (old / item new n n1)
  (setq old (vl-sort old '<))
  (while old
    (setq n (car old))
    (cond
      ((not item)(setq n1 n item (list n1)))
      ((= n (1+ (last item)))(setq item (list n1 n)))
      (item (setq new (cons item new) item (list (setq n1 n))))
      (1 (setq item nil))
    )
    (setq old (cdr old))
  )
  (reverse (if item (cons item new) new))
)

(defun @str2list (str pat / i j n lst)
  ;; This is a special version to handle a simple negative string "-1"
  (cond
    ((/= (type str)(type pat) 'STR))
    ((= str pat)'(""))
    ((wcmatch str (strcat pat "*"))(list str))
    (T
      (setq i 0 n (strlen pat))
      (while (setq j (vl-string-search pat str i))
        (setq lst (cons (substr str (1+ i)(- j i)) lst)
              i (+ j n)
        )
      )
      (reverse (cons (substr str (1+ i)) lst))
    )
  )
)

(defun @range2str (range / str n1 n2)
  (setq str "")
  (foreach item range
    (setq n1 (car item))
    (if (setq n2 (cadr item))
      (setq str (strcat str (itoa n1) "-" (itoa n2) ", "))
      (setq str (strcat str (itoa n1) ", "))
    )
  )
  (vl-string-trim ", " str)
)

(defun @rangestr2list (str / n1 n2 #s)
  (foreach item (reverse (@str2list str ", "))
    (setq n1 nil n2 nil)
    (mapcar 'set '(n1 n2) (mapcar 'atoi (@str2list item "-")))
    (if n2
     (repeat (- n2 n1 -1)(setq #s (cons n2 #s) n2 (1- n2)))
     (setq #s (cons n1 #s))
    )
  )
  #s
)

[Kent1Cooper]

My take on the first part, with only the list as argument [I haven't evaluated what @john.kaulB9QW2's 'x' argument is all about, but I expect you're wanting only the list]:

(defun rangelists (lst / n sub result)
  (repeat (- (setq n (1+ (apply 'max lst))) (apply 'min lst))
    (if (member (setq n (1- n)) lst)
      (setq sub (cons n sub)); then
      (if sub ; else
        (setq result (cons sub result) sub nil); then
      ); if
    ); if
  ); repeat
  (if sub (setq result (cons sub result))); last one(s)
  (setq result (mapcar '(lambda (x) (if (> (length x) 1) (list (car x) (last x)) x)) result))
)

[john.uhden]

@Kent1Cooper 

IT WORKS! (of course), and looks quite concise.

But, um, you owe us two more functions.

[john.uhden]

@john.kaulB9QW2 

That is clever, but not the assignment.  Please go back and read the challenge again.  I didn't miss a thing in explanation.

[john.uhden]

@hak_vz 

NICE WORK!! (as usual).

The only differences from the challenge instructions and examples are:

1.  The use of underscore in the string, which now that I look at it perhaps makes more sense with a range of negative numbers.  Maybe we should have used a colon.

2.  I showed a space after each comma.  I think it makes the string more legible (but that's a weak argument in the context of entering data in a dialog box... more spaces means more typing).  I guess I was affected by the way you enter raw descriptions or ranges of point numbers for point groups in Civil 3D.  Hmm, and my mind usually works contrary to what those programmers make up.

The only importance of these picayune comments is that our string conversion functions would not work with one another.

But since yours will be published upon your receipt of a Nobel award, the world will be fine.

[john.uhden]

@CodeDing 

PERFECTION!

Slightly verbose, but primarily because of the diligent indentation.

[hak_vz]

I have updated my code at #3 according to later updates from @john.uhden 

I have lost more time on removing empty space between code blocks in my post (and failed at the end) than to write and test new code.

[dbroad · Accepted solution]

Perhaps these with more function granularity.

Full test: (range-list->list(range-str->range-list(catranges(collect ul))))

(setq ul '(22 4 15 3 14 1 9 16 2 21 23)) ;test data

;;sort and collect into a list of ranges
(defun collect (l / pl)
  (setq l (vl-sort l '<))
  (while l
    (setq head (car l))
    (while (and l (cadr l) (= (car l) (1- (cadr l))))
      (setq l (cdr l))
      )
    (setq pl (if (= head (car l))
	       (cons (list head) pl)
	       (cons (list head (car l)) pl)
	       )
	  )
    (setq l (cdr l))
    )
  (reverse pl)
  )
;strcat those ranges
(defun catranges (l / s)
  (setq s "")
  (foreach n l
    (cond ((= 2 (length n))
	   (setq s (strcat s (itoa (car n)) "-" (itoa (cadr n))))
	   )
	  (t (setq s (strcat s (itoa (car n)))))
	  )
    (setq s (strcat s ", "))
    )
  (vl-string-right-trim ", " s)
  )

;convert string to range list
(defun range-str->range-list (str)
(read (strcat "(("
		      (vl-string-translate "-"" "
			(vl-string-translate ", " ")(" str)
			)
		      "))"
		      )))

;convert range list to list
(defun range-list->list (rlst / slst)
  (foreach l rlst
    (setq n (car l))
    (setq slst (cons n slst))
    (if (= 2 (length l))
	   (repeat (- (cadr l) n)
	     (setq slst (cons (setq n (1+ n)) slst))
	   )))
  (reverse slst))

[john.uhden]

@dbroad 

Looked good at first, but I threw in a couple of negatives and a zero...

UL = (-2 22 4 15 3 -1 14 1 9 16 2 21 23 0)
Collect = ((-2 4) (9) (14 16) (21 23)) ;; YAY!
Catranges = "-2-4, 9, 14-16, 21-23"  ;; YAY!
range-str->range-list = ((2 4) (9) (14 16) (21 23))  ;; Oops.

range-list->list = (_ _ _ _ 2 3 4 9 14 15 16 21 22 23) ;; Oops.

   (I'm gonna hafta check my own)

Plus that should have been literally range-str->list  = (-2 -1 0 1 2 3 etc.)

Thank you for chiming in; you always have a unique way of looking at things.

(defun c:TEST ( / a b c d)
  (setq ul '(-2 22 4 15 3 -1 14 1 9 16 2 21 23 0)) ;test data
  (princ "\nUL = ")(prin1 ul)
  (setq a (collect ul))
  (princ "\nCollect = ")(prin1 a)
  (setq b (catranges a))
  (princ "\nCatranges = ")(prin1 b)
  (setq c (range-str->range-list b))
  (princ "\nrange-str->range-list = ")(prin1 c)
  (setq d (range-list->list c))
  (princ "\nrange-list->list = ")(prin1 d)
  (princ)
)

[dbroad]

Perhaps you need to be more complete in your spec.  Nothing about negative numbers was mentioned.  Is that something that needs to be considered? For example, using a dash and a negative sign is probably poor practice.

[pbejse]

---

@john.uhden wrote:

Your challenge is to create a function that takes an unsorted list of integers, say

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

..

---

Forgive me @john.uhden, but I think i'm the only one who is not understanding the "range"

What is the result for this then?

'(22 1 26 25 29 4 15 3 14 1 9 16 6 2 21 23)

[hak_vz]

---

@pbejse wrote:

---

@john.uhden wrote:

Your challenge is to create a function that takes an unsorted list of integers, say

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

..

---

Forgive me @john.uhden, but I think i'm the only one who is not understanding the "range"

What is the result for this then?

'(22 1 26 25 29 4 15 3 14 1 9 16 6 2 21 23)

---

Command: (vl-sort '(22 1 26 25 29 4 15 3 14 1 9 16 6 2 21 23) '< )

(1 2 3 4 6 9 14 15 16 21 22 23 25 26 29)

If we sort the list in ascending order then there are ranges of consecutive numbers 1 2 3 4,... 14,15,16

This ranges can be represented as:

((1 4)(6)(9)(14 16)(21 23)(25 26)(29))

[pbejse]

---

@hak_vz wrote:

(1 2 3 4 6 9 14 15 16 21 22 23 25 26 29)

If we sort the list in ascending order then there are ranges of consecutive numbers 1 2 3 4,... 14,15,16

This ranges can be represented as:

((1 4)(6)(9)(14 16)(21 23)(25 26)(29))

---

😄 Ohhh, I got it now. thank you @hak_vz 

I seriously thought its like "range of", so OP list would be

'(22 4 15 3 14 1 9 16 2 21 23)

'((1 4)(9)(14)(16)(21 23));<-- by 5

and this 

'(22 1 26 25 29 4 15 3 14 1 9 16 6 2 21 23)

as 
((1 4)(6 9)(14)(16)(21 23 25) (26 29))

Question in my head was why not include the number for range as argument? Guess i messed up big time 🙂

[dbroad · Accepted solution]

Try this.  Still an extra step but range-str->range-list and range-list->list could be combined but if it were I would rather

(defun range-str->list (str)(range-list->list(range-str->range-list str))

;;(setq ul '(22 4 15 3 14 1 9 16 2 21 23))

;;unordered list with negative numbers
(setq ul '(-1 3 4 5 -2 8 9 0 11 14 15))

;;collect unordered list into ordered sublists representing
;;continuous ranges of integers
(defun collect	(l / pl)
  (setq l (vl-sort l '<))
  (while l
    (setq head (car l))
    (while (and l (cadr l) (= (car l) (1- (cadr l))))
      (setq l (cdr l)))
    (setq pl (if (= head (car l))
	       (cons (list head) pl)
	       (cons (list head (car l)) pl)))
    (setq l (cdr l)))
  (reverse pl))

;;Convert range lists into comma and hyphen delmited string ranges
(defun catranges  (l / s)
  (setq s "")
  (foreach n  l
    (cond ((= 2 (length n))
	   (setq s (strcat s (itoa (car n)) "-" (itoa (cadr n)))))
	  (t (setq s (strcat s (itoa (car n))))))
    (setq s (strcat s ", ")))
  (vl-string-right-trim ", " s))

;;Convert hyphen and comma delimited range string into range lists
(defun range-str->range-list  (str / lst num rl)
  (setq lst (vl-string->list str))
  (if (< 48 (car lst) 57)
    (setq num t))
  (foreach n  lst
    (cond ((and num (= n 45))		;hyphen
	   (setq num nil)
	   (setq rl (cons 32 rl)))
	  ((= n 44) (setq rl (cons 40 (cons 41 rl)))) ;comma
	  (t                         ;number or negative
	   (setq rl (cons n rl))
	   (if (< 48 n 57)
	     (setq num t)))		
	  ))
  (read (strcat "((" (vl-list->string (reverse rl)) "))")))

;;Convert range lists into ordered lists of integers
(defun range-list->list	 (rlst / slst n)
  (foreach l  rlst
    (setq n (car l))
    (setq slst (cons n slst))
    (if	(= 2 (length l))
      (repeat (- (cadr l) n)
	(setq slst (cons (setq n (1+ n)) slst)))))
  (reverse slst))

;;Test expressions
(setq rlst (collect ul))
(setq str (catranges rlst))
(setq rlst2 (range-str->range-list str))
(setq olist (range-list->list rlst2))