[求助]真的着急哦，请务必帮忙~~~~

dolaimi

我是用在clisp下面运行的

用的是common lisp的语言，看我的代码是和你们的有点不一样哦~~

不好意思~~~

好像是在定义函数变量的时候有不一样的规定~~~

谢谢~~

liu22737

(defun r-compress (lis)
(setq t0 '())
(while (car lis)
(setq lis_w (car lis))
(setq lis_m (- (length lis) (length(vl-remove lis_w lis))))
(if (= lis_m 1) (setq t0 (append t0 (list lis_w)))
(setq t0 (append t0 (list(list lis_m lis_w)))))
(setq lis (vl-remove lis_w lis))
)(princ t0)(princ)
)
;;;
(defun r-uncompress (lis)
(setq t0 '())
(while (car lis)
(if (listp(car lis))
(repeat (caar lis)(setq t0 (append t0 (list(cadr(car lis))) )))
(setq t0 (append t0 (list(car lis)) )))
(setq lis (vl-remove (car lis) lis)))
(princ t0)(princ)
)

王咣生

使用的程序环境都不一样,我也帮不上什么忙.

dolaimi

谢谢12楼的帮忙~~感激不尽~~~~

谢谢版主！！！！

dolaimi

还有人帮忙解决第二题吗？感激不尽~~~~

liu22737

(defun all-sequences (lis)
(if (/= (length lis) 1) (progn
(setq s (length lis) ss 1.0)
(while (/= s 1)
(setq ss (* ss s))
(setq s (- s 1)))
(setq aa lis s 0)
 (repeat (fix ss)
  (princ lis)
  (setq cc lis s (+ s 1))
  (if (/= (fix s) (fix (/ ss 2)) )(progn
  (setq lis (append (cdr lis) (list(car lis))))
    (if(equal lis aa)(setq lis (append(list(last cc))(reverse(cdr(reverse(cdr cc))))(list(car cc)) ) aa lis))
    )(setq lis (reverse lis) aa lis)))
 )(princ lis))
(princ)
)

xazhji

[I]For 楼主的第二题。[/I]本来对此贴不感兴趣，但楼主盛情难却。没有什么意思，不过可以测试一下您的计算机运行速度，来个  (all-sequences  '(a b c d e f g h i))  试试？

;;;By xazhji 21:53 2005-10-8
(defun all-sequences  (lis / li1 li2 m mm n nlis nnlis xx yy)
  (setq nlis (list (list (car lis))))
  (foreach xx (cdr lis)
    (progn
      (setq nnlis nil)
      (foreach yy nlis (progn
            (setq n 0 )
            (repeat (1+ (length yy))
                    (setq m 0 mm n li1 nil li2 nil)
                    (repeat n (setq li1 (cons (nth m yy) li1) m (1+ m)))
                    (repeat (- (length yy) n) (setq li2 (cons (nth mm yy) li2) mm (1+ mm)))
                    (setq nnlis (append (list (append (reverse li1) (cons xx (reverse li2)))) nnlis) n (1+ n))
             )
             (setq nlis  nnlis)
         )
     )
   )
 )
)

ZZXXQQ

第一题：

2. (DEFUN R-COMPRESS (LST)
3. (IF (LISTP LST) (PROGN
4.   (SETQ CP (LIST) I 1 J 1 TMP (NTH 0 LST))
5.   (REPEAT (1- (LENGTH LST))
6.    (SETQ TMP2 (NTH I LST) I (1+ I))
7.    (IF (= TMP TMP2)
8.     (SETQ J (1+ J))
9.     (SETQ CP (APPEND CP (LIST (IF (= J 1) TMP (LIST TMP J))))
10.           J 1 TMP TMP2)
11.    )
12.   )
13.   (SETQ CP (APPEND CP (LIST (IF (= J 1) TMP (LIST TMP J)))))
14. )
15.   (SETQ CP LST)
16. )
17. CP
18. )

复制代码

2. (DEFUN R-UNCOMPRESS (LST)
3. (IF (LISTP LST) (PROGN
4.   (SETQ I 0 TMP (LIST))
5.   (REPEAT (LENGTH LST)
6.    (SETQ TP (NTH I LST) I (1+ I))
7.    (IF (LISTP TP)
8.     (REPEAT (CAR TP) (SETQ TMP (APPEND TMP (CDR TP))))
9.     (SETQ TMP (APPEND TMP (LIST TP)))
10.    )
11.   )
12. )
13.   (SETQ TMP LST)
14. )
15. TMP
16. )

复制代码