加了些修改，参考地址：
https://ask.hellobi.com/blog/hql15/3448
后续补充下说明(因做项目贯穿前后端，无法专心深入具体一块，代码编写质量欠佳，后续逐步积累，初学者可以看看，嘿嘿)
#AHP
#http://www.doc88.com/p-28376768322.html
library(DBI)
library(ROracle)
drv=dbDriver('Oracle')
conn=dbConnect(drv,'ZJGS_G20','ZJGS_G20','localhost:1521/znjt')
#FIRST,A1:weather,A2:Flux,A3:acd,A4:vio
A=matrix(0,4,4)
diag(A)=1
A[1,2]=1/2;A[2,1]=2
A[1,3]=1/4;A[3,1]=4
A[1,4]=1/4;A[4,1]=4
A[2,4]=1/2;A[4,2]=2
A[2,3]=1/2;A[3,2]=2
A[3,4]=A[4,3]=1
#SECOND,B1:fog,B2:rain,B3:wind,B4:snow
B=matrix(0,4,4)
diag(B)=1
B[1,2]=2;B[2,1]=1/2
B[1,3]=6;B[3,1]=1/6
B[1,4]=2;B[4,1]=1/2
B[2,3]=3;B[3,2]=1/3
B[2,4]=1;B[4,2]=1
B[3,4]=1/3;B[4,3]=3
C=matrix(1,2,2)
C[1,2]=3
C[2,1]=1/3
#consistency
#A
Ac=colSums(A)
for (i in 1:nrow(A)) {
A[,i]=A[,i]/Ac[i]
}
weigA=rowMeans(A)
#B
Bc=colSums(B)
for (i in 1:nrow(B)) {
B[,i]=B[,i]/Bc[i]
}
weigB=rowMeans(B)
#C 1:flux,2:vehicle
Cc=colSums(C)
for (i in 1:nrow(C)) {
C[,i]=C[,i]/Cc[i]
}
weigC=rowMeans(C)
########row 1:fog,2:rain,3:wind,4:snow,5:flux,6:vehicle,7:acd,8:vio
########new row 1:fog,2:rain,3:wind,4:snow,5:even,6:acd,7:vio
weit=matrix(0,8,4)
weit[1:4,1]=weigB
weit[5:6,2]=weigC
weit[7,3]=1
weit[8,4]=1
######
w=as.matrix(weigA)
p=weit
we=p%*%w
#wenew=c(we[1:4],sum(we[5:6]),we[7],we[8])
wenew=we
#over
#get the function of accident
acdx<-c(0,0.1,0.2,0.3,0.4)
acdy<-c(5,4,3,2,1)
acdf <- LagrangePolynomial(acdx,acdy)
acdv <- function(x,f){
x=as.numeric(x)
ranka=f(x)
ranka[ranka>5]=5
ranka[ranka<0]=0
return (ranka)
}
#v=c(-0.1,0.2)
#vv=acdv(v,acdf)
#get the function of violation
viox<-c(0,0.1,0.2,0.3,0.4)
vioy<-c(5,4,3,2,1)
viof <- LagrangePolynomial(viox,vioy)
#get the function of flux flux
fluxfx<-c(0,0.15,0.3,0.45,0.6)
fluxfy<-c(5,4,3,2,1)
fluxff <- LagrangePolynomial(fluxfx,fluxfy)
#get the function of flux vehicel
fluxvx<-c(0,0.2,0.35,0.5,0.65)
fluxvy<-c(5,4,3,2,1)
fluxvf <- LagrangePolynomial(fluxvx,fluxvy)
#get the function of fog rain snow
fogx<-c(0,50,100,200,500)
fogy<-c(1,2,3,4,5)
fogf <- LagrangePolynomial(fogx,fogy)
#get the function of wind
windx<-c(0,13.9,20.7,28.5,32.7)
windy<-c(5,4,3,2,1)
windf <- LagrangePolynomial(windx,windy)
#get the data
rs=dbSendQuery(conn,"with weather as
(
select * from (
select * from weather_fact_aqts w
where w.cjrq=(select max(cjrq) from weather_fact_aqts)
and w.cjsd=(select max(cjsd) from weather_fact_aqts)
-- w.cjrq=to_char(sysdate,'yyyymm') and w.cjsd=to_char(sysdate,'hh24')
order by cjrq,cjsd asc ) where rownum=1
),
ExceptFlux as (
select v.yfbm,v.dlbm,v.ldbm,weather.cjrq,weather.cjsd,v.wfshb,a.sgshb,
weather.sbbh,weather.wd,weather.sd,weather.fl,weather.njd
,weather.fog_rank,weather.wind_rank from VIO_FACT_AQTS v
join ACD_FACT_AQTS a on v.yfbm=a.yfbm and v.dlbm=a.dlbm and v.ldbm=a.glsbm
join weather on 1=1
-- where a.yfbm=to_char(sysdate,'yyyymm')
)
select ex.cjrq,ex.dlbm,ex.ldbm,ex.yfbm,ex.cjsd,ex.wfshb,ex.sgshb,
ex.sbbh,ex.wd,ex.sd,ex.fl,ex.njd
,ex.fog_rank,ex.wind_rank
,fluxt.kkdbh,fluxt.gclhb,fluxt.cxgcbl
from ExceptFlux ex
join (select ff.kkdbh,ff.txrqbm,ff.sdbm,ff.gclhb,fr.cxgcbl,
f.dldm,f.lddm from fluxf_fact_aqts ff
join fluxr_fact_aqts fr on ff.kkdbh=fr.kkdbh and ff.txrqbm=fr.gcsjbm
join frm_roadsegitem f on ff.kkdbh=f.kkdbh) fluxt
on ex.dlbm=fluxt.dldm and ex.ldbm=fluxt.lddm
--and fluxt.txrqbm=to_char(sysdate,'yyyymmdd') and fluxt.sdbm=to_char(sysdate,'hh24')
")
data=fetch(rs)
data=as.matrix(data)
# get function of time frame
timex=c(0,2,8,10,12,16,18,20,22)
timey=c(0,0.2,0.8,1,0.8,0.5,0.9,0.5,0.2)
timef <- LagrangePolynomial(timex,timey)
#plot(c(1:23),timef(c(1:23)))
#Composite rank
#row 1:fog,2:rain,3:wind,4:snow,5:flux,6:vehicle,7:acd,8:vio
rankc=cbind(data[,c(2:5)],as.matrix(acdv(data[,12],fogf))*wenew[1],as.matrix(acdv(data[,12],fogf))*wenew[2],
as.matrix(acdv(data[,11],fogf))*wenew[3],as.matrix(acdv(data[,12],fogf))*wenew[4],
as.matrix(acdv(data[,16],fluxff))*wenew[5],as.matrix(acdv(data[,17],fluxff))*wenew[6],
as.matrix(acdv(data[,7],acdf))*wenew[7],as.matrix(acdv(data[,6],viof))*wenew[8])
#comprehensive rank
alv=as.numeric(rankc[,5:12])#
dim(alv)=c(nrow(rankc),8)
RANKOVER<-cbind(rankc[,1:4],ceiling(rowSums(alv)))
colnames(RANKOVER)<-c('DLBM','LDBM','CJRQ','CJSD','RANK')
RANKOVER=as.data.frame(RANKOVER)
RANKOVER[,5]=sub('5','4',RANKOVER[,5])
dbRemoveTable(conn, 'ZHZX_FACT_AQTS')
dbWriteTable(conn,'ZHZX_FACT_AQTS',RANKOVER, row.names = F, append = TRUE)
