Last active
December 14, 2015 22:20
-
-
Save fawda123/5157768 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
shinyServer(function(input, output) { | |
myData <- reactive({ | |
read.csv(input$file$datapath) | |
}) | |
output$summary <- renderPrint({ | |
if (is.null(input$file)) { | |
return(cat('File not uploaded')) | |
} | |
dataset <- myData() | |
macrophyte.IBI<-function(survey,location=T) | |
{ | |
all.sp<-c('A','AA','AC','AG','AI','AL','ALG','ALS','AM','AS','AT','B','BA','BB','BC','BGA','BRS', | |
'BS','BUB','BW','C','CA','CAC','CAH','CAL','CALA','CAN','CAP','CAS','CAW','CB','CC','CD','CE', | |
'CEE','CH','CHC','CM','COMP','COS','CP','CRES','CS','CV','CY','CYP','D','DA','DV','E','EA','EC', | |
'EF','ELAS','ELM','ELNE','ELOD','ELS','ELSP','ELT','EM','EN','EP','EQS','ERI','ES','EUM','EUP', | |
'EV','F','FA','FF','G','GAL','GB','GG','GL','H','HA','HD','HE','HJ','HV','HYS','HYV','I','IE', | |
'IM','IMA','IMS','IP','IRV','IS','IV','J','JB','JE','JEWL','JF','JN','LA','LAB','LC','LD','LG', | |
'LM','LO','LS','LT','LU','LYS','LYT','M','MA','MB','MEA','MF','MG','MH','MR','MS','MT','MV','MVO', | |
'MYH','MYS','MYT','N','NAG','NF','NG','NL','NM','NO','NS','NUL','NUR','NUS','NV','NX','NX','NYL', | |
'NYS','P','PA','PC','PD','PE','PF','PFL','PG','PHA','PHAU','PI','PL','PLA','PN','PO','POA','POAL', | |
'POB','POC','POF','POFR','PON','PONF','POO','POP','POPA','POPU','POR','POS','POSB','POSN','POV', | |
'PP','PPUL','PR','PS','PV','PZ','R','RAF','RF','RG','RIF','RL','RM','RO','RS','RT','RU','RUO','S', | |
'SA','SAC','SAL','SAS','SB','SC','SCA','SCC','SCE','SCF','SCH','SCP','SCS','SCT','SCTS','SCU', | |
'SE','SEME','SF','SFLO','SG','SIS','SL','SM','SO','SP','SPA','SPAG','SPAM','SPC','SPG','SPGL', | |
'SPI','SPM','SPNG','SPP','SPPE','SPT','SR','SS','SUA','SV','SX','TA','TG','TL','TS','TSNL','UC', | |
'UG','UI','UM','UP','UR','UV','V','VA','VEA','VES','VM','VS','WC','WM','WS','ZIP','ZP') | |
nonrooted<-c('BGA','D','EMT','FA','GA','PLA','SPAG','SPM','SPNG','WM') | |
submersed.sp<-c('BW','C','CAH','CAS','CD','CEE','CF','CH','CV','EC','ELAS','ELM','ELOD','ELT','EN', | |
'ES','FS','H','HD','HV','I','IE','IM','IMA','LD','LU','M','MA','MB','MF','MH','MS','MV','MYH', | |
'MYS','MYT','N','NAG','NF','NG','NM','NS','PA','PAN','PB','PC','PD','PE','PF','PG','PI','PN','PO', | |
'POAL','POB','POC','POF','POFR','POH','PON','PONF','POO','POP','POPU','POR','POS','POSB','POSN', | |
'POV','PP','PPUL','PR','PS','PTO','PV','PZ','R','RAF','RF','RG','RL','RO','RS','RSU','RT','SS', | |
'SUA','UC','UG','UI','UM','UP','UR','UV','VA','X','ZP') | |
sensitive.sp<-c('AG','CP','CH','CAH','CEE','CHC','DA','ELM','ELT','ES','ERI','GB','HV','HA','HE', | |
'I','IE','IM','IMA','LG','LU','LD','MB','MT','MG','MA','MF','MYT','MV','NAG','NG','NL', 'NYL', | |
'POC','POAL','POB', 'PD','PE','POF','POFR','POO','PO','PR','POS','PS','POV','SB','SAC','SH','SS', | |
'SCT','SPAM','SPA','SPF','SN','PV','SUA','TM','UC','UG','UI','UM','UP','UR','VM','VO','X','ZAQ', | |
'ZIP') | |
tolerant.sp<-c('AC','AS','BUB','CAT','CB','CD','CE','EM','HJ','IP','IMS','JEWL','LS','MYH','MYS', | |
'PC','PHA','PHAU','RM','TA','TG','TL','TS','TSNL') | |
exotic.sp<-c('AC','BUB','CE','IP','LS','MYH','MYS','PC','PHA','TA','TG','TSNL') | |
data.prep<-{ | |
all.pts<-{ | |
if(location==T){ | |
if(strsplit(survey,'.',fixed=T)[[1]][2] == '.csv') lake.data<-read.csv(survey,header=T) | |
else lake.data<-read.table(survey,header=T,sep=',') | |
} | |
if(location==F) lake.data<-survey | |
lake.data[is.na(lake.data)]<-0 | |
match.test<-match(names(lake.data),nonrooted,nomatch=0) | |
rooted<-{ | |
sp.names<-subset(cbind(names(lake.data),match.test),match.test==0)[,1] | |
subset(lake.data,select=sp.names) | |
} | |
Sum<-ifelse(as.matrix(rowSums(rooted)-rooted[,1])>0,1,0) | |
cbind(rooted,Sum)[order(cbind(rooted,Sum)$AQPNT_Depth),] | |
} | |
ADPG<-max((subset(all.pts,Sum==1)$AQPNT_Depth)) | |
Cumsum<-cumsum(subset(all.pts,(AQPNT_Depth<ADPG|AQPNT_Depth==ADPG))$Sum) | |
Freq<-round(Cumsum/max(Cumsum),2) | |
cbind(subset(all.pts,(AQPNT_Depth<ADPG|AQPNT_Depth==ADPG)),Cumsum,Freq) | |
} | |
sp.freq<-round(colSums(rooted[,1:ncol(rooted)])[2:ncol(rooted)]/nrow(data.prep),4) | |
if(sum(is.na(match(names(sp.freq),all.sp)))>0){ | |
unknown<<-names(sp.freq)[which(is.na(match(names(sp.freq),all.sp))==TRUE)] | |
stop("unknown species, type 'unknown' for identification") | |
} | |
if(sum(as.numeric(colSums(data.prep[,2:ncol(data.prep)]))==0)>0){ | |
unsampled<<-names(sp.freq)[which(as.numeric(colSums(data.prep[,2:ncol(data.prep)]))==0)] | |
stop("unsampled species, type 'unsampled' for identification") | |
} | |
if(ncol(lake.data)-sum(names(lake.data)=='PC')==1){ | |
stop('curly-leaf pondweed surveys not used for IBI') | |
} | |
boxcox<-function(x,lambda,geometric.mean){ | |
((1+x)^lambda-1)/(lambda*geometric.mean^(lambda-1)) | |
} | |
pos.scale<-function(x,quan,min){ | |
if(x>quan|x==quan){10} | |
else{10*(x-min)/(quan-min)} | |
} | |
neg.scale<-function(x,quan,max){ | |
if(x<quan|x==quan){10} | |
else{10-(10*(x-quan)/(max-quan))} | |
} | |
MAXD<-{ | |
MAXD.raw<-max(subset(data.prep, Freq<0.95|Freq==0.95)$AQPNT_Depth) | |
if(MAXD.raw<1.75){ | |
warning('questionable value for MAXD, verify survey accuracy') | |
} | |
round(pos.scale(MAXD.raw,18.2,1.75),2) | |
} | |
LITT<-{ | |
LITT.raw<-{ | |
littoral.zone<-subset(data.prep, Freq<0.95|Freq==0.95) | |
length(subset(littoral.zone,Sum==1)$Sum)/length(littoral.zone$AQPNT_Depth) | |
} | |
if(LITT.raw<0){ | |
warning('questionable value for LITT, verify survey accuracy') | |
} | |
round(pos.scale(LITT.raw,1,0),2) | |
} | |
OVER<-{ | |
OVER.raw<-sum(ifelse(sp.freq>0.1|sp.freq==0.1,1,0)) | |
if(OVER.raw<0){ | |
warning('questionable value for OVER, verify survey accuracy') | |
} | |
round(pos.scale(OVER.raw,12.2,0),2) | |
} | |
SUBM<-{ | |
SUBM.raw<-sum(sp.freq[(names(sp.freq) %in% submersed.sp)]/sum(sp.freq)) | |
if(boxcox(SUBM.raw,6.042163,1.776386)>0.5926954){ | |
warning('questionable value for SUBM, verify survey accuracy') | |
} | |
round(neg.scale(boxcox(SUBM.raw,6.042163,1.776386),0.07707069,0.5926954),2) | |
} | |
SENS<-{ | |
SENS.raw<-sum(sp.freq[(names(sp.freq) %in% sensitive.sp)]/sum(sp.freq)) | |
if(SENS.raw<0){ | |
warning('questionable value for SENS, verify survey accuracy') | |
} | |
round(pos.scale(SENS.raw,0.2328255,0),2) | |
} | |
TOLR<-{ | |
TOLR.raw<-sum(sp.freq[(names(sp.freq) %in% tolerant.sp)]/sum(sp.freq)) | |
if(TOLR.raw>0.9426771){ | |
warning('questionable value for TOLR, verify survey accuracy') | |
} | |
round(neg.scale(TOLR.raw,0,0.9426771),2) | |
} | |
TAXA<-{ | |
TAXA.raw<-(ncol(rooted)-1)-length(names(rooted)[names(rooted) %in% exotic.sp]) | |
if(TAXA.raw<1){ | |
warning('questionable value for TAXA, verify survey accuracy') | |
} | |
round(pos.scale(TAXA.raw,31.6,1),2) | |
} | |
IBIscore<-round(10*(MAXD+LITT+OVER+SUBM+SENS+TOLR+TAXA)/7,2) | |
Raw<<-as.data.frame(formatC(rbind(MAXD.raw,LITT.raw,OVER.raw,SUBM.raw,SENS.raw,TOLR.raw,TAXA.raw), | |
digits=2,format='f')) | |
names(Raw)<<-'Scores' | |
score.table<-as.data.frame(rbind(MAXD,LITT,OVER,SUBM,SENS,TOLR,TAXA,IBIscore)) | |
names(score.table)<-'Scores' | |
cat('\nMN macrophyte IBI v1.5.4, milfoil hybrid addition\n') | |
cat('\nPrepared by M. Beck, Jan. 2011\n') | |
cat('\nnote: version includes milfoil hybrid which is not in DNR vegetation database\n') | |
if(location==T){ | |
surv=strsplit(survey,'/')[[1]][length(strsplit(survey,'/')[[1]])] | |
cat(paste('\nIBI and metric scores for file',surv,sep=" "),'\n\n') | |
} | |
if(location==F) cat('\nIBI and metric scores\n\n') | |
print(score.table) | |
cat("\nMetric values are scaled from 0-10 \nType 'Raw' for unscaled metrics \n\n") | |
} | |
macrophyte.IBI(dataset,location=F) | |
}) | |
output$view<-renderTable({ | |
if (is.null(input$file)) { | |
return(cat('')) | |
} | |
head(myData()) | |
}) | |
}) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
shinyUI(pageWithSidebar( | |
headerPanel("Load macrophyte survey"), | |
sidebarPanel( | |
fileInput("file", "File data", multiple=FALSE) | |
), | |
mainPanel( | |
verbatimTextOutput("summary"), | |
tableOutput("view") | |
) | |
)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment