关于LISP表处理的测试练习，看看谁的代码高效的前提下更简洁

Lispboy · 发表于 2013-5-26 13:29:20

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 Lispboy 于 2013-5-26 14:14 编辑

条件：点表 Pts = '(p1 p2 p3 p4 p5...pn) 得： '((p1 p2)(p2 p3)(p3 p4)....(pn-1 pn))

大家试试写下代码。

wowan1314 · 发表于 2013-5-26 13:43:20

我来支持下你。

;;(SETQ LST '(1 2 3 4 5 6 7 8))
;;(T11 LST)=>((1 2) (3 4) (5 6) (7 8))
(DEFUN T11 (LST / LST1)
(SETQ LST1 NIL)
(WHILE (SETQ LST1 (CONS (LIST (CAR LST) (CADR LST)) LST1)
LST (CDDR LST)
)
)
(reverse LST1)
)

Lispboy · 发表于 2013-5-26 13:55:35

wowan1314 发表于 2013-5-26 13:43
我来支持下你。
;;(SETQ LST '(1 2 3 4 5 6 7 8))
;;(T11 LST)=>((1 2) (3 4) (5 6) (7 8))

葛老，咋我的帖子里面总有你呢。:hug:

炫翔 · 发表于 2013-5-26 14:01:35

修正楼上的:

;;(SETQ LST '(1 2 3 4 5 6 7 8))
;;(T11 LST)=>((1 2) (2 3) (3 4) (4 5) (5 6) (6 7) (7 8))
(defun t11 (lst / lst1)
(setq lst1 nil)
(while (and
(car lst)
(cadr lst)
)
(setq lst1 (cons (list (car lst) (cadr lst)) lst1)
lst (cdr lst)
)
)
(reverse lst1)
)

Lispboy · 发表于 2013-5-26 14:02:34

wowan1314 发表于 2013-5-26 13:43
我来支持下你。

葛老，程序不对哦

命令: (setq a '(1 2))
(1 2)
命令: (t11 a)
((1 2))
命令: (setq b '(1 2 3))
(1 2 3)
命令: (t11 a)
((1 2))

Free-Lancer · 发表于 2013-5-26 14:05:27

(mapcar '(lambda (a b) (list a b)) lst (cdr lst))来自: Android客户端

Lisphk · 发表于 2013-5-26 14:08:17

(setq a '(1 3 2 4 5 5 6 7))
(setq i 0 l nil)
(repeat (- (length a) 1)
(setq b (nth i a)
i (1+ i)
c (nth i a)
l (cons (list b c)l)
)
)
(reverse l)

Lispboy · 发表于 2013-5-26 14:18:04

Free-Lancer 发表于 2013-5-26 14:05
(mapcar '(lambda (a b) (list a b)) lst (cdr lst))

除了循环语句外，如果用LISP的基本函数呢，就是CONS,CAR,CDR这样的组合，还有什么更效率的？

wowan1314 · 发表于 2013-5-26 14:34:46

本帖最后由 wowan1314 于 2013-5-26 17:31 编辑

Lispboy 发表于 2013-5-26 14:18
除了循环语句外，如果用LISP的基本函数呢，就是CONS,CAR,CDR这样的组合，还有什么更效率的？

又尝试写了个！

;;(SETQ LST '(1 2 3 4 5 6 7 8))
;;测试
;;(T12 LST)=>((1 2) (2 3) (3 4) (4 5) (5 6) (6 7) (7 8))
(DEFUN T12 (LST / LST1 T11)
(DEFUN T11 (LST)
(AND (cadr lst)
(setq lst1 (cons (list (car lst) (cadr lst)) lst1)
lst (cdr lst)
)
(T11 LST))
)
(SETQ LST1 NIL)
(T11 LST)
(reverse lst1)
)

Lispboy · 发表于 2013-5-26 14:39:39

wowan1314 发表于 2013-5-26 14:34
又尝试写了个！
;;(SETQ LST '(1 2 3 4 5 6 7 8))
;;(T12 LST)=>((1 2) (2 3) (3 4) (4 5) (5 6) (6 7) ...

葛老，怎么不习惯用代码高亮发布？看着累。

好像你给弄出递归了？

Underway · 发表于 2013-5-26 15:18:12

另方:
(apply 'mapcar (cons 'list (list a (cdr a))))

XDSoft · 发表于 2013-5-26 15:53:41

wowan1314 发表于 2013-5-26 14:34
又尝试写了个！

葛老，不是必须时候，不要用点评，点评别人回复不了你，就耽误了沟通。

论坛帖代码要点 <>按钮，或者直接手输入【code=lisp】【/code】，粗括号改成细的。

wowan1314 · 发表于 2013-5-26 16:07:15

XDSoft 发表于 2013-5-26 15:53
葛老，不是必须时候，不要用点评，点评别人回复不了你，就耽误了沟通。

论坛帖代码要点按钮，或者直 ...

收到！ :lol

wowan1314 · 发表于 2013-5-26 16:48:46

本帖最后由 wowan1314 于 2013-5-26 19:53 编辑

Underway 发表于 2013-5-26 15:18
另方:
(apply 'mapcar (cons 'list (list a (cdr a))))

加APPLY有什么特别的用么？
直接这样好像就可以
(mapcar 'list a (cdr a)) -------这应该是最简单的了

;;再来一个-----这样好像也可以
(DEFUN T11 (A / LST)
(SETQ LST NIL)
(foreach b a (setq lst (cons (list b (cadr a)) lst) a (cdr a)))
(reverse (CDR LST))
)

taner · 发表于 2013-5-26 16:51:35

;;; 在哪里偷来的不记得了
(DEFUN TXT-LST-SPLIT (LI N / RETURN A LEN)
(WHILE LI
(SETQ A NIL
LEN (LENGTH LI)
)
(REPEAT (IF (<= N LEN)
N
LEN
)
(SETQ A (CONS (CAR LI) A)
LI (CDR LI)
)
)
(SETQ RETURN (CONS (REVERSE A) RETURN))
)
(REVERSE RETURN)
)
(DEFUN TH-LST-SPLIT (INPLST GP# / IDX LEN OUTLST SUBLST)
(WHILE INPLST
(SETQ IDX -1
SUBLST NIL
LEN (LENGTH INPLST)
)
(IF (> GP# LEN)
(SETQ GP# LEN)
)
(WHILE (< (SETQ IDX (1+ IDX))
GP#
)
(SETQ SUBLST (CONS (NTH IDX INPLST) SUBLST))
)
(SETQ OUTLST (CONS (REVERSE SUBLST) OUTLST))
(REPEAT GP#
(SETQ INPLST (CDR INPLST))
)
)
(REVERSE OUTLST)
)
(DEFUN HAO-LST-SPLIT (LST N)
(IF LST
(CONS (TH-HOLD-LSTMN 0 (1- N) LST)
(HAO-LST-SPLIT
(TH-HOLD-LSTMN
N
(LENGTH LST)
LST
)
N
)
)
)
)
;;; HAO-LST-SPLIT速度最慢
(DEFUN TT-LST-SPLIT (LST N / RET OUT CNT)
(SETQ RET NIL)
(SETQ CNT (- N (REM (LENGTH LST) N))
LST (REVERSE LST)
)
(WHILE LST
(SETQ RET (CONS (CAR LST) RET)
LST (CDR LST)
)
(IF (ZEROP (REM (SETQ CNT (1+ CNT))
N
)
)
(SETQ OUT (CONS RET OUT)
RET NIL
)
)
)
(IF RET
(CONS RET OUT)
OUT
)
)
(DEFUN T2-LST-SPLIT (LST N / A I LL)
(SETQ I 1)
(MAPCAR
'(LAMBDA (X)
(IF (< I N)
(SETQ A (CONS X A)
I (1+ I)
)
(SETQ LL (CONS (REVERSE (CONS X A)) LL)
A NIL
I 1
)
)
)
LST
)
(REVERSE (IF A
(CONS (REVERSE A) LL)
LL
)
)
)
(DEFUN YBL-LST-SPLIT (LST N / M LL L)
(SETQ M (FIX (/ (LENGTH LST) N)))
(IF (ZEROP M)
LST
(PROGN
(REPEAT M
(REPEAT N
(SETQ LL (CONS (CAR LST) LL)
LST (CDR LST)
)
)
(SETQ L (CONS LL L)
LL NIL
)
)
(IF LST
(APPEND
(REVERSE (MAPCAR
'REVERSE
L
)
)
(LIST LST)
)
(REVERSE (MAPCAR
'REVERSE
L
)
)
)
)
)
)

;;; 在哪里偷来的不记得了 
(DEFUN TXT-LST-SPLIT (LI N / RETURN A LEN) 
  (WHILE LI 
    (SETQ A   NIL 
          LEN (LENGTH LI) 
    ) 
    (REPEAT (IF        (<= N LEN) 
              N 
              LEN 
            ) 
      (SETQ A  (CONS (CAR LI) A) 
            LI (CDR LI) 
      ) 
    ) 
    (SETQ RETURN (CONS (REVERSE A) RETURN)) 
  ) 
  (REVERSE RETURN) 
) 
(DEFUN TH-LST-SPLIT (INPLST GP# / IDX LEN OUTLST SUBLST) 
  (WHILE INPLST 
    (SETQ IDX         -1 
          SUBLST NIL 
          LEN         (LENGTH INPLST) 
    ) 
    (IF        (> GP# LEN) 
      (SETQ GP# LEN) 
    ) 
    (WHILE (< (SETQ IDX (1+ IDX)) 
              GP# 
           ) 
      (SETQ SUBLST (CONS (NTH IDX INPLST) SUBLST)) 
    ) 
    (SETQ OUTLST (CONS (REVERSE SUBLST) OUTLST)) 
    (REPEAT GP# 
      (SETQ INPLST (CDR INPLST)) 
    ) 
  ) 
  (REVERSE OUTLST) 
) 
(DEFUN HAO-LST-SPLIT (LST N) 
  (IF LST 
    (CONS (TH-HOLD-LSTMN 0 (1- N) LST) 
          (HAO-LST-SPLIT 
            (TH-HOLD-LSTMN 
              N 
              (LENGTH LST) 
              LST 
            ) 
            N 
          ) 
    ) 
  ) 
) 
;;; HAO-LST-SPLIT速度最慢 
(DEFUN TT-LST-SPLIT (LST N / RET OUT CNT) 
  (SETQ RET NIL) 
  (SETQ        CNT (- N (REM (LENGTH LST) N)) 
        LST (REVERSE LST) 
  ) 
  (WHILE LST 
    (SETQ RET (CONS (CAR LST) RET) 
          LST (CDR LST) 
    ) 
    (IF        (ZEROP (REM (SETQ CNT (1+ CNT)) 
                    N 
               ) 
        ) 
      (SETQ OUT        (CONS RET OUT) 
            RET        NIL 
      ) 
    ) 
  ) 
  (IF RET 
    (CONS RET OUT) 
    OUT 
  ) 
) 
(DEFUN T2-LST-SPLIT (LST N / A I LL) 
  (SETQ I 1) 
  (MAPCAR 
    '(LAMBDA (X) 
       (IF (
         (SETQ A (CONS X A) 
               I (1+ I) 
         ) 
         (SETQ LL (CONS (REVERSE (CONS X A)) LL) 
               A  NIL 
               I  1 
         ) 
       ) 
     ) 
    LST 
  ) 
  (REVERSE (IF A 
             (CONS (REVERSE A) LL) 
             LL 
           ) 
  ) 
) 
(DEFUN YBL-LST-SPLIT (LST N / M LL L) 
  (SETQ M (FIX (/ (LENGTH LST) N))) 
  (IF (ZEROP M) 
    LST 
    (PROGN 
      (REPEAT M 
        (REPEAT        N 
          (SETQ        LL  (CONS (CAR LST) LL) 
                LST (CDR LST) 
          ) 
        ) 
        (SETQ L         (CONS LL L) 
              LL NIL 
        ) 
      ) 
      (IF LST 
        (APPEND 
          (REVERSE (MAPCAR 
                     'REVERSE 
                     L 
                   ) 
          ) 
          (LIST LST) 
        ) 
        (REVERSE (MAPCAR 
                   'REVERSE 
                   L 
                 ) 
        ) 
      ) 
    ) 
  ) 
)

账号		自动登录	找回密码
密码			立即注册

[研讨] 关于LISP表处理的测试练习，看看谁的代码高效的前提下更简洁

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

点评

评分

点评

评分

点评

评分

评分

点评

点评

评分

评分

浏览过的版块