R语言使用层次分析法进行综合指标等级划分

  • A+
所属分类:R语言 数据分析

业务临时需要,需要确定多因素影响下的综合权重值,现使用层次分析法和拉格朗日多项式插值算法做简易值计算。

R语言使用层次分析法进行综合指标等级划分

1、建立层次分析结构模型,分析影响综合指标的各个因素,分层级,上层受下层影响,而同层各因素之间基本上相对独立(本实例只有两层)

2、连接oracle数据库,读取各个因素实际指标值

  1. library(DBI)
  2. library(ROracle)
  3. drv=dbDriver('Oracle')
  4. conn=dbConnect(drv,'AQTS_ZHZX','AQTS_ZHZX','192.160.0.0:1521/iims')
  5. rs=dbSendQuery(conn,"with weather as
  6. (
  7.   select * from (
  8.   select * from weather_fact_aqts w 
  9.   where w.cjrq=(select max(cjrq) from weather_fact_aqts) 
  10.   order by w.cjsd desc) where rownum=1
  11. )
  12.                
  13.                select v.yfbm,v.dlbm,v.ldbm,weather.cjrq,weather.cjsd,v.wfshb,a.sgshb,
  14.                weather.sbbh,weather.wd,weather.sd,weather.fl,weather.njd
  15.                ,weather.fog_rank,weather.wind_rank from VIO_FACT_AQTS v
  16.                join ACD_FACT_AQTS a on v.yfbm=a.sgyfbm and v.dlbm=a.lhbm and v.ldbm=a.glsbm
  17.                join weather on 1=1")
  18. data=fetch(rs)
  19. data=as.matrix(data)

3、影响综合因素的指标分两级:

  1. #FIRST,A1:weather,A2:Flux,A3:acd,A4:vio
  2. #SECOND1,B1:fog,B2:rain,B3:wind,B4:snow
  3. #SECOND2,B2:FLUX1,FLUX2

4、构造第一层成对比较矩阵(采用成对比较法和1~9尺度)

  1. #FIRST,A1:weather,A2:Flux,A3:acd,A4:vio
  2. A=matrix(0,4,4)
  3. diag(A)=1
  4. A[1,2]=1/2;A[2,1]=2
  5. A[1,3]=1/4;A[3,1]=4
  6. A[1,4]=1/4;A[4,1]=4
  7. A[2,4]=1/2;A[4,2]=2
  8. A[2,3]=1/2;A[3,2]=2
  9. A[3,4]=A[4,3]=1

5、构造第二层成对比较矩阵(构造针对上一层成对比较矩阵)

  1. #SECOND,B1:fog,B2:rain,B3:wind,B4:snow
  2. B=matrix(0,4,4)
  3. diag(B)=1
  4. B[1,2]=2;B[2,1]=1/2
  5. B[1,3]=6;B[3,1]=1/6
  6. B[1,4]=2;B[4,1]=1/2
  7. B[2,3]=3;B[3,2]=1/3
  8. B[2,4]=1;B[4,2]=1
  9. B[3,4]=1/3;B[4,3]=3
  10. #SECOND2,B2:FLUX1,FLUX2
  11. C=matrix(1,2,2)
  12. C[1,2]=3
  13. C[2,1]=1/3

6、计算权向量并一致性校验

求权向量以及特征向量,进行一致性检验(因时间问题,这块没有加校验,后续修改)

7、求各层级因素权重,这里使用规范列平均法

  1. Ac=colSums(A)
  2. for (i in 1:nrow(A)) {
  3.   A[,i]=A[,i]/Ac[i]
  4. }
  5. weigA=rowMeans(A)
  6. #B
  7. Bc=colSums(B)
  8. for (i in 1:nrow(B)) {
  9.   B[,i]=B[,i]/Bc[i]
  10. }
  11. weigB=rowMeans(B)
  12. #C 1:flux,2:vehicle
  13. Cc=colSums(C)
  14. for (i in 1:nrow(C)) {
  15.   C[,i]=C[,i]/Cc[i]
  16. }
  17. weigC=rowMeans(C)
  18. ########row 1:fog,2:rain,3:wind,4:snow,5:flux,6:vehicle,7:acd,8:vio
  19. ########new row 1:fog,2:rain,3:wind,4:snow,5:even,6:acd,7:vio
  20. weit=matrix(0,8,4)
  21. weit[1:4,1]=weigB
  22. weit[5:6,2]=weigC
  23. weit[7,3]=1
  24. weit[8,4]=1
  25. ######
  26. w=as.matrix(weigA)
  27. p=weit
  28. we=p%*%w
  29. wenew=c(we[1:4],sum(we[5:6]),we[7],we[8])

8、构造各个因素的函数

  1. #get the function of accident
  2. acdx<-c(0,0.1,0.2,0.3,0.4)
  3. acdy<-c(5,4,3,2,1)
  4. acdf <- LagrangePolynomial(acdx,acdy)
  5. acdv <- function(x,f){
  6.   x=as.numeric(x)
  7.   ranka=f(x)
  8.   ranka[ranka>5]=5
  9.   ranka[ranka<0]=0
  10.   return (ranka)
  11. }
  12. #v=c(-0.1,0.2)
  13. #vv=acdv(v,acdf)
  14. #get the function of violation
  15. viox<-c(0,0.1,0.2,0.3,0.4)
  16. vioy<-c(5,4,3,2,1)
  17. viof <- LagrangePolynomial(viox,vioy)
  18. #get the function of flux flux
  19. fluxfx<-c(0,0.15,0.3,0.45,0.6)
  20. fluxfy<-c(5,4,3,2,1)
  21. fluxff <- LagrangePolynomial(fluxfx,fluxfy)
  22. #get the function of flux vehicel
  23. fluxvx<-c(0,0.2,0.35,0.5,0.65)
  24. fluxvy<-c(5,4,3,2,1)
  25. fluxvf <- LagrangePolynomial(fluxvx,fluxvy)
  26. #get the function of  fog rain snow
  27. fogx<-c(0,50,100,200,500)
  28. fogy<-c(1,2,3,4,5)
  29. fogf <- LagrangePolynomial(fogx,fogy)
  30. #get the function of wind
  31. windx<-c(0,13.9,20.7,28.5,32.7)
  32. windy<-c(5,4,3,2,1)
  33. windf <- LagrangePolynomial(windx,windy)

9、对应各因素指标值与权重相乘求取综合指标级别,并写入数据库

  1. rankc=cbind(data[,c(2:5)],as.matrix(acdv(data[,12],fogf))*wenew[1],as.matrix(acdv(data[,12],fogf))*wenew[2],
  2. as.matrix(acdv(data[,11],fogf))*wenew[3],as.matrix(acdv(data[,12],fogf))*wenew[4],as.matrix(rep(3,nrow(data)))*wenew[5],
  3. as.matrix(acdv(data[,7],acdf))*wenew[6],as.matrix(acdv(data[,6],viof))*wenew[7])
  4. #comprehensive rank
  5. alv=as.numeric(rankc[,5:11])
  6. dim(alv)=c(nrow(rankc),7)
  7. RANKOVER<-cbind(rankc[,1:4],ceiling(rowSums(alv)))
  8. colnames(RANKOVER)<-c('DLBM','LDBM','CJRQ','CJSD','RANK')
  9. RANKOVER=as.data.frame(RANKOVER)
  10. #dbRemoveTable(conn, 'ZHZX_FACT_AQTS')
  11. dbWriteTable(conn,'ZHZX_FACT_AQTS',RANKOVER, row.names = F, append = TRUE)

附:拉格朗日多项式插值算法

  1. #LagrangePolynomial
  2. LagrangePolynomial <- function(x,y) {
  3.   len = length(x)
  4.   if(len != length(y))
  5.     stop("length not equal!")
  6.   if(len < 2)
  7.     stop("dim size must more than 1")
  8.   #pretreat data abd alloc memery
  9.   xx <- paste("(","a -",x,")")
  10.   m <- c(rep(0,len))
  11.   #combin express
  12.   for(i in 1:len) {
  13.     td <- 1
  14.     tm <- "1"
  15.     for(j in 1:len) {
  16.       if(i != j) {
  17.         td <- td*(x[i] - x[j])
  18.         tm <- paste(tm,"*",xx[j])
  19.       }
  20.     }
  21.     tm <- paste(tm,"/",td)
  22.     m[i]<-tm #m[i] <- parse(text=tm)
  23.   }
  24.   #combin the exrpession
  25.   m <- paste(m,"*",y)
  26.   r <- paste(m,collapse="+")
  27.   #combin the function
  28.   fbody <- paste("{ return(",r,")}")
  29.   f <- function(a) {}
  30.   #fill the function's body
  31.   body(f) <- parse(text=fbody)
  32.   return(f)
  33. }

(记录日常点滴)对算法以及R使用还不是很熟悉,后续完善!

如有错误,希望指点>>>OK

深入浅出数据分析(中文版)
误差分位数的默示有效估计与\ 自回归时间序列的预测区间
R语言神经网络模型银行客户信用评估数据
精选各名校数学专业考研初试试卷

发表评论

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen: