日志
1年前在明经发表的用动态规划法求最优解的程序
热度 1 |
;;;========================================================================================================================
;;;电站建设问题
;;;背景：某电力系统拟建三座大型水电站，通过设计负荷水平年和枯水年的电力电量平衡计算，确定水电站群的总装机容量为280万kw；
;;;根据投资估算和经济分析，各电站可选择的装机容量变化范围及部分装机容量相应的费用列表如下：
;;;---------------------------------------------------------------------------------------------------|
;;;| \费用 | |
;;;| \(亿元)| 装机容量 (万kw) |
;;;|序号 \ | |
;;;----------------------------------------------------------------------------------------------------
;;;| | 50 | 60 | 70 | 80 | 90 | 100 | 110 | 120 | 130 |
;;;| 电站1 | 1.600 | 1.610 | 1.622 | 1.635 | 1.650 | 1.670 | | | |
;;;| 电站2 | | 1.800 | 1.814 | 1.832 | 1.852 | 1.875 | 1.900 | | |
;;;| 电站3 | | | | 1.700 | 1.720 | 1.743 | 1.770 | 1.800 | 1.835 |
;;;----------------------------------------------------------------------------------------------------
;;;问题：如何合理地分配水电站群内各电站的装机容量，使系统的总费用为最小？
;;;要求：建立该问题的数学模型，并编写程序计算，尽量使程序通用。可任选程序设计语言实现，
;;; 但不允许直接使用MATLAB、LINGO等具有优化计算功能的数学软件包。
;;;提示：可以采用线性规划、整数规划、非线性规划或动态规划等方法求解。
;;;========================================================================================================================
;;;此程序使用动态规划方法设计算法求取最优解，本程序所用到的很多子函数不仅能够针对性的解决此类问题，同时在其他的cad二次开发
;;;也可能用到，如函数dimequal用于比较2个对象是否相同，又如删除某列表指定成员的函数SurePosition等等，不再一一举例。本程序分
;;;为3大部分，第一部分：格式转换函数Formatconvert；第二部分：也是程序主体部分，用动态规划法获得最优解；第三部分：第二部分
;;;获得到的最优解需要人工查询才能找到，第三部分查询函数search是对程序的进一步改进，自动将最优解打印到cad模型空间中。
;;;
;;;本程序所能解决的问题:
;;;1.对于任意个电站的任意设定的总装机容量数都能求取最优解。
;;;
;;;使用本程序需注意事项：
;;;1.本程序的excel表格数据费用一栏，只允许为空或者数字，不允许为其它非法字符。
;;;2.从解决问题的实际出发，不允许在装机容量的变化范围内出现装机容量为0的情况。事实上，实际问题中不会出现装机容量为0的情况。
;;;3.本程序中的excel路径参数由excelFile="F:\\CAD\\book1.xls"，sheetName="BOM"，RangeStr="C3:K6"定义，位于Formatconvert函数前
;;; 三行，如果路径有变请修改此三项参数。
;;;
;;;作者：非常道，武汉大学水利水电学院水利水电工程专业毕业，目前代表作有《百灵工具箱》，此工具箱专为实现水利水电工程自动化而
;;;设计的一款软件,欢迎各位朋友关注此软件，程序交流请加QQ群：124737196
(setq HS_TotalCapacity 280);;此参数用于确定电站总装机容量。
(setq Extremevalue_add 10);;此变量的设置是为了满足HS_Data第一个列表的变化范围为HS_si的一个子集。存在于Extremevalue函数中。
;;;(setq HS_Data '((50 60 70 80 90 100 110 120 130)
;;; (1.600 1.610 1.622 1.635 1.650 1.670 nil nil nil)
;;; (nil 1.800 1.814 1.832 1.852 1.875 1.900 nil nil)
;;; (nil nil nil 1.700 1.720 1.743 1.770 1.800 1.835)
;;; )
;;;)
;;;第一部分将excel中的数据读入到程序中，并转化为上表的文件格式========================================================
;;;===================================================================================================================
(defun GetCellValueAsList (excelFile sheetName RangeStr
/ xl wbs wb shs
sh rg cs vvv nms
nm ttt
)
(vl-load-com)
(setq xl (vlax-get-or-create-object "Excel.Application"))
;;创建excel程序对象
(setq wbs (vlax-get-property xl "WorkBooks"))
;;获取excel程序对象的工作簿集合对象
(setq wb (vlax-invoke-method wbs "open" excelFile))
;;用工作簿集合对象打开指定的excel文件
(setq shs (vlax-get-property wb "Sheets"))
;;获取刚才打开工作簿的工作表集合
(setq sh (vlax-get-property shs "Item" sheetName)) ;获取指定的工作表
(setq rg (vlax-get-property sh "Range" RangeStr))
;;用指定的字符串创建工作表范围对象
(setq vvv (vlax-get-property rg 'Value)) ;获取范围对象的值
(setq ttt (vlax-safearray->list (vlax-variant-value vvv)))
;;转换为list
(vlax-invoke-method wb "Close")
;;关闭工作簿
(vlax-invoke-method xl "Quit")
;;推出excel对象
(vlax-release-object xl)
;;释放excel对象
(setq ret ttt)
)
(defun Formatconvert(/ excelFile sheetName RangeStr orginallist Formatconvert_i orginallistf
Formatconvert_everyline Formatconvert_everylinef Formatconvert_j Formatconvert_everyelement)
(setq excelFile (getfiled "坐标" "F:\\CAD\\book1.xls" "xls" 2))
(setq sheetName "BOM")
(setq RangeStr "C3:K6")
(setq orginallist (GetCellValueAsList excelFile sheetName RangeStr))
(setq Formatconvert_i 0)
(setq orginallistf nil)
(repeat (length orginallist)
(setq Formatconvert_everyline (nth Formatconvert_i orginallist))
(setq Formatconvert_everylinef nil)
(setq Formatconvert_j 0)
(repeat (length Formatconvert_everyline)
(setq Formatconvert_everyelement (vlax-variant-value (nth Formatconvert_j Formatconvert_everyline)))
(if (= Formatconvert_everyelement 0) (setq Formatconvert_everyelement nil));;对于位置上为0的转化为nil
(setq Formatconvert_everylinef (cons Formatconvert_everyelement Formatconvert_everylinef))
(setq Formatconvert_j (1+ Formatconvert_j))
)
(setq Formatconvert_everylinef (reverse Formatconvert_everylinef))
(setq orginallistf (cons Formatconvert_everylinef orginallistf))
(setq Formatconvert_i (1+ Formatconvert_i))
)
(reverse orginallistf)
)
;;;第一部分结束===================================================================================================
;;;===============================================================================================================
;;;第二部分开始===================================================================================================
;;;===============================================================================================================
(defun C:HS ()
(setvar "cmdecho" 0)
(setq HS_Data (Formatconvert))
(setq HS_i 1)
(setq HS_x (nth 0 HS_Data))
;;;第一部分：
(setq HS_totallist1 nil)
(setq HS_si (deallist nil HS_x (nth (1- (length HS_Data)) HS_Data)))
;;排列最后一个电站的装机容量可能取值数组
(setq HS_xi (deallist nil HS_x (nth (1- (length HS_Data)) HS_Data)))
;;排列最后一个电站的装机容量数组
(setq HS_fsi (SurePosition nil (nth (1- (length HS_Data)) HS_Data)))
;;排列最后一个电站的费用数组
(setq HS_xi* HS_xi)
(setq HS_MINlist_element-indexlist/listf (jointlist HS_fsi HS_xi*))
;;取值所对应的排列最后一个电站的装机容量
(setq HS_totallist1
(cons HS_si
(cons HS_xi
(cons HS_MINlist_element-indexlist/listf HS_totallist1)
)
)
)
(setq HS_totallist2 nil)
;;;第二部分：
(repeat (- (length HS_Data) 2)
(setq HS_i (1+ HS_i))
(setq HS_listmid nil)
(setq HS_xif (nth (- (length HS_Data) HS_i) HS_Data))
(setq HS_xiff (nth (- (1+ (length HS_Data)) HS_i) HS_Data))
;;某个电站的费用数组
(setq HS_xi (deallist nil HS_x HS_xif))
(setq HS_flectlist HS_si)
;;某个电站的装机容量变化范围
(cond ((> (- (length HS_Data) HS_i) 1)
(setq HS_si (Extremevalue HS_xi HS_si HS_TotalCapacity))
)
((= (- (length HS_Data) HS_i) 1)
(setq HS_si (cons HS_TotalCapacity nil))
)
)
(setq HS_MINlist_element-indexlist/list nil)
;;;当前电站的可能取值数组
(setq HS_j 0)
(repeat (length HS_si)
(setq HS_sij (nth HS_j HS_si))
(setq HS_k 0)
(setq HS_Costlist nil)
(setq HS_xlist nil)
(repeat (length HS_xi)
(setq HS_xik (nth HS_k HS_xi))
(setq HS_arg (- HS_sij HS_xik))
(cond ((<= HS_arg 0) (setq HS_Cost nil))
((> HS_arg 0)
(cond ((/= (Judgenumber HS_arg HS_flectlist) nil)
(setq HS_Cost
(+ (nth
(lbsy HS_xik HS_x)
HS_xif
)
(nth 0
(nth
(lbsy (Judgenumber HS_arg HS_flectlist)
HS_flectlist
)
HS_MINlist_element-indexlist/listf
)
)
)
)
)
((= (Judgenumber HS_arg HS_flectlist) nil)
(setq HS_Cost nil)
)
)
)
)
;;endcond
(setq HS_k (1+ HS_k))
(setq HS_Costlist (cons HS_Cost HS_Costlist))
)
;;endrepeat
(setq HS_Costlist (reverse HS_Costlist))
(setq HS_MINlist_element-indexlist/list
(cons
(MINlist HS_Costlist)
HS_MINlist_element-indexlist/list
)
)
(setq HS_j (1+ HS_j))
)
;;(MINlist HS_Costlist)运行后为nil的位置进行清除，更新HS_si及(MINlist HS_Costlist)运行后产生的数组，以准备进行下一次关于HS_si的运算。
(setq HS_MINlist_element-indexlist/list
(reverse
HS_MINlist_element-indexlist/list
)
)
(setq HS_MINlist_element-indexlist/listf
HS_MINlist_element-indexlist/list
)
(setq HS_si (deallist '(nil nil)
HS_si
HS_MINlist_element-indexlist/list
)
)
(setq HS_MINlist_element-indexlist/list
(Convertcapacity
(SurePosition
'(nil nil)
HS_MINlist_element-indexlist/list
)
HS_xi
)
)
(setq HS_listmid
(cons
HS_xi
(cons
HS_si
(cons HS_MINlist_element-indexlist/list HS_listmid)
)
)
)
;;第二部分某个电站包含HS_xi，HS_si，HS_fsi，HS_xi*的列表
(setq HS_totallist2 (cons HS_listmid HS_totallist2))
(setq HS_totallist2 (reverse HS_totallist2))
;;总表第二部分所有电站的信息
)
(setq HS_totallist2 (cons HS_totallist1 HS_totallist2))
(search HS_totallist2)
(prin1)
)
;;;(jointlist '(12 23) '(12 23));测试用数据
;;;把HS_fsi，HS_xi*合并成一个HS_MINlist_element-indexlist/list格式的数组
;;;第一个数组为HS_fsi，第二个数组为HS_xi*。
(defun jointlist (HS_fsi HS_xi* /
jointlist_i jointlist_list1 jointlist_list2
jointlist_list3
)
(setq jointlist_i 0)
(setq jointlist_list3 nil)
(repeat (length HS_fsi)
(setq jointlist_list1 nil)
(setq jointlist_list2 nil)
(setq jointlist_list1
(cons (nth jointlist_i HS_xi*) jointlist_list1)
)
(setq jointlist_list2
(cons (nth jointlist_i HS_fsi)
(cons jointlist_list1 jointlist_list2)
)
)
(setq jointlist_list3 (cons jointlist_list2 jointlist_list3))
(setq jointlist_i (1+ jointlist_i))
)
(reverse jointlist_list3)
)
;;;(setq Convertcapacity_list '((3.5 (0)) (3.595 (4)) (3.735 (5))))
;;;(setq Convertcapacity_xilist '(120 130 140 180 190 200 210));测试用数据
;;;把HS_MINlist_element-indexlist/list的列表化成HS_MINlist_element-Capacitylist/list
(defun Convertcapacity (Convertcapacity_list
Convertcapacity_xilist
/
Convertcapacity_element
Convertcapacity_i
Convertcapacity_j
Convertcapacity_xi*f
Convertcapacity_xi*
Convertcapacity_fsi
Convertcapacity_totallist
Convertcapacity_listf
)
(setq Convertcapacity_i 0)
(if Convertcapacity_list
(progn
(setq Convertcapacity_totallist nil)
(repeat (length Convertcapacity_list)
(setq Convertcapacity_list* nil)
(setq Convertcapacity_element
(nth Convertcapacity_i
Convertcapacity_list
)
)
(setq Convertcapacity_fsi (nth 0 Convertcapacity_element))
(setq Convertcapacity_xi*f (nth 1 Convertcapacity_element))
(if (/= Convertcapacity_xi*f '(nil nil))
(progn
(setq Convertcapacity_j 0)
(setq Convertcapacity_listf nil)
(repeat (length Convertcapacity_xi*f)
(setq Convertcapacity_xi*
(nth (nth Convertcapacity_j
Convertcapacity_xi*f
)
Convertcapacity_xilist
)
)
(setq Convertcapacity_listf
(cons Convertcapacity_xi*
Convertcapacity_listf
)
)
(setq Convertcapacity_j (1+ Convertcapacity_j))
)
(setq Convertcapacity_listf (reverse Convertcapacity_listf))
)
)
(setq Convertcapacity_list*
(cons Convertcapacity_fsi
(cons Convertcapacity_listf
Convertcapacity_list*
)
)
)
(setq Convertcapacity_totallist
(cons Convertcapacity_list*
Convertcapacity_totallist
)
)
(setq Convertcapacity_i (1+ Convertcapacity_i))
)
)
)
(reverse Convertcapacity_totallist)
)
;;;(setq MINlist_list '(3.52 3.514 nil nil nil nil))
;;;(MINlist '(nil nil nil))用于测试
;;;对包含nil成员的数组进行求费用最小值及其位置，如果数组中所有成员都为nil则返回值为nil，如果成员不都是nil则返回费用最小值及其位置。
(defun MINlist (MINlist_list /
MINlist_minlist MINlist_elementlist
MINlist_i MINlist_element
MINlist_indexlist MINlist_element-indexlist
MINlist_listf
)
(setq MINlist_listf (SurePosition nil MINlist_list))
(cond
((/= MINlist_listf nil)
(progn
(setq MINlist_minlist nil)
(setq MINlist_elementlist nil)
(setq MINlist_element-indexlist nil)
(cond
((= (length MINlist_listf) 1)
(setq MINlist_element (nth 0 MINlist_listf))
)
((> (length MINlist_listf) 1)
(progn
(setq MINlist_i 0)
(setq MINlist_element (nth MINlist_i MINlist_listf))
(repeat (length MINlist_listf)
(if
(>= MINlist_element (nth MINlist_i MINlist_listf))
(setq MINlist_element
(nth MINlist_i MINlist_listf)
)
)
(setq MINlist_i (1+ MINlist_i))
)
)
)
)
;;endcond
(cond ((/= MINlist_element nil)
(setq MINlist_indexlist
(index MINlist_element MINlist_list)
)
)
((= MINlist_element nil)
(setq MINlist_indexlist nil)
)
)
(setq MINlist_element-indexlist
(cons MINlist_element
(cons MINlist_indexlist
MINlist_element-indexlist
)
)
)
)
)
((= MINlist_listf nil)
(setq MINlist_element-indexlist '(nil nil))
)
)
MINlist_element-indexlist
)
;;;求列表索引，用于求在MINlist_list数组中成员element的位置，有可能相同，返回他们位置的数组。
(defun index (element MINlist_list / MINlist_i MINlist_indexlist)
(setq MINlist_i 0)
(setq MINlist_indexlist nil)
(repeat (length MINlist_list)
(if (= (nth MINlist_i MINlist_list) element)
(setq MINlist_indexlist (cons MINlist_i MINlist_indexlist))
)
(setq MINlist_i (1+ MINlist_i))
)
(reverse MINlist_indexlist)
)
;;;对包含nil成员的数组进行求和。如果数组中所有成员都为nil则返回值为nil，如果成员不都是nil则返回这些成员之和。
(defun SUMlist (SUMlist_list / SUMlist_i SUMlist_sum SUMlist_j)
(setq SUMlist_i 0)
(setq SUMlist_j 0)
(setq SUMlist_sum 0)
(repeat (length SUMlist_list)
(if (/= (nth SUMlist_i SUMlist_list) nil)
(setq SUMlist_sum (+ SUMlist_sum (nth SUMlist_i SUMlist_list)))
)
(if (= (nth SUMlist_i SUMlist_list) nil)
(setq SUMlist_j (1+ SUMlist_j))
)
(setq SUMlist_i (1+ SUMlist_i))
)
(cond ((= SUMlist_j (length SUMlist_list))
(setq SUMlist_sum SUMlist_sum)
)
((/= SUMlist_j (length SUMlist_list))
(setq SUMlist_sum nil)
)
)
)
;;;求列表索引，intatom
(defun lbsy (intatom l1 / syz)
(if (/= (member intatom l1) nil)
(setq syz (- (length l1) (length (member intatom l1))))
)
syz
)
;;判断某数是否为某数组成员，如果是则返回原数，不是则返回nil.
(defun Judgenumber
(Judgenumber_number Judgenumber_list / Judgenumber_numberf)
(cond ((/= (member Judgenumber_number Judgenumber_list) nil)
(setq Judgenumber_numberf Judgenumber_number)
)
((= (member Judgenumber_number Judgenumber_list) nil)
(setq Judgenumber_numberf nil)
)
)
Judgenumber_numberf
)
;;;(deallist 'nil '(4 5 6 7) '(1 2 nil 3));测试用数据
;;;如果某电站不存在某个装机容量，就把该装机容量对应的HS_Data第一行的所对应的数置为空。
;;;已知两个维度相同的数组，其中一个数组有数值为nil的成员，把与数值为nil的成员的相同位置上的数值也置为nil。
;;;其中第一个数组没有空值，第二个数组可能有空值。
;;;此函数主要用于求取数组HS_xi
(defun deallist
(deallist_goal deallist_list1 deallist_list2
/ deallist_list deallist_i
)
(setq deallist_list nil)
(setq deallist_i 0)
(repeat (length deallist_list2)
(if (= (dimequal (nth deallist_i deallist_list2) deallist_goal)
nil
)
(setq deallist_list
(cons (nth deallist_i deallist_list1)
deallist_list
)
)
)
(setq deallist_i (1+ deallist_i))
)
(reverse deallist_list)
)
;;;(setq Extremevalue_list1 '(40 50 60 70))
;;;(setq Extremevalue_list2 '(30 50 90 60))
;;;(setq HS_TotalCapacity 280)用于测试
;;;以下代码用于参数HS_si的确定
;;;==========================================================================================================
;;以下函数用于求2个数组最值参数Extremevalue_list1，Extremevalue_list2为任意顺序(不一定从小到大排列)的数据。
;;;==========================================================================================================
(defun Extremevalue (Extremevalue_list1
Extremevalue_list2
HS_TotalCapacity
/
Extremevalue_valuelist
Extremevalue_value1
Extremevalue_value2
Extremevalue_add
Extremevalue_re
Extremevalue_value
)
(if (and Extremevalue_list1 Extremevalue_list2)
(progn
(setq Extremevalue_valuelist nil)
(setq Extremevalue_list1 (SurePosition nil Extremevalue_list1))
;Extremevalue_list1去空值
(setq Extremevalue_list2 (SurePosition nil Extremevalue_list2))
;Extremevalue_list2去空值
(setq Extremevalue_list1
(vl-sort Extremevalue_list1
(function (lambda (e1 e2)
(< e1 e2)
)
)
)
) ;Extremevalue_list1从小到大排列
(setq Extremevalue_list2
(vl-sort Extremevalue_list2
(function (lambda (e1 e2)
(< e1 e2)
)
)
)
) ;Extremevalue_list2从小到大排列
(setq Extremevalue_value1 nil)
(setq Extremevalue_value1
(+ (nth 0
Extremevalue_list1
)
(nth 0
Extremevalue_list2
)
)
) ;求最小值
(setq Extremevalue_value2 nil)
(setq Extremevalue_value2
(+ (nth (1- (length Extremevalue_list1))
Extremevalue_list1
)
(nth (1- (length Extremevalue_list2))
Extremevalue_list2
)
)
) ;求最大值
(if (> Extremevalue_value2 HS_TotalCapacity)
(setq Extremevalue_value2 HS_TotalCapacity)
)
(setq Extremevalue_re
(- (1+ (fix (/ Extremevalue_value2 10)))
(fix (/ Extremevalue_value1 10))
)
)
(setq Extremevalue_value (* (fix (/ Extremevalue_value1 10)) 10))
(repeat Extremevalue_re
(setq Extremevalue_valuelist
(cons Extremevalue_value
Extremevalue_valuelist
)
)
(setq Extremevalue_value
(+ Extremevalue_value Extremevalue_add)
)
)
)
)
(reverse Extremevalue_valuelist)
)
;;;(setq SurePosition_zddx '(nil nil))
;;;(setq SurePosition_l2 '(nil (nil nil) 1 2));;SurePosition测试用数据
;;;删除指定成员,SurePosition_zddx---->指定成员，SurePosition_l2---->指定数组
(defun SurePosition (SurePosition_zddx SurePosition_l2
/ SurePosition_i
SurePosition_nl2
)
(setq SurePosition_i 0)
(setq SurePosition_nl2 nil)
(repeat (length SurePosition_l2)
(if
(or
(and (atom SurePosition_zddx)
(/= (nth SurePosition_i SurePosition_l2) SurePosition_zddx)
)
(and (listp SurePosition_zddx)
(>= (length SurePosition_zddx) 1)
(= (dimequal (nth SurePosition_i SurePosition_l2)
SurePosition_zddx
)
nil
)
)
)
(setq SurePosition_nl2
(cons (nth SurePosition_i SurePosition_l2)
SurePosition_nl2
)
)
)
(setq SurePosition_i (1+ SurePosition_i))
)
(reverse SurePosition_nl2)
)
;;;=======================================================================================================
;;;(setq dimequal_list1 '(nil nil nil))
;;;(setq dimequal_list2 '(nil nil nil));dimequal函数测试数据
;;;比较两个列表或者原子是否相等
(defun dimequal (dimequal_list1 dimequal_list2
/ dimequal_i
dimequal_menssage
)
(setq dimequal_menssage T)
(cond ((and (listp dimequal_list1) (listp dimequal_list2))
(cond ((/= (length dimequal_list1) (length dimequal_list2))
(setq dimequal_menssage nil)
)
((and (> (length dimequal_list1) 0)
(= (length dimequal_list1) (length dimequal_list2))
)
(progn
(setq dimequal_i 0)
(while (and (/= dimequal_menssage nil)
(<= dimequal_i (length dimequal_list1))
)
(if (/= (nth dimequal_i dimequal_list1)
(nth dimequal_i dimequal_list2)
)
(setq dimequal_menssage nil)
)
(setq dimequal_i (1+ dimequal_i))
)
)
)
)
;;endcond
)
((or (and (= (listp dimequal_list1) nil)
(/= (listp dimequal_list2) nil)
)
(and (/= (listp dimequal_list1) nil)
(= (listp dimequal_list2) nil)
)
)
(setq dimequal_menssage nil)
)
)
;;endcond
dimequal_menssage
)
;;;第三部分开始，查询以下格式的数据===========================================================================================
;;;(setq search_list
;;; '(((80 90 100 110 120 130)
;;; (80 90 100 110 120 130)
;;; ((1.7 (80))
;;; (1.72 (90))
;;; (1.743 (100))
;;; (1.77 (110))
;;; (1.8 (120))
;;; (1.835 (130))
;;; )
;;; )
;;; ((60 70 80 90 100 110)
;;; (140 150 160 170 180 190 200 210 220 230 240)
;;; ((3.5 (60))
;;; (3.514 (70))
;;; (3.532 (80))
;;; (3.552 (80 90))
;;; (3.572 (90))
;;; (3.595 (100))
;;; (3.618 (100))
;;; (3.643 (110))
;;; (3.67 (110))
;;; (3.7 (110))
;;; (3.735 (110))
;;; )
;;; )
;;; ((50 60 70 80 90 100)
;;; (280)
;;; ((5.242 (100))
;;; )
;;; )
;;; )
;;;)
;;;对HS_totallist1，HS_totallist2的数据进行查询得到最低费用数组。
(defun search (search_list /
search_constant search_list
search_i search_pt
search_midlist search_midlist_children1
search_midlist_children2 search_midlist_children3
search_slist* search_midlist_children3xi*
search_j search_slist*f
search_slist*positionf search_s*
search_ptsi search_cut
search_midlist_children3next
search_k search_x*
search_midlist_children2next
)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq search_constant 0.1) ;;位置偏转角度参数
(setq search_list (reverse search_list)) ;;将第二部分获得到的列表翻转
(setq search_i 0) ;;总运行次数控制参数
(setq search_pt (polar '(0 0 0) (* pi 0.25) 50)) ;;打印位置基准点
;;;(vl-cmdf "donut" 0 0.1 search_pt "")
(repeat (1- (length search_list))
(setq search_midlist (nth search_i search_list))
(setq search_midlist_children1 (nth 0 search_midlist))
(setq search_midlist_children2 (nth 1 search_midlist))
(setq search_midlist_children3 (nth 2 search_midlist))
(if (= search_i 0)
(setq search_slist* search_midlist_children2)
)
(if (= search_i 0)
(progn
(setq search_midlist_children3xi*
(nth 1
(nth 0
search_midlist_children3
)
)
)
)
)
(setq search_j 0)
(setq search_slist*f nil)
(setq search_slist*positionf nil)
(repeat (length search_slist*)
(setq search_s* (nth search_j search_slist*))
(cond ((= search_i 0)
(progn
(setq search_ptsi
(polar search_pt
(* pi search_constant search_j)
50
)
)
;;;(vl-cmdf "donut" 0 0.5 search_ptsi "")
(vl-cmdf "text"
search_ptsi
10
0
(strcat "S" (rtos search_s*))
)
(vl-cmdf "line" search_pt search_ptsi "")
)
)
((> search_i 0)
(setq search_ptsi (nth search_j search_slist*position))
)
)
(setq search_k 0)
(if (> search_i 0)
(setq search_midlist_children3xi*
(nth 1
(nth (lbsy
search_s*
search_midlist_children2next
)
search_midlist_children3
)
)
)
)
(repeat (length search_midlist_children3xi*)
(setq search_ptxi
(polar search_ptsi
(* pi search_constant search_k)
50
)
)
(setq search_ptsi
(polar search_ptxi
(* pi search_constant)
50
)
)
(setq search_slist*positionf
(cons search_ptsi
search_slist*positionf
)
)
(setq search_x* (nth search_k search_midlist_children3xi*))
;;; (vl-cmdf "donut" 0 0.1 search_ptxi "")
(vl-cmdf "text"
search_ptxi
10
0
(strcat "X" (rtos search_x*))
)
(vl-cmdf "line" search_ptsi search_ptxi "")
(setq search_cut (- search_s* search_x*))
(setq search_slist*f (cons search_cut search_slist*f))
;;; (vl-cmdf "donut" 0 0.5 search_ptsi "")
(vl-cmdf "text"
search_ptsi
10
0
(strcat "S" (rtos search_cut))
)
(vl-cmdf "line" search_ptxi search_ptsi "")
(setq search_midlist_children2next
(nth 1
(nth (1+ search_i) search_list)
)
)
(setq search_midlist_children3next
(nth 2
(nth (1+ search_i) search_list)
)
)
(setq search_midlist_children3xi*f
(nth
1
(nth
(lbsy
search_cut
search_midlist_children2next
)
search_midlist_children3next
)
)
)
(setq search_k (1+ search_k))
)
(setq search_j (1+ search_j))
)
(setq search_slist*f (reverse search_slist*f))
(setq search_slist* search_slist*f)
(setq search_slist*positionf (reverse search_slist*positionf))
(setq search_slist*position search_slist*positionf)
(setq search_i (1+ search_i))
)
(setvar "osmode" 0)
(prin1)
)
;;;电站建设问题
;;;背景：某电力系统拟建三座大型水电站，通过设计负荷水平年和枯水年的电力电量平衡计算，确定水电站群的总装机容量为280万kw；
;;;根据投资估算和经济分析，各电站可选择的装机容量变化范围及部分装机容量相应的费用列表如下：
;;;---------------------------------------------------------------------------------------------------|
;;;| \费用 | |
;;;| \(亿元)| 装机容量 (万kw) |
;;;|序号 \ | |
;;;----------------------------------------------------------------------------------------------------
;;;| | 50 | 60 | 70 | 80 | 90 | 100 | 110 | 120 | 130 |
;;;| 电站1 | 1.600 | 1.610 | 1.622 | 1.635 | 1.650 | 1.670 | | | |
;;;| 电站2 | | 1.800 | 1.814 | 1.832 | 1.852 | 1.875 | 1.900 | | |
;;;| 电站3 | | | | 1.700 | 1.720 | 1.743 | 1.770 | 1.800 | 1.835 |
;;;----------------------------------------------------------------------------------------------------
;;;问题：如何合理地分配水电站群内各电站的装机容量，使系统的总费用为最小？
;;;要求：建立该问题的数学模型，并编写程序计算，尽量使程序通用。可任选程序设计语言实现，
;;; 但不允许直接使用MATLAB、LINGO等具有优化计算功能的数学软件包。
;;;提示：可以采用线性规划、整数规划、非线性规划或动态规划等方法求解。
;;;========================================================================================================================
;;;此程序使用动态规划方法设计算法求取最优解，本程序所用到的很多子函数不仅能够针对性的解决此类问题，同时在其他的cad二次开发
;;;也可能用到，如函数dimequal用于比较2个对象是否相同，又如删除某列表指定成员的函数SurePosition等等，不再一一举例。本程序分
;;;为3大部分，第一部分：格式转换函数Formatconvert；第二部分：也是程序主体部分，用动态规划法获得最优解；第三部分：第二部分
;;;获得到的最优解需要人工查询才能找到，第三部分查询函数search是对程序的进一步改进，自动将最优解打印到cad模型空间中。
;;;
;;;本程序所能解决的问题:
;;;1.对于任意个电站的任意设定的总装机容量数都能求取最优解。
;;;
;;;使用本程序需注意事项：
;;;1.本程序的excel表格数据费用一栏，只允许为空或者数字，不允许为其它非法字符。
;;;2.从解决问题的实际出发，不允许在装机容量的变化范围内出现装机容量为0的情况。事实上，实际问题中不会出现装机容量为0的情况。
;;;3.本程序中的excel路径参数由excelFile="F:\\CAD\\book1.xls"，sheetName="BOM"，RangeStr="C3:K6"定义，位于Formatconvert函数前
;;; 三行，如果路径有变请修改此三项参数。
;;;
;;;作者：非常道，武汉大学水利水电学院水利水电工程专业毕业，目前代表作有《百灵工具箱》，此工具箱专为实现水利水电工程自动化而
;;;设计的一款软件,欢迎各位朋友关注此软件，程序交流请加QQ群：124737196
(setq HS_TotalCapacity 280);;此参数用于确定电站总装机容量。
(setq Extremevalue_add 10);;此变量的设置是为了满足HS_Data第一个列表的变化范围为HS_si的一个子集。存在于Extremevalue函数中。
;;;(setq HS_Data '((50 60 70 80 90 100 110 120 130)
;;; (1.600 1.610 1.622 1.635 1.650 1.670 nil nil nil)
;;; (nil 1.800 1.814 1.832 1.852 1.875 1.900 nil nil)
;;; (nil nil nil 1.700 1.720 1.743 1.770 1.800 1.835)
;;; )
;;;)
;;;第一部分将excel中的数据读入到程序中，并转化为上表的文件格式========================================================
;;;===================================================================================================================
(defun GetCellValueAsList (excelFile sheetName RangeStr
/ xl wbs wb shs
sh rg cs vvv nms
nm ttt
)
(vl-load-com)
(setq xl (vlax-get-or-create-object "Excel.Application"))
;;创建excel程序对象
(setq wbs (vlax-get-property xl "WorkBooks"))
;;获取excel程序对象的工作簿集合对象
(setq wb (vlax-invoke-method wbs "open" excelFile))
;;用工作簿集合对象打开指定的excel文件
(setq shs (vlax-get-property wb "Sheets"))
;;获取刚才打开工作簿的工作表集合
(setq sh (vlax-get-property shs "Item" sheetName)) ;获取指定的工作表
(setq rg (vlax-get-property sh "Range" RangeStr))
;;用指定的字符串创建工作表范围对象
(setq vvv (vlax-get-property rg 'Value)) ;获取范围对象的值
(setq ttt (vlax-safearray->list (vlax-variant-value vvv)))
;;转换为list
(vlax-invoke-method wb "Close")
;;关闭工作簿
(vlax-invoke-method xl "Quit")
;;推出excel对象
(vlax-release-object xl)
;;释放excel对象
(setq ret ttt)
)
(defun Formatconvert(/ excelFile sheetName RangeStr orginallist Formatconvert_i orginallistf
Formatconvert_everyline Formatconvert_everylinef Formatconvert_j Formatconvert_everyelement)
(setq excelFile (getfiled "坐标" "F:\\CAD\\book1.xls" "xls" 2))
(setq sheetName "BOM")
(setq RangeStr "C3:K6")
(setq orginallist (GetCellValueAsList excelFile sheetName RangeStr))
(setq Formatconvert_i 0)
(setq orginallistf nil)
(repeat (length orginallist)
(setq Formatconvert_everyline (nth Formatconvert_i orginallist))
(setq Formatconvert_everylinef nil)
(setq Formatconvert_j 0)
(repeat (length Formatconvert_everyline)
(setq Formatconvert_everyelement (vlax-variant-value (nth Formatconvert_j Formatconvert_everyline)))
(if (= Formatconvert_everyelement 0) (setq Formatconvert_everyelement nil));;对于位置上为0的转化为nil
(setq Formatconvert_everylinef (cons Formatconvert_everyelement Formatconvert_everylinef))
(setq Formatconvert_j (1+ Formatconvert_j))
)
(setq Formatconvert_everylinef (reverse Formatconvert_everylinef))
(setq orginallistf (cons Formatconvert_everylinef orginallistf))
(setq Formatconvert_i (1+ Formatconvert_i))
)
(reverse orginallistf)
)
;;;第一部分结束===================================================================================================
;;;===============================================================================================================
;;;第二部分开始===================================================================================================
;;;===============================================================================================================
(defun C:HS ()
(setvar "cmdecho" 0)
(setq HS_Data (Formatconvert))
(setq HS_i 1)
(setq HS_x (nth 0 HS_Data))
;;;第一部分：
(setq HS_totallist1 nil)
(setq HS_si (deallist nil HS_x (nth (1- (length HS_Data)) HS_Data)))
;;排列最后一个电站的装机容量可能取值数组
(setq HS_xi (deallist nil HS_x (nth (1- (length HS_Data)) HS_Data)))
;;排列最后一个电站的装机容量数组
(setq HS_fsi (SurePosition nil (nth (1- (length HS_Data)) HS_Data)))
;;排列最后一个电站的费用数组
(setq HS_xi* HS_xi)
(setq HS_MINlist_element-indexlist/listf (jointlist HS_fsi HS_xi*))
;;取值所对应的排列最后一个电站的装机容量
(setq HS_totallist1
(cons HS_si
(cons HS_xi
(cons HS_MINlist_element-indexlist/listf HS_totallist1)
)
)
)
(setq HS_totallist2 nil)
;;;第二部分：
(repeat (- (length HS_Data) 2)
(setq HS_i (1+ HS_i))
(setq HS_listmid nil)
(setq HS_xif (nth (- (length HS_Data) HS_i) HS_Data))
(setq HS_xiff (nth (- (1+ (length HS_Data)) HS_i) HS_Data))
;;某个电站的费用数组
(setq HS_xi (deallist nil HS_x HS_xif))
(setq HS_flectlist HS_si)
;;某个电站的装机容量变化范围
(cond ((> (- (length HS_Data) HS_i) 1)
(setq HS_si (Extremevalue HS_xi HS_si HS_TotalCapacity))
)
((= (- (length HS_Data) HS_i) 1)
(setq HS_si (cons HS_TotalCapacity nil))
)
)
(setq HS_MINlist_element-indexlist/list nil)
;;;当前电站的可能取值数组
(setq HS_j 0)
(repeat (length HS_si)
(setq HS_sij (nth HS_j HS_si))
(setq HS_k 0)
(setq HS_Costlist nil)
(setq HS_xlist nil)
(repeat (length HS_xi)
(setq HS_xik (nth HS_k HS_xi))
(setq HS_arg (- HS_sij HS_xik))
(cond ((<= HS_arg 0) (setq HS_Cost nil))
((> HS_arg 0)
(cond ((/= (Judgenumber HS_arg HS_flectlist) nil)
(setq HS_Cost
(+ (nth
(lbsy HS_xik HS_x)
HS_xif
)
(nth 0
(nth
(lbsy (Judgenumber HS_arg HS_flectlist)
HS_flectlist
)
HS_MINlist_element-indexlist/listf
)
)
)
)
)
((= (Judgenumber HS_arg HS_flectlist) nil)
(setq HS_Cost nil)
)
)
)
)
;;endcond
(setq HS_k (1+ HS_k))
(setq HS_Costlist (cons HS_Cost HS_Costlist))
)
;;endrepeat
(setq HS_Costlist (reverse HS_Costlist))
(setq HS_MINlist_element-indexlist/list
(cons
(MINlist HS_Costlist)
HS_MINlist_element-indexlist/list
)
)
(setq HS_j (1+ HS_j))
)
;;(MINlist HS_Costlist)运行后为nil的位置进行清除，更新HS_si及(MINlist HS_Costlist)运行后产生的数组，以准备进行下一次关于HS_si的运算。
(setq HS_MINlist_element-indexlist/list
(reverse
HS_MINlist_element-indexlist/list
)
)
(setq HS_MINlist_element-indexlist/listf
HS_MINlist_element-indexlist/list
)
(setq HS_si (deallist '(nil nil)
HS_si
HS_MINlist_element-indexlist/list
)
)
(setq HS_MINlist_element-indexlist/list
(Convertcapacity
(SurePosition
'(nil nil)
HS_MINlist_element-indexlist/list
)
HS_xi
)
)
(setq HS_listmid
(cons
HS_xi
(cons
HS_si
(cons HS_MINlist_element-indexlist/list HS_listmid)
)
)
)
;;第二部分某个电站包含HS_xi，HS_si，HS_fsi，HS_xi*的列表
(setq HS_totallist2 (cons HS_listmid HS_totallist2))
(setq HS_totallist2 (reverse HS_totallist2))
;;总表第二部分所有电站的信息
)
(setq HS_totallist2 (cons HS_totallist1 HS_totallist2))
(search HS_totallist2)
(prin1)
)
;;;(jointlist '(12 23) '(12 23));测试用数据
;;;把HS_fsi，HS_xi*合并成一个HS_MINlist_element-indexlist/list格式的数组
;;;第一个数组为HS_fsi，第二个数组为HS_xi*。
(defun jointlist (HS_fsi HS_xi* /
jointlist_i jointlist_list1 jointlist_list2
jointlist_list3
)
(setq jointlist_i 0)
(setq jointlist_list3 nil)
(repeat (length HS_fsi)
(setq jointlist_list1 nil)
(setq jointlist_list2 nil)
(setq jointlist_list1
(cons (nth jointlist_i HS_xi*) jointlist_list1)
)
(setq jointlist_list2
(cons (nth jointlist_i HS_fsi)
(cons jointlist_list1 jointlist_list2)
)
)
(setq jointlist_list3 (cons jointlist_list2 jointlist_list3))
(setq jointlist_i (1+ jointlist_i))
)
(reverse jointlist_list3)
)
;;;(setq Convertcapacity_list '((3.5 (0)) (3.595 (4)) (3.735 (5))))
;;;(setq Convertcapacity_xilist '(120 130 140 180 190 200 210));测试用数据
;;;把HS_MINlist_element-indexlist/list的列表化成HS_MINlist_element-Capacitylist/list
(defun Convertcapacity (Convertcapacity_list
Convertcapacity_xilist
/
Convertcapacity_element
Convertcapacity_i
Convertcapacity_j
Convertcapacity_xi*f
Convertcapacity_xi*
Convertcapacity_fsi
Convertcapacity_totallist
Convertcapacity_listf
)
(setq Convertcapacity_i 0)
(if Convertcapacity_list
(progn
(setq Convertcapacity_totallist nil)
(repeat (length Convertcapacity_list)
(setq Convertcapacity_list* nil)
(setq Convertcapacity_element
(nth Convertcapacity_i
Convertcapacity_list
)
)
(setq Convertcapacity_fsi (nth 0 Convertcapacity_element))
(setq Convertcapacity_xi*f (nth 1 Convertcapacity_element))
(if (/= Convertcapacity_xi*f '(nil nil))
(progn
(setq Convertcapacity_j 0)
(setq Convertcapacity_listf nil)
(repeat (length Convertcapacity_xi*f)
(setq Convertcapacity_xi*
(nth (nth Convertcapacity_j
Convertcapacity_xi*f
)
Convertcapacity_xilist
)
)
(setq Convertcapacity_listf
(cons Convertcapacity_xi*
Convertcapacity_listf
)
)
(setq Convertcapacity_j (1+ Convertcapacity_j))
)
(setq Convertcapacity_listf (reverse Convertcapacity_listf))
)
)
(setq Convertcapacity_list*
(cons Convertcapacity_fsi
(cons Convertcapacity_listf
Convertcapacity_list*
)
)
)
(setq Convertcapacity_totallist
(cons Convertcapacity_list*
Convertcapacity_totallist
)
)
(setq Convertcapacity_i (1+ Convertcapacity_i))
)
)
)
(reverse Convertcapacity_totallist)
)
;;;(setq MINlist_list '(3.52 3.514 nil nil nil nil))
;;;(MINlist '(nil nil nil))用于测试
;;;对包含nil成员的数组进行求费用最小值及其位置，如果数组中所有成员都为nil则返回值为nil，如果成员不都是nil则返回费用最小值及其位置。
(defun MINlist (MINlist_list /
MINlist_minlist MINlist_elementlist
MINlist_i MINlist_element
MINlist_indexlist MINlist_element-indexlist
MINlist_listf
)
(setq MINlist_listf (SurePosition nil MINlist_list))
(cond
((/= MINlist_listf nil)
(progn
(setq MINlist_minlist nil)
(setq MINlist_elementlist nil)
(setq MINlist_element-indexlist nil)
(cond
((= (length MINlist_listf) 1)
(setq MINlist_element (nth 0 MINlist_listf))
)
((> (length MINlist_listf) 1)
(progn
(setq MINlist_i 0)
(setq MINlist_element (nth MINlist_i MINlist_listf))
(repeat (length MINlist_listf)
(if
(>= MINlist_element (nth MINlist_i MINlist_listf))
(setq MINlist_element
(nth MINlist_i MINlist_listf)
)
)
(setq MINlist_i (1+ MINlist_i))
)
)
)
)
;;endcond
(cond ((/= MINlist_element nil)
(setq MINlist_indexlist
(index MINlist_element MINlist_list)
)
)
((= MINlist_element nil)
(setq MINlist_indexlist nil)
)
)
(setq MINlist_element-indexlist
(cons MINlist_element
(cons MINlist_indexlist
MINlist_element-indexlist
)
)
)
)
)
((= MINlist_listf nil)
(setq MINlist_element-indexlist '(nil nil))
)
)
MINlist_element-indexlist
)
;;;求列表索引，用于求在MINlist_list数组中成员element的位置，有可能相同，返回他们位置的数组。
(defun index (element MINlist_list / MINlist_i MINlist_indexlist)
(setq MINlist_i 0)
(setq MINlist_indexlist nil)
(repeat (length MINlist_list)
(if (= (nth MINlist_i MINlist_list) element)
(setq MINlist_indexlist (cons MINlist_i MINlist_indexlist))
)
(setq MINlist_i (1+ MINlist_i))
)
(reverse MINlist_indexlist)
)
;;;对包含nil成员的数组进行求和。如果数组中所有成员都为nil则返回值为nil，如果成员不都是nil则返回这些成员之和。
(defun SUMlist (SUMlist_list / SUMlist_i SUMlist_sum SUMlist_j)
(setq SUMlist_i 0)
(setq SUMlist_j 0)
(setq SUMlist_sum 0)
(repeat (length SUMlist_list)
(if (/= (nth SUMlist_i SUMlist_list) nil)
(setq SUMlist_sum (+ SUMlist_sum (nth SUMlist_i SUMlist_list)))
)
(if (= (nth SUMlist_i SUMlist_list) nil)
(setq SUMlist_j (1+ SUMlist_j))
)
(setq SUMlist_i (1+ SUMlist_i))
)
(cond ((= SUMlist_j (length SUMlist_list))
(setq SUMlist_sum SUMlist_sum)
)
((/= SUMlist_j (length SUMlist_list))
(setq SUMlist_sum nil)
)
)
)
;;;求列表索引，intatom
(defun lbsy (intatom l1 / syz)
(if (/= (member intatom l1) nil)
(setq syz (- (length l1) (length (member intatom l1))))
)
syz
)
;;判断某数是否为某数组成员，如果是则返回原数，不是则返回nil.
(defun Judgenumber
(Judgenumber_number Judgenumber_list / Judgenumber_numberf)
(cond ((/= (member Judgenumber_number Judgenumber_list) nil)
(setq Judgenumber_numberf Judgenumber_number)
)
((= (member Judgenumber_number Judgenumber_list) nil)
(setq Judgenumber_numberf nil)
)
)
Judgenumber_numberf
)
;;;(deallist 'nil '(4 5 6 7) '(1 2 nil 3));测试用数据
;;;如果某电站不存在某个装机容量，就把该装机容量对应的HS_Data第一行的所对应的数置为空。
;;;已知两个维度相同的数组，其中一个数组有数值为nil的成员，把与数值为nil的成员的相同位置上的数值也置为nil。
;;;其中第一个数组没有空值，第二个数组可能有空值。
;;;此函数主要用于求取数组HS_xi
(defun deallist
(deallist_goal deallist_list1 deallist_list2
/ deallist_list deallist_i
)
(setq deallist_list nil)
(setq deallist_i 0)
(repeat (length deallist_list2)
(if (= (dimequal (nth deallist_i deallist_list2) deallist_goal)
nil
)
(setq deallist_list
(cons (nth deallist_i deallist_list1)
deallist_list
)
)
)
(setq deallist_i (1+ deallist_i))
)
(reverse deallist_list)
)
;;;(setq Extremevalue_list1 '(40 50 60 70))
;;;(setq Extremevalue_list2 '(30 50 90 60))
;;;(setq HS_TotalCapacity 280)用于测试
;;;以下代码用于参数HS_si的确定
;;;==========================================================================================================
;;以下函数用于求2个数组最值参数Extremevalue_list1，Extremevalue_list2为任意顺序(不一定从小到大排列)的数据。
;;;==========================================================================================================
(defun Extremevalue (Extremevalue_list1
Extremevalue_list2
HS_TotalCapacity
/
Extremevalue_valuelist
Extremevalue_value1
Extremevalue_value2
Extremevalue_add
Extremevalue_re
Extremevalue_value
)
(if (and Extremevalue_list1 Extremevalue_list2)
(progn
(setq Extremevalue_valuelist nil)
(setq Extremevalue_list1 (SurePosition nil Extremevalue_list1))
;Extremevalue_list1去空值
(setq Extremevalue_list2 (SurePosition nil Extremevalue_list2))
;Extremevalue_list2去空值
(setq Extremevalue_list1
(vl-sort Extremevalue_list1
(function (lambda (e1 e2)
(< e1 e2)
)
)
)
) ;Extremevalue_list1从小到大排列
(setq Extremevalue_list2
(vl-sort Extremevalue_list2
(function (lambda (e1 e2)
(< e1 e2)
)
)
)
) ;Extremevalue_list2从小到大排列
(setq Extremevalue_value1 nil)
(setq Extremevalue_value1
(+ (nth 0
Extremevalue_list1
)
(nth 0
Extremevalue_list2
)
)
) ;求最小值
(setq Extremevalue_value2 nil)
(setq Extremevalue_value2
(+ (nth (1- (length Extremevalue_list1))
Extremevalue_list1
)
(nth (1- (length Extremevalue_list2))
Extremevalue_list2
)
)
) ;求最大值
(if (> Extremevalue_value2 HS_TotalCapacity)
(setq Extremevalue_value2 HS_TotalCapacity)
)
(setq Extremevalue_re
(- (1+ (fix (/ Extremevalue_value2 10)))
(fix (/ Extremevalue_value1 10))
)
)
(setq Extremevalue_value (* (fix (/ Extremevalue_value1 10)) 10))
(repeat Extremevalue_re
(setq Extremevalue_valuelist
(cons Extremevalue_value
Extremevalue_valuelist
)
)
(setq Extremevalue_value
(+ Extremevalue_value Extremevalue_add)
)
)
)
)
(reverse Extremevalue_valuelist)
)
;;;(setq SurePosition_zddx '(nil nil))
;;;(setq SurePosition_l2 '(nil (nil nil) 1 2));;SurePosition测试用数据
;;;删除指定成员,SurePosition_zddx---->指定成员，SurePosition_l2---->指定数组
(defun SurePosition (SurePosition_zddx SurePosition_l2
/ SurePosition_i
SurePosition_nl2
)
(setq SurePosition_i 0)
(setq SurePosition_nl2 nil)
(repeat (length SurePosition_l2)
(if
(or
(and (atom SurePosition_zddx)
(/= (nth SurePosition_i SurePosition_l2) SurePosition_zddx)
)
(and (listp SurePosition_zddx)
(>= (length SurePosition_zddx) 1)
(= (dimequal (nth SurePosition_i SurePosition_l2)
SurePosition_zddx
)
nil
)
)
)
(setq SurePosition_nl2
(cons (nth SurePosition_i SurePosition_l2)
SurePosition_nl2
)
)
)
(setq SurePosition_i (1+ SurePosition_i))
)
(reverse SurePosition_nl2)
)
;;;=======================================================================================================
;;;(setq dimequal_list1 '(nil nil nil))
;;;(setq dimequal_list2 '(nil nil nil));dimequal函数测试数据
;;;比较两个列表或者原子是否相等
(defun dimequal (dimequal_list1 dimequal_list2
/ dimequal_i
dimequal_menssage
)
(setq dimequal_menssage T)
(cond ((and (listp dimequal_list1) (listp dimequal_list2))
(cond ((/= (length dimequal_list1) (length dimequal_list2))
(setq dimequal_menssage nil)
)
((and (> (length dimequal_list1) 0)
(= (length dimequal_list1) (length dimequal_list2))
)
(progn
(setq dimequal_i 0)
(while (and (/= dimequal_menssage nil)
(<= dimequal_i (length dimequal_list1))
)
(if (/= (nth dimequal_i dimequal_list1)
(nth dimequal_i dimequal_list2)
)
(setq dimequal_menssage nil)
)
(setq dimequal_i (1+ dimequal_i))
)
)
)
)
;;endcond
)
((or (and (= (listp dimequal_list1) nil)
(/= (listp dimequal_list2) nil)
)
(and (/= (listp dimequal_list1) nil)
(= (listp dimequal_list2) nil)
)
)
(setq dimequal_menssage nil)
)
)
;;endcond
dimequal_menssage
)
;;;第三部分开始，查询以下格式的数据===========================================================================================
;;;(setq search_list
;;; '(((80 90 100 110 120 130)
;;; (80 90 100 110 120 130)
;;; ((1.7 (80))
;;; (1.72 (90))
;;; (1.743 (100))
;;; (1.77 (110))
;;; (1.8 (120))
;;; (1.835 (130))
;;; )
;;; )
;;; ((60 70 80 90 100 110)
;;; (140 150 160 170 180 190 200 210 220 230 240)
;;; ((3.5 (60))
;;; (3.514 (70))
;;; (3.532 (80))
;;; (3.552 (80 90))
;;; (3.572 (90))
;;; (3.595 (100))
;;; (3.618 (100))
;;; (3.643 (110))
;;; (3.67 (110))
;;; (3.7 (110))
;;; (3.735 (110))
;;; )
;;; )
;;; ((50 60 70 80 90 100)
;;; (280)
;;; ((5.242 (100))
;;; )
;;; )
;;; )
;;;)
;;;对HS_totallist1，HS_totallist2的数据进行查询得到最低费用数组。
(defun search (search_list /
search_constant search_list
search_i search_pt
search_midlist search_midlist_children1
search_midlist_children2 search_midlist_children3
search_slist* search_midlist_children3xi*
search_j search_slist*f
search_slist*positionf search_s*
search_ptsi search_cut
search_midlist_children3next
search_k search_x*
search_midlist_children2next
)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq search_constant 0.1) ;;位置偏转角度参数
(setq search_list (reverse search_list)) ;;将第二部分获得到的列表翻转
(setq search_i 0) ;;总运行次数控制参数
(setq search_pt (polar '(0 0 0) (* pi 0.25) 50)) ;;打印位置基准点
;;;(vl-cmdf "donut" 0 0.1 search_pt "")
(repeat (1- (length search_list))
(setq search_midlist (nth search_i search_list))
(setq search_midlist_children1 (nth 0 search_midlist))
(setq search_midlist_children2 (nth 1 search_midlist))
(setq search_midlist_children3 (nth 2 search_midlist))
(if (= search_i 0)
(setq search_slist* search_midlist_children2)
)
(if (= search_i 0)
(progn
(setq search_midlist_children3xi*
(nth 1
(nth 0
search_midlist_children3
)
)
)
)
)
(setq search_j 0)
(setq search_slist*f nil)
(setq search_slist*positionf nil)
(repeat (length search_slist*)
(setq search_s* (nth search_j search_slist*))
(cond ((= search_i 0)
(progn
(setq search_ptsi
(polar search_pt
(* pi search_constant search_j)
50
)
)
;;;(vl-cmdf "donut" 0 0.5 search_ptsi "")
(vl-cmdf "text"
search_ptsi
10
0
(strcat "S" (rtos search_s*))
)
(vl-cmdf "line" search_pt search_ptsi "")
)
)
((> search_i 0)
(setq search_ptsi (nth search_j search_slist*position))
)
)
(setq search_k 0)
(if (> search_i 0)
(setq search_midlist_children3xi*
(nth 1
(nth (lbsy
search_s*
search_midlist_children2next
)
search_midlist_children3
)
)
)
)
(repeat (length search_midlist_children3xi*)
(setq search_ptxi
(polar search_ptsi
(* pi search_constant search_k)
50
)
)
(setq search_ptsi
(polar search_ptxi
(* pi search_constant)
50
)
)
(setq search_slist*positionf
(cons search_ptsi
search_slist*positionf
)
)
(setq search_x* (nth search_k search_midlist_children3xi*))
;;; (vl-cmdf "donut" 0 0.1 search_ptxi "")
(vl-cmdf "text"
search_ptxi
10
0
(strcat "X" (rtos search_x*))
)
(vl-cmdf "line" search_ptsi search_ptxi "")
(setq search_cut (- search_s* search_x*))
(setq search_slist*f (cons search_cut search_slist*f))
;;; (vl-cmdf "donut" 0 0.5 search_ptsi "")
(vl-cmdf "text"
search_ptsi
10
0
(strcat "S" (rtos search_cut))
)
(vl-cmdf "line" search_ptxi search_ptsi "")
(setq search_midlist_children2next
(nth 1
(nth (1+ search_i) search_list)
)
)
(setq search_midlist_children3next
(nth 2
(nth (1+ search_i) search_list)
)
)
(setq search_midlist_children3xi*f
(nth
1
(nth
(lbsy
search_cut
search_midlist_children2next
)
search_midlist_children3next
)
)
)
(setq search_k (1+ search_k))
)
(setq search_j (1+ search_j))
)
(setq search_slist*f (reverse search_slist*f))
(setq search_slist* search_slist*f)
(setq search_slist*positionf (reverse search_slist*positionf))
(setq search_slist*position search_slist*positionf)
(setq search_i (1+ search_i))
)
(setvar "osmode" 0)
(prin1)
)
