搜索
物元可拓法于80年代由我国蔡文教授创立，目前已广泛应用于新产品构思与设计、优化决策、控制、识别与评价等各个领域，无论在理论还是在实践上都发挥了越来越重要的作用。物元是描述事物的名称、特征及量值3个基本元素的简称，在形式上可记为M=(N，c，v)=(N，c，c(N))。其中M、N、c、v分别是Matter、Name，Character，Value的缩写。可拓集合是用关联度将模糊集合的[0，1]闭合区间连续取值拓广到(-∞，+∞)实数轴，以表达物元的量值为实轴上的一点时符合要求的程度。物元分析是研究物元及其变化并用以解决矛盾问题的规律和方法，可拓学是用形式化的工具，从定性和定量两个角度去研究解决矛盾问题的规律和方法。物元可拓法结合二者，是将辨证逻辑和形式逻辑相结合的可拓逻辑，丰富了事物的内涵，客观地反映了物质世界的真实状态。本次选用评价因子污染贡献率方法来确定权系数。主要计算程序：DimsRowAsInteger,sColAsInteger'起始的行与列DimiAsInteger,jAsInteger'循环变量DimXjAsDouble'定义实测值DimAijAsDouble,BijAsDouble'定义标准域区间DimApjAsDouble,BpjAsDouble'定义节域变量DimYZSAsInteger'定义评价因子个数DimDJSAsInteger'定义评价等级数'得到起始行列值sRow=InputBox(请输入监测数据第一个数的行号！,输入行号,0)sCol=InputBox(请输入监测数据第一个数的列号！,输入列号,0)YZS=InputBox(请输入评价因子个数!,输入因子个数,0)DJS=InputBox(请输入评价等级个数!,输入评价等级数,0)'插入标记列文字WithSheets(sheet1)Fori=1ToDJSCells(sRow+DJS+2+i,sCol-1).Value=关联函数k_等级&iNextiCells(sRow+2*DJS+3,sCol-1).Value=X/SCells(sRow+2*DJS+4,sCol-1).Value=归一化权重Fori=1ToDJSCells(sRow+2*DJS+4+i,sCol-1).Value=关联度K_等级&iNextiCells(sRow+3*DJS+5,sCol-1).Value=可拓指数'按列循环计算Forj=sColTosCol+YZS-1'赋初值Xj=Cells(sRow,j).Value'实测值Apj=Cells(sRow+1,j).Value'可拓域最小值Bpj=Cells(sRow+DJS+2,j).Value'可拓域最大值Fori=1ToDJS'对aij,bij赋值Aij=Cells(sRow+i,j).ValueBij=Cells(sRow+i+1,j).Value'按条件选择公式计算关联度IfXjAijAndXjBijThen'xjXij点x位于本标准之内IfXj=((Aij+Bij)/2)ThenCells(sRow+i+DJS+2,j).Value=-(Aij-Xj)/(Bij-Aij)ElseCells(sRow+i+DJS+2,j).Value=-(Xj-Bij)/(Bij-Aij)EndIfElse'xjXij点x位于本标准之外IfXjAijThen'x位于标准的左边,此时有x(ai+bi)/2IfXj=(Apj+Bpj)/2ThenCells(sRow+i+DJS+2,j).Value=(Aij-Xj)/(Apj-Aij)ElseCells(sRow+i+DJS+2,j).Value=(Aij-Xj)/(2*Xj-Bpj-Aij)EndIfElseIfXjBijThen'x位于标准的右边,此时有x(ai+bi)/2IfXj=(Apj+Bpj)/2ThenCells(sRow+i+DJS+2,j).Value=(Xj-Bij)/(Apj+Bij-2*Xj)ElseCells(sRow+i+DJS+2,j).Value=(Xj-Bij)/(Bij-Bpj)EndIfEndIfEndIfNextiNextj'计算X/SForj=sColTosCol+YZS-1DimaAsDoublea=0Fori=1ToDJS+2a=a+Cells(sRow+i,j)NextiCells(sRow+2*DJS+3,j).Value=Cells(sRow,j).Value*(DJS+2)/aNextj'计算权重'计算x/s的总和a=0Fori=sColTosCol+YZS-1a=a+Cells(sRow+2*DJS+3,i)NextiForj=sColTosCol+YZS-1Cells(sRow+2*DJS+4,j).Value=Cells(sRow+2*DJS+3,j).Value/aNextj'计算关联度Cells(sRow+2*DJS+4,sCol+YZS)=综合关联度Fori=1ToDJSForj=sColTosCol+YZS-1Cells(sRow+2*DJS+4+i,j).Value=Cells(sRow+DJS+2+i,j).Value*Cells(sRow+2*DJS+4,j).ValueNextjDimkAsIntegera=0Fork=sColTosCol+YZS-1a=a+Cells(sRow+2*DJS+4+i,k)'综合关联度累加NextkCells(sRow+2*DJS+4+i,sCol+YZS).Value=aNexti'计算可拓指数'找最小与最大关联度DimKmax,KminAsDoubleKmax=Cells(sRow+2*DJS+4+1,sCol+YZS).ValueKmin=KmaxFori=2ToDJSIfKmaxCells(sRow+2*DJS+4+i,sCol+YZS).ValueThenKmax=Cells(sRow+2*DJS+4+i,sCol+YZS).ValueEndIfIfKminCells(sRow+2*DJS+4+i,sCol+YZS).ValueThenKmin=Cells(sRow+2*DJS+4+i,sCol+YZS).ValueEndIfNextiDimKXP()AsDoubleReDimKXP(DJS)AsDoubleFori=1ToDJSKXP(i)=(Cells(sRow+2*DJS+4+i,sCol+YZS).Value-Kmin)/(Kmax-Kmin)NextiDimFZ,FMAsDoubleFori=1ToDJSFZ=FZ+i*KXP(i)FM=FM+KXP(i)NextiCells(sRow+3*DJS+5,sCol).Value=FZ/FMEndWith我做地下水水质评价时用到的公式是这样的:矩跟关联度的公式是通常用到的那个,即:p(xj,xij)=|xj-0.5(aij+bij)|-0.5(bij-aij)关联函数计算公式:当xj属于xij时,ki(xj)=-p(xj,xij)/|xij|当xj不属于xij时,ki(xj)=p(xj,xij)/[p(xj,xrj)-p(xj,xij)]综合关联度计算公式:Kj(p)=a1*kj(x1)+a2*kj(x2)+...+an*kj(xn)权重用的污染因子贡献率法:ai=(xi/Si)/(x1/S1+x2/S2+...xn/Sn)可拓指数用公式:KXP=(Kj(X)-Min(Kj(X)))/(Max(Kj(X))-Min(Kj(X)))由于涉及的内容或者思路一同,可能选用的关联度计算公式,权重计算公式不同,酌情参考。参考源程序里最初的部分，后面的变量说明有详细解释，定义要评价的参数个数，评价的等级等，相应的在excel表格里的参数个数与评价等级的行数要与之对应。PS:上面的代码里因子个数是通过跳出的对话框手动输入进去的。