Topic: List of numbers to compacted string?

[Jeff_M]

OK, so it's Friday, it's been a long week, and I just can't seem to get into coding this seemingly simple function. Anyone care to help out?

Given: List of numbers, sorted lowest->highest, not necessarily sequential.
Needed: String of said numbers, compacting the sequential ones.

Example:
This list: '(1 3 4 5 8 10 11 14 15 16)
would return this string: "1,3-5,8,10,11,14-16"

Thanks

[MP]

Be gentle, very quick, very dirty --

Code: [Select]

(defun IntsToRangedString ( ints / sorted result group )

    ;;  first sort em, losing any duplicates
   
    (setq
        sorted (vl-sort ints '<)
        result (list (list (last sorted)))
    )

    ;;  now roll 'em ...
   
    (foreach x (cdr (reverse sorted))
        (setq result
            (if (eq (1+ x) (car (setq group (car result))))
                (cons
                    (cons x (list (last group)))
                    (cdr result)
                )
                (cons
                    (list x)
                    result
                )
            )
        )   
    )
   
    (setq result
        (mapcar
           '(lambda ( lst / a b )
                (cond
                    (   (eq 1 (length lst))
                        (itoa (car lst))
                    )
                    (   (eq (1+ (setq a (car lst))) (setq b (cadr lst)))
                        (strcat (itoa a) "," (itoa b))
                    )
                    (   (strcat (itoa a) "-" (itoa b))  )
                )
            )
            result
        )
    )
   
    (apply 'strcat
        (append
            (list (car result))
            (mapcar
               '(lambda (x) (strcat "," x))
                (cdr result)
            )
        )
    )
   
)
(IntsToRangedString '(1 3 4 5 8 10 11 14 15 16))

"1,3-5,8,10,11,14-16"

[T.Willey]

Here is mine.

Code: [Select]

(defun ForJeff (NumList / Str PrevNum Hyphen)

(foreach Num NumList
 (if (not Str)
  (setq Str (itoa Num))
  (if (equal (1- Num) PrevNum)
   (setq Hyphen T)
   (setq Str
    (strcat
     Str
     (if Hyphen
      (progn
       (setq Hyphen nil)
       (strcat "-" (itoa PrevNum) "," (itoa Num))
      )
      (strcat "," (itoa Num))
     )
    )
   )
  )
 )
 (if
  (and
   (equal Num (last NumList))
   (equal (1- Num) PrevNum)
  )
  (setq Str
   (strcat
    Str
    (if Hyphen
     (progn
      (setq Hyphen nil)
      (strcat "-" (itoa Num))
     )
     (strcat "," (itoa Num))
    )
   )
  )
 )
 (setq PrevNum Num)
; (prompt (strcat "\n Testing: " Str))
)
Str
)
Return

Command: (forjeff '(1 3 4 5 8 10 11 14 15 16))
"1,3-5,8,10-11,14-16"

Command: (forjeff '(1 3 4 5 8 10 11 14 15 16 20))
"1,3-5,8,10-11,14-16,20"

[MP]

Here is mine ...

Cool.

[Jeff_M]

Thanks, Michael! Looks almost like what I was imagining but couldn't quite code.

Works great, too!

Thanks to Tim, too! Only minor deficiency I see is "10-11" should be "10,11" but looks great, too.

Now I can get back to some real work.

[T.Willey]

Here is mine ...

Cool.

Same could/is said about yours.  Going the list route.  Took me a little while to see the whole flow.  I like the example. 

Thanks to Tim, too! Only minor deficiency I see is "10-11" should be "10,11" but looks great, too.

Now I can get back to some real work.

Guess I could look at that, but since Michael's works.......
Have fun today.   

[MP]

You're very welcome Jeff. I'm surprised I can code anything today -- have a cold / splitting headache -- but I am in the comfort of my own home* -- maybe that's what enabled a solution to percolate up.



* Officially unemployed (of my own volition) as of yesterday but starting with a new client on the 30th, so all is cool.

[T.Willey]

You're very welcome Jeff. I'm surprised I can code anything today -- have a cold / splitting headache -- but I am in the comfort of my own home* -- maybe that's what enabled a solution to percolate up.

Sorry to hear this.  Get better soon.

* Officially unemployed (of my own volition) as of yesterday but starting with a new client on the 30th, so all is cool.

Happy to hear this.  Hope the new client will stimulate you mind, and keep things fresh and fun.  Good luck there Michael.

[MP]

You're very welcome Jeff. I'm surprised I can code anything today -- have a cold / splitting headache -- but I am in the comfort of my own home* -- maybe that's what enabled a solution to percolate up.

Sorry to hear this.  Get better soon.

Thanks Tim!

* Officially unemployed (of my own volition) as of yesterday but starting with a new client on the 30th, so all is cool.

Happy to hear this.  Hope the new client will stimulate you mind, and keep things fresh and fun.  Good luck there Michael.

Thanks x 2! The new job has abundant promise: A spectrum of automation challenges, no development software handcuffs + good peeps, folks I've worked with before and have lots of respect for (that bring buckets of expertise and experience to the table). Bidirectional mentoring = true. What's not to like?

[Jeff_M]

Dittos on the get well soon, MP. While it'll be good to be off the next few weeks to recharge your system, it would be far better if you felt good during that period.

[ElpanovEvgeniy]

Code: [Select]

(defun test (lst)
  (if (and lst (listp (car lst)))
    (cond
      ((not (cadr lst))
       (strcat (itoa (caar lst)) "-" (itoa (cadar lst)))
      )
      ((= (1+ (cadar lst)) (cadr lst))
       (test (cons (list (caar lst) (cadr lst)) (cddr lst)))
      )
      (t (strcat (itoa (caar lst)) "-" (itoa (cadar lst)) "," (test (cddr lst))))
    ) ;_  cond
    (cond
      ((null lst) "")
      ((not (cadr lst)) (itoa (car lst)))
      ((= (1+ (car lst)) (cadr lst))
       (test (cons (list (car lst) (cadr lst)) (cddr lst)))
      )
      (t (strcat (itoa (car lst)) "," (test (cddr lst))))
    ) ;_  cond
  ) ;_  if
)

[MP]

Dittos on the get well soon, MP. While it'll be good to be off the next few weeks to recharge your system, it would be far better if you felt good during that period.

Thanks and true Jeff. I'm exploiting the time off / bed rest by doing as much geek reading as my eyes will permit.

[MP]

Code: [Select]

<recursive version>

Applause.

[Kerry]

Great thread guys !

[gile]

Hi,

Another way :

Code: [Select]

(defun intlst2str (lst / str)
  (setq lst (vl-sort lst '<)
str ""
  )
  (while lst
    (setq str (strcat str (itoa (car lst))))
    (if (= (+ 2 (car lst)) (caddr lst))
      (progn
(setq str (strcat str "-"))
(while (= (1+ (car lst)) (cadr lst))
  (setq lst (cdr lst))
)
(setq str (strcat str (itoa (car lst))))
      )
    )
    (setq lst (cdr lst))
    (if lst
      (setq str (strcat str ","))
    )
    str
  )
)

[Jeff_M]

I like the recursive approach, but it looks like it has problems....

(1 3 5 6 8 53 54 55 56 57 58 59 60 61 62 63 64 66 67 68)
_$ (test testlist)
"1,5-6,53-64,67-68"
 

[T.Willey]

Okay, here is my new entry.  I think it will work better.  Inspiration from Michael's. 

Code: [Select]

(defun NumList->String (NumList AddFactor / StrList Str)

(foreach Num NumList
 (cond
  ((not StrList)
   (setq StrList (list (list Num)))
  )
  ((equal (caar StrList) (- Num AddFactor) (* AddFactor 0.25))
   (setq StrList (subst (cons Num (car StrList)) (car StrList) StrList))
  )
  (T
   (setq StrList (cons (list Num) StrList))
  )
 )
)
(setq Str "")
(foreach Lst (reverse StrList)
 (cond
  ((equal (length Lst) 1)
   (setq Str (strcat Str (vl-princ-to-string (car Lst)) ","))
  )
  ((equal (length Lst) 2)
   (setq Str (strcat Str (vl-princ-to-string (cadr Lst)) "," (vl-princ-to-string (car Lst)) ","))
  )
  (T
   (setq Str (strcat Str (vl-princ-to-string (last Lst)) "-" (vl-princ-to-string (car Lst)) ","))
  )
 )
)
(substr Str 1 (1- (strlen Str)))
)
Return

Command: (NumList->String '(1 2 4 5 6  8 10 11 12) 1)
"1,2,4-6,8,10-12"

Command: (NumList->String '(1.0 2 4 5 6  8 10 11 12) 0.1)
"1.0,2,4,5,6,8,10,11,12"

Command: (NumList->String '(1.0 1.1 1.2 2 2.1 2.2 2.5) 0.1)
"1.0-1.2,2-2.2,2.5"

Command: (NumList->String '(1 3 5 6 8 53 54 55 56 57 58 59 60 61 62 63 64 66 67 68) 1)
"1,3,5,6,8,53-64,66-68"

[CAB]

OK late to the party again.
Took my wife out to dinner, first time in 8 weeks. Big points. 

This code will handle reals but not like Tim's, no AddFactor

Code: [Select]

(defun intstorangedstring (ints / sorted result x y )
  (setq sorted (vl-sort ints '>)
        x      (car sorted)
        sorted (cdr sorted)
        result (list (vl-princ-to-string x))
  )
  (while (setq y (car sorted))
    (setq sorted (cdr sorted))
    (cond
      ((and (= (1+ y) x) (= (1- y) (car sorted)))
       (if (/= (car result) "-") (setq result (cons "-" result)))
      )
      ((= (car result) "-")
       (setq result (cons (vl-princ-to-string y) result))
       )
      ((setq result (cons (vl-princ-to-string y) (cons "," result))))
    )
    (setq x y)
  )
 (apply 'strcat result)
)

Code: [Select]

(defun c:test ()
  (print (intstorangedstring '(1 3 4 5 8 10 11 14 15 16)))
  ;; "1,3-5,8,10,11,14-16"
  (print (intstorangedstring '(1 2 4 5 6  8 10 11 12)))
  ;;  "1,2,4-6,8,10-12"
  (print (intstorangedstring '(1.0 2 4 5 6  8 10 11 12)))
  ;; "1.0,2,4,5,6,8,10,11,12"
  (print (intstorangedstring '(1 3 5 6 8 53 54 55 56 57 58 59 60 61 62 63 64 66 67 68)))
  ;;  "1,3,5,6,8,53-64,66-68"
 (princ)
)

[ElpanovEvgeniy]

I like the recursive approach, but it looks like it has problems....

(1 3 5 6 8 53 54 55 56 57 58 59 60 61 62 63 64 66 67 68)
_$ (test testlist)
"1,5-6,53-64,67-68"
 

Excuse, I have hastened and have badly checked up...

Code: [Select]

(defun test (lst)
  (if (and lst (listp (car lst)))
    (cond
      ((not (cadr lst))
       (strcat (itoa (caar lst)) "-" (itoa (cadar lst)))
      )
      ((equal (1+ (cadar lst)) (cadr lst) 1e-8)
       (test (cons (list (caar lst) (cadr lst)) (cddr lst)))
      )
      (t (strcat (itoa (caar lst)) "-" (itoa (cadar lst)) "," (test (cdr lst))))
    ) ;_  cond
    (cond
      ((null lst) "")
      ((not (cadr lst)) (itoa (car lst)))
      ((equal (1+ (car lst)) (cadr lst) 1e-8)
       (test (cons (list (car lst) (cadr lst)) (cddr lst)))
      )
      (t (strcat (itoa (car lst)) "," (test (cdr lst))))
    ) ;_  cond
  ) ;_  if
)
(test  '(1 3 5 6 8 53 54 55 56 57 58 59 60 61 62 63 64 66 67 68))
=>>
"1,3,5-6,8,53-64,66-68"

[ElpanovEvgeniy]

Has deleted superfluous checks...

Code: [Select]

(defun test (lst)
  (if lst
    (if (listp (car lst))
      (if (cadr lst)
        (if (equal (1+ (cadar lst)) (cadr lst) 1e-8)
          (test (cons (list (caar lst) (cadr lst)) (cddr lst)))
          (strcat (itoa (caar lst)) "-" (itoa (cadar lst)) "," (test (cdr lst)))
        ) ;_  if
        (strcat (itoa (caar lst)) "-" (itoa (cadar lst)))
      ) ;_  if
      (if (cadr lst)
        (if (equal (1+ (car lst)) (cadr lst) 1e-8)
          (test (cons (list (car lst) (cadr lst)) (cddr lst)))
          (strcat (itoa (car lst)) "," (test (cdr lst)))
        ) ;_  if
        (itoa (car lst))
      ) ;_  if
    ) ;_  if
    ""
  ) ;_  if
)

[Kerry]

Evgeniy,
very nice ..

Could you show how you would expand the list ?

ie
(setq x "1,3,5-6,8,53-64,66-68" )
(test_expand x) ;; ->>
(1 3 5 6 8 53 54 55 56 57 58 59 60 61 62 63 64 66 67 68)

[ElpanovEvgeniy]

Evgeniy,
very nice ..

Could you show how you would expand the list ?

ie
(setq x "1,3,5-6,8,53-64,66-68" )
(test_expand x) ;; ->>
(1 3 5 6 8 53 54 55 56 57 58 59 60 61 62 63 64 66 67 68)

Code: [Select]

(defun test1 (s)
  (if s
    (if (listp s)
      (if (and (cadar s)(< (caar s) (cadar s)))
          (cons (caar s) (test1 (cons (list (1+ (caar s)) (cadar s)) (cdr s))))
          (cons (caar s)(test1 (cdr s)))
        )
      (test1
        (read
          (strcat
            "(("
            (apply
              (function strcat)
              (mapcar
                (function
                  (lambda (x)
                    (cond
                      ((< 47 x 58) (chr x))
                      ((= 44 x) ")(")
                      ((= 45 x) " ")
                    ) ;_  cond
                  ) ;_  lambda
                ) ;_  function
                (vl-string->list s)
              ) ;_  mapcar
            ) ;_  apply
            "))"
          ) ;_  strcat
        ) ;_  read
      ) ;_  test
    ) ;_  if
  ) ;_  if
)

[Kerry]

Evgeniy,

(test1 "1,3,5-6,8,53-64,66-68")

; error: too many arguments

edit : piccy

[ElpanovEvgeniy]

Whence it (T)??

[Kerry]

 ahhhhh ,  My bad ..   


Thanks !

[Kerry]

I think I must have left the t when I removed the closing_comments ..

            "))"
          ) ;_  strcat

clumsy !

[Andrea]

and mine...

Code: [Select]


[code(setq mainlist (vl-sort '(1 3 4 5 8 10 11 14 15 16) '<) Flist "")
(foreach n mainlist
  (setq i1 (car mainlist) i2 (cadr mainlist))
  (if i2
    (progn
      (if (eq (+ i1 1) i2)
(setq Flist (strcat Flist (rtos i1 2 0) ","))
(setq Flist (strcat Flist (rtos i1 2 0) "-")))
      (setq mainlist (cdr mainlist))
    )(setq Flist (strcat Flist (rtos i1 2 0)))
))(alert (strcat "Ther it is: " Flist))

[Kerry]

Andrea, you may need to test that.

[Andrea]

Andrea, you may need to test that.

test result....

[Kerry]

Andrea, you may need to test that.

test result.... "1-3,4,5-8-10,11-14,15,16"

I believe it should return "1,3-5,8,10-11,14-16"  or "1,3-5,8,10,11,14-16" depending on how you read the specifications.

[Andrea]

oops !!..

ok...i'll try to work on it.

sorry...