[功能] 循环下移(流星雨)

/db_自贡黄明儒_ · 发表于 2017-5-24 08:26:38

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

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

×

;;[功能] 循环下移(流星雨)
;;;(swapDown '(1 2 3 4) 0) => (2 1 3 4)
;;;(swapDown '(1 2 3 4) 1) => (1 3 2 4)
;;;(swapDown '(1 2 3 4) 2) => (1 2 4 3)
;;;(swapDown '(1 2 3 4) 3) => (4 2 3 1)
(defun swapDown        (*Lst n / A I L TEMP)
  (setq L nil)
  (setq i -1)
  (if (= (1- (length *Lst)) n)
    (progn
      (setq *Lst (append *Lst (list (car *Lst))))
      (setq *Lst (reverse (cdr (swapDown *Lst n))))
      (cons (car *Lst) (reverse (cdr *Lst)))
    )
    (progn
      (while (setq a (car *Lst))
        (setq *Lst (cdr *Lst))
        (setq i (1+ i))
        (cond
          ((= n i) (setq temp a))
          ((= (1+ n) i) (setq L (cons a L)) (setq L (cons temp L)))
          (T (setq L (cons a L)))
        )
      )
      (reverse L)
    )
  )
)

fangmin723 · 发表于 2017-6-1 08:52:05

做了点小小的改动，
之前是：(swapDown '(1 2 3 4) 3) => (4 2 3 1)；
现在是：(swapDown '(1 2 3 4) 3) => (4 1 2 3)；

(defun swapDown(*Lst n / A I L TEMP)
(setq L nil)
(setq i -1)
(if (= (1- (length *Lst)) n)
(progn
(setq *Lst (append *Lst (list (last *Lst))))
(setq *Lst (cdr (reverse (swapDown *Lst n))))
;(setq *Lst (reverse (cdr (swapDown *Lst n))))
(cons (car *Lst) (reverse (cdr *Lst)))
)
(progn
(while (setq a (car *Lst))
(setq *Lst (cdr *Lst))
(setq i (1+ i))
(cond
((= n i) (setq temp a))
((= (1+ n) i) (setq L (cons a L)) (setq L (cons temp L)))
(T (setq L (cons a L)))
)
)
(reverse L)
)
)
)

pxt2015 · 发表于 2017-6-10 09:39:26

这个好贴，关注人少。做个演示吧。

qq1254582201 · 发表于 2017-6-12 21:43:50

画图中用途不太广哦，代码还是极好的，点赞支持

sicky111 · 发表于 2017-6-13 00:02:03

这个牛哦。

PO0O0 · 发表于 2017-6-13 00:18:59

不明觉力

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

[原创] [功能] 循环下移(流星雨)

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

评分