[已解决]表提取相同的元素并得到新表

nnzj

寻找了很久都没有找到表提取相同元素的函数，基本都是删除相同元素或者替换相同元素的。
比如表如下：
（项目 兰花 位置）（项目 树木 位置）（项目1 兰花 位置）（项目1 树木 位置）（项目2 草地 面积）（项目2 直树 位置）
根据上表得到如下数据：
  1、比如要提取元素中的 项目 关键字得到新表（项目 兰花 位置）（项目 树木 位置）
2、又比如提取元素中的 兰花 关键字得到新表 （项目 兰花 位置）（项目1 兰花 位置）
3、又比如提取元素中的 位置 关键字得到新表（项目 兰花 位置）（项目 树木 位置）（项目1 兰花 位置）（项目1 树木 位置）（项目2 直树 位置）
请高手编辑一个提取相同元素的函数，谢谢！

ll_j

第一个和第二个要求用vl-remove-if-not函数，第三个用vl-sort函数。

伪书虫86

(setq lst (list '("项目" "兰花" "位置")'("项目" "树木" "位置")'("项目1" "兰花" "位置")'("项目1" "树木" "位置")'("项目2" "草地" "面积")'("项目2" "直树" "位置")))
(vl-remove-if-not '(lambda(x) (member "项目" x)) lst)

nnzj

多谢上两位，
再请教如果表形式如下：（表中的元素有不同名称用分隔符隔开）
("项目 兰花 位置" " 项目 树木 位置" "项目1 兰花 位置" "项目1 树木 位置" "项目2 草地 面积" "名称 价格" "部位1" "部位2")
同样是提取元素 项目 得到新表 ("项目 兰花 位置" "项目 树木 位置")
那怎么提取，谢谢！

nnzj

本人新手；根据列表数据得到新表格式，自定义了个函数取得不同列表样式
("项目 兰花 位置" " 项目 树木 位置" "项目1 兰花 位置" "项目1 树木 位置" "项目2 草地 面积" "名称 价格" "部位1" "部位2")
以条件 “位置”取得新表
结果一：(("项目1" "树木" "位置") ("项目1" "兰花" "位置") ("项目" "树木" "位置") ("项目" "兰花" "位置"))
结果二：("项目 兰花 位置" "项目 树木 位置" "项目1 兰花 位置" "项目1 树木 位置")
结果二是我想要的格式
(defun bbtq (mingc lst1 / lstxx newlst1 x1 x2 bas1 bss1 bas2 bss2 lstx)
;parse 分列，返回一个包含在具有分隔符的字符串所有的标记的列表
;功能：
;分列，返回一个包含在具有分隔符的字符串所有的标记的列表
;语法：
;(parse str delim)
;参数：
;一个具有分隔符的字符串和分隔符
;示例(ax:Parse (getenv "ACAD") "")
;说明：
;在AutoLISP中不能正确解释在1到255范围之外的字符代码，所以不能分列一个空分隔符的字符串。
  (defun parse (str delim / lst pos)
     (setq pos (vl-string-search delim str))
       (while pos
           (setq lst (cons (substr str 1 pos) lst)
                str (substr str (+ pos 2))
                pos (vl-string-search delim str)
        )
     )
  (if (> (strlen str) 0)
    (setq lst (cons str lst))
  )
  (reverse lst)
  )
  ;将一个字符串列表解析为1个具有分隔符的字符串
;(StrUnParse Lst Delimiter)
;参数：
;Str:要连接的列表
;Delimiter :使用的分隔符
;返回值：
;一个字符串
;示例：
;(setq a '("Harp" "Guiness" "Black and Tan"))
;(StrUnParse a ",")
;返回:
;"Harp,Guiness,Black and Tan"
;函数代码：
(defun StrUnParse (Lst Delimiter / return)
        (setq return "")
        (foreach str Lst
                (setq return (strcat return Delimiter str))
        ) ;_ end of foreach
        (substr return 2)
) ;_ end of defun语法：
(setq newlst1 nil lstxx nil x1 0 x2 0)
            (repeat (length lst1)
                   (setq bas1 (vl-princ-to-string  (nth x1 lst1)))   ;把元素转换为字符串
                   (setq bss1 (parse bas1 " "))     ;自定义函数把字符串转为按分隔符转换为表
                                   (setq newlst1 (cons bss1 newlst1))
                                   (setq x1(1+ x1))
                          )
   (setq lstx(vl-remove-if-not '(lambda(x) (member mingc x)) newlst1))
                          (repeat (length lstx)
                   (setq bas2 (nth x2 lstx))   ;把元素转换为字符串
                   (setq bss2 (StrUnParse bas2 " "))     ;自定义函数把字符串转为按分隔符转换为表
                                   (setq lstxx (cons bss2 lstxx))
                                   (setq x2(1+ x2))
                          )
)
各位老师看看还有什么简便的方法没有。上面高得复杂了。

ivde

看看wcmatch函数介绍

ll_j

nnzj 发表于 2014-11-19 17:03
本人新手；根据列表数据得到新表格式，自定义了个函数取得不同列表样式
("项目 兰花 位置" " 项目 树木 位 ...

求结果一稍复杂，需要将长字符串分解为字符串列表，刚才写了这段分解代码，使用下面代码将字符串分解成字符串列表，然后就可以用vl-remove-if-not和vl-sort求解了。

1. (defun str->lst(str cr / l i sr)  ;字符串分解为字符串列表，str—字符串，cr—特征分隔字符，单字符
   
2.   (while (setq i (vl-string-position (ascii cr) str))
   
3.     (setq sr (substr str 1 i)
   
4.           str(substr str (+ i 2))
   
5.     )
   
6.     (if (/= sr "") (setq l (cons sr l)))
   
7.   )
   
8.   (reverse (cons str l))
   
9. )

(defun str->lst(str cr / l i sr)  ;字符串分解为字符串列表，str—字符串，cr—特征分隔字符，单字符<br />   (while (setq i (vl-string-position (ascii cr) str))<br />     (setq sr (substr str 1 i)<br />           str(substr str (+ i 2))<br />     )<br />     (if (/= sr "") (setq l (cons sr l)))<br />   )<br />   (reverse (cons str l))<br /> )

求结果二比较简单，使用vl-remove-it-not结合wcmatch要多少截多少，输出结果可以使用vl-sort排序，或者使用上面代码转换后再进行处理。

冰与火之歌

这些表明显是有规律的 那么构造一表 long_lst （（项目 兰花 位置）（项目 树木 位置）（项目1 兰花 位置）（项目1 树木 位置）（项目2 草地 面积）（项目2 直树 位置）……）你的1、2、3条便可如此实现
(vl-remove nil (mapcar '(lambda (x) (if (not (= (car x) 项目) ) (setq x nil)) x) long_lst))
(vl-remove nil (mapcar '(lambda (x) (if (not (= (cadr x) 兰花) ) (setq x nil)) x) long_lst))
(vl-remove nil (mapcar '(lambda (x) (if (not (= (caddr x) 位置) ) (setq x nil)) x) long_lst))

nnzj

感谢各位老师的帮助，还想找个简单方法，还有函数教程说明很多不明白像下这函数组合书上可没有哦
(vl-remove nil (mapcar '(lambda (x) (if (not (= (car x) 项目) ) (setq x nil)) x) long_lst))
一、数据列表格式如下：
(setq lst (list '("项目 兰花 位置" " 项目 树木 位置" "项目1 兰花 位置" "项目1 树木 位置" "项目2 草地 面积" "名称 价格" "部位1" "部位2")))
研究了各位老师的提示，函数并不知到怎么组合直接按条件"项目"或"位置"直接得到新表：
("项目 兰花 位置" "项目 树木 位置" "项目1 兰花 位置" "项目1 树木 位置")
二、通过明经取得的函数采用变通
(setq lst (list '("项目 兰花 位置" " 项目 树木 位置" "项目1 兰花 位置" "项目1 树木 位置" "项目2 草地 面积" "名称 价格" "部位1" "部位2")))
  1、 先用函数  把字符串转为按分隔符转换为表
     如："项目 兰花 位置"  转为表  ("项目" "兰花" "位置")
2、再用
    (vl-remove-if-not '(lambda(x) (member "位置" x)) lst)
3、取得新表
    结果：(("项目1" "树木" "位置") ("项目1" "兰花" "位置") ("项目" "树木" "位置") ("项目" "兰花" "位置"))
4、再用函数  将一个字符串列表解析为1个具有分隔符的字符串
    结果：("项目 兰花 位置" "项目 树木 位置" "项目1 兰花 位置" "项目1 树木 位置")
  三、请教老师的是用简单的函数直接得到第4、步的新表。

ll_j

nnzj 发表于 2014-11-21 00:31
感谢各位老师的帮助，还想找个简单方法，还有函数教程说明很多不明白像下这函数组合书上可没有哦
(vl-remo ...

(vl-remove nil (mapcar... 一句是去除表中的nil（空）项，mapcar函数出来的结果是把长表中第一项不是项目（应该是字符串"项目"）的项设为nil，随后去除这些空项，这是针对1楼的表的用法。
一、命令: (vl-remove-if-not '(lambda (x) (wcmatch x "项目 *,项目1 *")) lst)
("项目 兰花 位置" "项目 树木 位置" "项目1 兰花 位置" "项目1 树木 位置")
说明一下，楼主给出的lst应该直接是(setq lst '("项目.... ，list函数多余了，表中第二项前面多一个空格。
二、三、命令: (mapcar '(lambda (x) (strcat (car x) " " (cadr x) " " (caddr x))) lst1)
("项目1 树木 位置" "项目1 兰花 位置" "项目 树木 位置" "项目 兰花 位置")