Skip to content

Instantly share code, notes, and snippets.

@fawda123
Last active December 19, 2015 23:18
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save fawda123/6033710 to your computer and use it in GitHub Desktop.
CDOM processing
shinyServer(function(input, output) {
myData <- reactive({
read.table(
input$file$datapath,
sep='\t',
header=T,
stringsAsFactors=F
)
})
output$summary <- renderPrint({
if (is.null(input$file)) {
return(cat('File not uploaded'))
}
dataset <- myData()
CDOM_proc<-function(data.in){
#spectra for averaging
wv.avg<-c(280,312,350,375,400,412,430,440,443,469,488,531,551,555,645,667,678,480,
567,658)
#ranges for slope calculation
slopes<-list(c(350,400),c(350,412),c(350,440),c(280,312),c(280,350))
round.slo<-4
round.ave<-3
ref<-700
#unique replicate names for stations
reps<-data.in[1,][!as.character(data.in[1,]) %in% 'Wavelength nm.']
reps<-unique(gsub('a|b|c','',reps))
#function for spectra average
get.avg<-function(ave.in,proc.dat,ref.in=ref){
tmp<-mean(as.numeric(proc.dat[proc.dat[,1]==ave.in,2:4]))
ref.in<-mean(as.numeric(proc.dat[proc.dat[,1]==ref.in,2:4]))
23.03*(tmp-ref.in)
}
#function for slope average
get.slo<-function(range.in,proc.dat,ref.in=ref){
require(reshape)
tmp<-proc.dat[proc.dat[,1]>=range.in[1] & proc.dat[,1]<=range.in[2],]
tmp<-melt(tmp,id.vars=names(proc.dat)[1])
ref.in<-mean(as.numeric(proc.dat[proc.dat[,1]==ref.in,2:4]))
y.vals<-log(23.03*(as.numeric(as.character(tmp[,3]))-ref.in))
as.numeric(lm(y.vals~as.numeric(tmp[,1]))$coefficients[2])
}
#process data
out<-matrix(nrow=(ncol(data.in)-1)/3,ncol=2+length(wv.avg)+length(slopes))
for(rep in reps){
sel<-grep(rep,data.in[1,])
proc.dat<-data.in[2:nrow(data.in),c(1,sel)]
slope.out<-unlist(lapply(slopes, function(x){
get.slo(x,proc.dat)
}))
slope.out<-round(slope.out,round.slo)
ave.out<-sapply(wv.avg, function(x){
get.avg(x,proc.dat)
})
ave.out<-round(ave.out,round.ave)
station<-names(proc.dat[,2:ncol(proc.dat)])
station<-unique(unlist(lapply(strsplit(station,'.',fixed=T),function(x) x[1])))
out[which(rep==reps),]<-c(station,rep,slope.out,ave.out)
}
#prep output for export
slope.names<-unlist(lapply(slopes,function(x) paste('S(',x[1],'-',x[2],'nm)',sep='')))
ave.names<-paste('ag(',wv.avg,')',sep='')
out<-data.frame(out,stringsAsFactors=F)
names(out)<-c('Station','Serial#',slope.names,ave.names)
return(out)
}
out<<-CDOM_proc(dataset) #important assignment to global env
out
})
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(con) {
write.csv(out, con, row.names=F)
}
)
})
shinyUI(pageWithSidebar(
headerPanel("Load raw data"),
sidebarPanel(
fileInput("file", "File data", multiple=FALSE),
downloadLink("downloadData", "Download")
),
mainPanel(
verbatimTextOutput("summary"),
tableOutput("view")
)
))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment