0 Members and 1 Guest are viewing this topic.
(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))))
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"
(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))
(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))
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"
(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"
(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)
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)
(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)
"))" ) ;_ strcat
[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))
Andrea, you may need to test that.
Quote from: Kerry Brown on October 14, 2006, 07:30:04 PMAndrea, you may need to test that.test result.... "1-3,4,5-8-10,11-14,15,16"