[讨论]：出题目啦: 表项替换

梦断江南 · 发表于 2004-10-14 12:27:34

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

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

×

[php]
;|
(subi a ilst lst) 表项替换,支持子表
功能: 用a替换ilst中指定位置的lst的项.
参数: a = 要替换的项,可是元素或表.
ilst = 整数或整数定位表,如'(2 3 1),将替换表中第二项的第三项的第一个项.
lst = 要被替换的表.
返回: 成功:返回替换后的新表. 失败,返回原表.
|;
(setq a 333 ilst '(2 3 1) lst '(0 0 (0 0 0 (0 0)) 0 ))
;; 结果应该返回: '(0 0 (0 0 0 (0 333)) 0)
[/php]

望各位各显神通

LUCAS · 发表于 2004-10-14 15:27:34

;;(xl-sub-ilst <新項> <序號i層次表> <表>) = 按序號層次表替換表元素 v0.1
;;－－－－－－－－－－－－－－－陌生人。2004.2;
為甚麼又再來一次????

梦断江南 · 发表于 2004-10-14 22:29:07

哦,我说呢,我记得是有这么回事,有这么一贴的,可不记得细节,搜索范围大了,没时间慢慢找.
只好自己写了一次.哈哈.写完看lucas的回帖,再搜索,一看,嘿嘿,我今天写的代码还要少.

lucas说的那个贴在这里.
http://www.xdcad.net/forum/showt ... d=767588#post767588

wkai · 发表于 2004-10-14 22:50:57

好久没有见到陌生人了！
有点想念他了。他去哪里了呢？

梦断江南 · 发表于 2004-10-15 03:57:36

一般来说可能是改名字了

eachy · 发表于 2004-10-15 06:52:18

再贴一次，置顶帖子里的一个函数。

;; 用 a 置換表 l 中第 n 个元素;
;|
用法：(SUBST-N '(0 2) '(99 22) '((1 2 3) 2 55 99 66)) 替换第一个子表第三项
((1 2 (99 22)) 2 55 99 66)
(SUBST-N '(2 1) '(99) '(1 2 (55) 99 66)) 替换第二个子表第二项
(1 2 (55 ((99))) 99 66)
(SUBST-N 2.0 '(99) '(1 2 55 99 66)) 替换第二个原子
(1 2 (99) 99 66)
|;
(defun subst-n (n a l)
(cond
((numberp n) ;整数或实数
(if (zerop n)
(append (list a) (cdr l)) ;第一个
(cons (car l) (subst-n (1- n) a (cdr l))) ;
)
)
((listp n) ;表
(cond
((equal (length n) 1) ;替换单项
(if (zerop (car n))
(append (list a) (cdr l))
(cons (car l) (subst-n (1- (car n)) a (cdr l)))
)
)
((> (length n) 1) ;替换子表项
(if (zerop (car n))
(cons (subst-n (cdr n) a (car l)) (cdr l))
(cons
(car l)
(subst-n (append (list (1- (car n))) (cdr n)) a (cdr l))
)
)
)
)
)
)
)

;; 用 a 置換表 l 中 第 n 个元素; 
;| 
用法：(SUBST-N '(0 2) '(99 22) '((1 2 3) 2 55 99 66))       替换第一个子表第三项 
                                   ((1 2 (99 22)) 2 55 99 66) 
      (SUBST-N '(2 1) '(99) '(1 2 (55) 99 66))   替换第二个子表第二项 
                                  (1 2 (55 ((99))) 99 66) 
      (SUBST-N 2.0 '(99) '(1 2 55 99 66)) 替换第二个原子 
                             (1 2 (99) 99 66) 
|; 
(defun subst-n (n a l) 
  (cond 
    ((numberp n)                        ;整数或实数 
     (if (zerop n) 
       (append (list a) (cdr l))        ;第一个 
       (cons (car l) (subst-n (1- n) a (cdr l))) ; 
     ) 
    ) 
    ((listp n)                                ;表 
     (cond 
       ((equal (length n) 1)                ;替换单项 
        (if (zerop (car n)) 
          (append (list a) (cdr l)) 
          (cons (car l) (subst-n (1- (car n)) a (cdr l))) 
        ) 
       ) 
       ((> (length n) 1)                ;替换子表项 
        (if (zerop (car n)) 
          (cons (subst-n (cdr n) a (car l)) (cdr l)) 
          (cons 
            (car l) 
            (subst-n (append (list (1- (car n))) (cdr n)) a (cdr l)) 
          ) 
        ) 
       ) 
     ) 
    ) 
  ) 
)

梦断江南 · 发表于 2004-10-15 12:11:20

贴我昨天写的其中一个:
[php]
;;************************************************************  3 *****;;;
;| (subilst a ilst lst) = 表项替换,支持子表.----------------ok!---------梦断江南.2004.10
功能: 用a替换ilst中指定位置的lst的项.
参数: a = 要替换的项,可是元素或表.
   ilst = 整数或整数定位表,如'(2 3 1),将替换表中第二项的第三项的第一个项.'
   lst  = 要被替换的表.
返回: 成功:替换后的新表. 失败,返回原表.
说明: 可单独运行,无需加载其他函数.
   用了第归的方法.
测试: (setq a 333 ilst '(2 3 1) lst '(0 0 (0 0 0 (0 0)) 0 ))
   (subilst a 2 lst) -> (0 0 333 0) (setq ilst 2)
   (subilst a ilst lst) -> (0 0 (0 0 0 (0 333)) 0)
   (subilst '333 '(2 3 5) lst) -> (0 0 (0 0 0 (0 0)) 0)
|;
;;*******************************************************************************;;;
(defun subilst (a ilst lst / n)
  (setq n -1)
  (if (atom ilst)(setq ilst (list ilst)))
  (mapcar '(lambda(x)
      (setq n (1+ n))
      (if (= (car ilst) n)
         (if (= 1 (length ilst)) a (subilst a (cdr ilst) x))
         x
      )
   )
      lst
  )
)
[/php]

yjtdkj · 发表于 2005-1-11 13:43:05

请问楼主做此程序的目的是什么呀，或者说如何应用？

young263 · 发表于 2005-3-17 21:24:31

看不懂这个东西,干什么用的?

aeo · 发表于 2005-3-18 00:37:26

???

命令: !a
(1 2 3 (4 5 6 (7 8) 9 0))
命令: (subilst "A" 1 a)
(1 "A" 3 (4 5 6 (7 8) 9 0))
命令: (subilst "A" '(3 3 0) a)
(1 2 3 (4 5 6 ("A" 8) 9 0))
命令: (subilst "A" '(3 3 0 4) a)
错误: 参数类型错误: listp 7
命令: (subilst "A" '(1 2) a)
错误: 参数类型错误: listp 2

复制代码

无痕 · 发表于 2005-3-18 07:54:33

试改一下
[php](defun subilst (a ilst lst / n)
  (setq n -1)
  (if (atom ilst)(setq ilst (list ilst)))
  (mapcar '(lambda(x)
      (setq n (1+ n))
      (if (and (= (car ilst) n) (not(atom x)))
         (if (= 1 (length ilst)) a (subilst a (cdr ilst) x))
         x
      )
      )
      lst
  )
)[/php]

aeo · 发表于 2005-3-20 10:11:02

最初由无痕发布
[B]试改一下
[php](defun subilst (a ilst lst / n)
  (setq n -1)
  (if (atom ilst)(setq ilst (list ilst)))
  (mapcar '(lambda(x)
      (setq n (1+ n))
      (if (and (= (car ilst) n) (not(a... [/B]

命令: (subilst "A" 1 '(0 1 2 3 4 5))
(0 1 2 3 4 5)

无痕 · 发表于 2005-3-20 12:02:37

加强了容错性能.
测试: (setq a 333 ilst '(2 3 1) lst '(0 0 (0 0 0 (0 0)) 0 ))
   (subilst a 2 lst) -> (0 0 333 0) (setq ilst 2)
   (subilst a ilst lst) -> (0 0 (0 0 0 (0 333)) 0)
   (subilst '333 '(2 3 5) lst) -> (0 0 (0 0 0 (0 0)) 0)
   (subilst "A" '(3 2 0 4) '(1 2 3 (4 5 6 (7 8) 9 0))) ->(1 2 3 (4 5 6 (7 8) 9 0))
   (subilst "A" '(3 2 0 4) 3) ->3
   (subilst "A" 1 '(0 1 2 3 4 5))->(0 "A" 2 3 4 5)
[php]
;;v1.2
(defun subilst (a ilst lst / n)
  (setq n -1)
  (if (atom ilst)(setq ilst (list ilst)))
  (if (atom lst)
lst
(mapcar '(lambda (x)
         (setq n (1+ n))
         (if (= (car ilst) n)
   (if (cdr ilst)(subilst a (cdr ilst) x)a)
   x
         )
      )
      lst
)
  )
)[/php]

zwy1981 · 发表于 2005-3-20 23:45:06

听不懂3阿！~~~~~~~~

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

[讨论]：出题目啦: 表项替换

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

相关帖子

浏览过的版块