API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Oct 22nd, 2014
126
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 15.03 KB | None | 0 0
raw download clone embed print report
  1. plot_1 <- function(var = input$select) {
  2. gg1 <- aggregate(cbind(get(var)) ~ Mi + hours , a(), FUN=mean)
  3. ggl <- aggregate(cbind(get(var)) ~ Mi + hours , b(), FUN=mean)
  4. names(gg1)[2] <- "Day"
  5. names(ggl)[2] <- "Day"
  6. names(gg1)[3] <- var
  7. names(ggl)[3] <- var
  8. gg1$Day <- gg1$Day /24
  9. ggl$Day <- ggl$Day /24
  10. print(ggplot(subset(gg1,!is.na(var)), aes_string(x = "Day", y = var, group = "Mi")) +
  11. geom_point(aes(color = factor(Mi)),size = 3, alpha = 0.7) +
  12. #scale_x_continuous(breaks=pretty_breaks(n=10)) + #geom_smooth(stat= "smooth" , alpha = I(0.4), method="loess",color="grey", formula = y ~ x)
  13. geom_line(data = (ggl), size = 1) +
  14. scale_color_manual("Mesocosm", values = c('#FF0000', '#00FF00', '#0000FF', '#FFFF00', '#FF00FF', '#808080', '#800000' , '#008000', '#008080')) +
  15. scale_y_continuous(breaks=pretty_breaks(n=10)) +
  16. guides(colour = guide_legend(override.aes = list(size=8))) +
  17. theme_bw() +
  18. theme (legend.position = "right", legend.title=element_text(size=14),legend.key.width = unit(5, "line"),
  19. legend.key.size = unit(0.2, "in"), legend.text = element_text(size=14),
  20. panel.border = element_rect(colour = "black"),strip.background = element_rect(fill="#CCCCFF"),
  21. strip.text.x = element_text(size=14, face="bold"),axis.text.y = element_text(colour="grey20",size=13,face="bold"),
  22. axis.text.x = element_text(colour="grey20",size=13,face="bold"),
  23. axis.title.x = element_text(colour="grey20",size=20,face="bold"),
  24. axis.title.y = element_text(colour="grey20",size=20,face="bold")) +
  25. scale_x_continuous(breaks=pretty_breaks(n=10), limits=c(input$slider[1],input$slider[2])) )
  26. }
  27.  
  28. library(shiny)
  29. pkgs <- c("reshape2","raster","maps","maptools", "ggplot2", "scales", "grid")
  30. pkgs <- pkgs[!(pkgs %in% installed.packages()[,"Package"])]
  31. if(length(pkgs)) install.packages(pkgs,repos="http://cran.cs.wwu.edu/")
  32. library(reshape2); library(raster); library(maptools) ; library(ggplot2) ; library(scales) ; library(grid)
  33.  
  34. # By default, the file size limit is 5MB. It can be changed by
  35. # setting this option. Here we'll raise limit to 9MB.
  36. options(shiny.maxRequestSize = 10*1024^2)
  37.  
  38. #Main Shinyserver function
  39. shinyServer(function(input, output) {
  40.  
  41.  
  42. #Plot
  43. output$showMapPlot <- renderUI({
  44. { list(plotOutput("plot",height="100%"), br()) }
  45. })
  46.  
  47.  
  48. #Change the selectInput based on the radioButton option
  49. output$select <- renderUI({
  50. if (input$radio == 1 | input$radio == 2) {selectInput("select", h4("Variables:"), choices=var.name, selected=var.name[1], multiple=F, width="100%")}
  51. else { selectInput("select", h4("Variables:"), choices=var.name, selected=var.name[1], multiple=T, width="100%")}
  52. })
  53.  
  54. output$experiment <- renderUI({
  55. if(input$radio == 4) {selectInput("experiment", h4("Experiment:"), choices=unique(a()$Ei), selected=NULL)}
  56. })
  57.  
  58.  
  59. #Upload Model Data
  60. a <- reactive({
  61. fileinput1 <- input$file1
  62. if (is.null(fileinput1))
  63. return(NULL)
  64. read.table(fileinput1$datapath, header = TRUE, col.names = c("Ei","Mi","hours","Nphy","Cphy","CHLphy","Nhet","Chet","Ndet","Cdet","DON","DOC","DIN","DIC","AT","dCCHO","TEPC","Ncocco","Ccocco","CHLcocco","PICcocco","par","Temp","Sal","co2atm","u10","dicfl","co2ppm","co2mol","pH"))
  65. })
  66.  
  67. #Upload Observation Data
  68.  
  69. b <- reactive({
  70. fileinput2 <- input$file2
  71. if (is.null(fileinput2))
  72. return(NULL)
  73. read.table(fileinput2$datapath, header = TRUE, col.names = c("Ei","Mi","hours","Nphy","Cphy","CHLphy","Nhet","Chet","Ndet","Cdet","DON","DOC","DIN","DIC","AT","dCCHO","TEPC","Ncocco","Ccocco","CHLcocco","PICcocco","par","Temp","Sal","co2atm","u10","dicfl","co2ppm","co2mol","pH"))
  74. })
  75.  
  76. # Based on the selected radio button (Option) and the input variables (SelectInput) Do the plotting.
  77. # Option --> radioButton --> Function to apply
  78. # Variable --> SelectInput --> Variables to pass into functions
  79. #########################################Plot Code############################################
  80.  
  81. #Plot conditions and Downlaod graph implementation
  82. output$plot <- renderPlot({
  83. if(input$radio == "1")
  84. {
  85. plot_1()
  86.  
  87. output$Plotoutput <- downloadHandler(
  88. filename = 'curPlot.pdf',
  89. content = function(file){
  90. pdf(file = file, width=11, height=8.5, pointsize=8)
  91. plot_1()
  92. dev.off()
  93. }
  94. )
  95. }
  96. if(input$radio == "2")
  97. {
  98. plot_2()
  99.  
  100. output$Plotoutput <- downloadHandler(
  101. filename = 'curPlot.pdf',
  102. content = function(file){
  103. pdf(file = file, width=11, height=8.5, pointsize=8)
  104. plot_2()
  105. dev.off()
  106. }
  107. )
  108. }
  109. if(input$radio == "3")
  110. {
  111. if(length(input$select) >= 2)
  112. {
  113. plot_3()
  114.  
  115. output$Plotoutput <- downloadHandler(
  116. filename = 'curPlot.pdf',
  117. content = function(file){
  118. pdf(file = file, width=11, height=8.5, pointsize=8)
  119. plot_3()
  120. dev.off()
  121. }
  122. )
  123. }
  124. }
  125. if(input$radio == "4")
  126. {
  127. if(length(input$select) >= 6)
  128. {
  129. plot_4()
  130.  
  131. output$Plotoutput <- downloadHandler(
  132. filename = 'curPlot.pdf',
  133. content = function(file){
  134. pdf(file = file, width=11, height=8.5, pointsize=8)
  135. plot_4()
  136. dev.off()
  137. }
  138. )
  139. }
  140. }
  141. },
  142. height=700, width=1100
  143. )
  144.  
  145. ################# Option-1 ###################
  146.  
  147. plot_1 <- function(var = input$select) {
  148. gg1 <- aggregate(cbind(get(var)) ~ Mi + hours , a(), FUN=mean)
  149. ggl <- aggregate(cbind(get(var)) ~ Mi + hours , b(), FUN=mean)
  150. names(gg1)[2] <- "Day"
  151. names(ggl)[2] <- "Day"
  152. names(gg1)[3] <- var
  153. names(ggl)[3] <- var
  154. gg1$Day <- gg1$Day /24
  155. ggl$Day <- ggl$Day /24
  156. print(ggplot(subset(gg1,!is.na(var)), aes_string(x = "Day", y = var, group = "Mi")) +
  157. geom_point(aes(color = factor(Mi)),size = 3, alpha = 0.7) +
  158. #scale_x_continuous(breaks=pretty_breaks(n=10)) + #geom_smooth(stat= "smooth" , alpha = I(0.4), method="loess",color="grey", formula = y ~ x)
  159. geom_line(data = (ggl), size = 1) +
  160. scale_color_manual("Mesocosm", values = c('#FF0000', '#00FF00', '#0000FF', '#FFFF00', '#FF00FF', '#808080', '#800000' , '#008000', '#008080')) +
  161. scale_y_continuous(breaks=pretty_breaks(n=10)) +
  162. guides(colour = guide_legend(override.aes = list(size=8))) +
  163. theme_bw() +
  164. theme (legend.position = "right", legend.title=element_text(size=14),legend.key.width = unit(5, "line"),
  165. legend.key.size = unit(0.2, "in"), legend.text = element_text(size=14),
  166. panel.border = element_rect(colour = "black"),strip.background = element_rect(fill="#CCCCFF"),
  167. strip.text.x = element_text(size=14, face="bold"),axis.text.y = element_text(colour="grey20",size=13,face="bold"),
  168. axis.text.x = element_text(colour="grey20",size=13,face="bold"),
  169. axis.title.x = element_text(colour="grey20",size=20,face="bold"),
  170. axis.title.y = element_text(colour="grey20",size=20,face="bold")) +
  171. scale_x_continuous(breaks=pretty_breaks(n=10), limits=c(input$slider[1],input$slider[2])) )
  172. }
  173.  
  174. ################ END of Option-1 ###############
  175.  
  176. ################ Option-2 ######################
  177. plot_2 <- function(var = input$select) {
  178. #EXP <- unique(a()$Ei)
  179. gg2 <- aggregate(cbind(get(var)) ~ Ei + Mi + hours, a(), FUN=mean)
  180. ggl <- aggregate(cbind(get(var)) ~ Ei + Mi + hours, b(), FUN=mean)
  181. #gg2 <- subset(aggr,aggr$Ei == c(EXP))
  182. names(gg2)[3] <- "Day"
  183. names(ggl)[3] <- "Day"
  184. names(gg2)[4] <- var
  185. names(ggl)[4] <- var
  186. gg2$Day <- gg2$Day /24
  187. ggl$Day <- ggl$Day /24
  188. print( ggplot(subset(gg2,!is.na(var)),aes_string(x="Day", y= var)) +
  189. geom_point(aes(color = factor(Mi)),size = 3) +
  190. geom_line(data = (ggl), size = 1) +
  191. #geom_smooth(color="blue",stat= "smooth" , alpha = I(0.01), method="loess") +
  192. #coord_fixed(ratio=1) +
  193. facet_grid(Ei~., labeller=function(x,y) (paste0("EXP",y))) +
  194. scale_color_manual("Mesocosm", values = c('#FF0000', '#00FF00', '#0000FF', '#FFFF00', '#FF00FF', '#808080', '#800000' , '#008000', '#008080'), breaks=pretty_breaks(n=8) ) +
  195. scale_y_continuous(breaks=pretty_breaks(n=10)) +
  196. guides(colour = guide_legend(override.aes = list(size=8))) +
  197. theme_bw() +
  198. theme (legend.position = "right", legend.title=element_text(size=14),legend.key.width = unit(5, "line"),
  199. legend.key.size = unit(0.2, "in"), legend.text = element_text(size=14),
  200. panel.border = element_rect(colour = "black"),strip.background = element_rect(fill="#CCCCFF"),
  201. strip.text.x = element_text(size=14, face="bold"),
  202. strip.text.y = element_text(size=14, face="bold"),
  203. axis.text.y = element_text(colour="grey20",size=13,face="bold"),
  204. axis.text.x = element_text(colour="grey20",size=13,face="bold"),
  205. axis.title.x = element_text(colour="grey20",size=20,face="bold"),
  206. axis.title.y = element_text(colour="grey20",size=20,face="bold")) +
  207. scale_x_continuous(breaks=pretty_breaks(n=10), limits=c(input$slider[1],input$slider[2])) )
  208. }
  209.  
  210. ################ END of Option-2 ###############
  211.  
  212. ############## Option-3 ########################
  213. plot_3 <- function(var1 = input$select[1],var2 = input$select[2]) {
  214.  
  215. gg3 <- aggregate(cbind(get(var1),get(var2))~Mi+hours,a(), FUN=mean)
  216. names(gg3)[2] <- "Day"
  217. names(gg3)[3] <- var1
  218. names(gg3)[4] <- var2
  219. gg3$Day <- gg3$Day/24
  220. plot(x = gg3[,"Day"], y = gg3[,var1], type="p", col="red", xlab="", ylab="", xlim=c(input$slider[1],input$slider[2]))
  221. par(new=TRUE)
  222. plot(x = gg3[,"Day"], y = gg3[,var2], type="p", col="blue", xaxt="n", yaxt="n", xlab="", ylab="", xlim=c(input$slider[1],input$slider[2]))
  223. axis(4)
  224. mtext(var1,side=2,line=2)
  225. mtext(var2,side=4,line=-2)
  226. mtext("Day",side=1,line=2)
  227. legend("topleft",col=c("red","blue"),lty=1,legend=c(var1,var2), text.width = 3)
  228. }
  229.  
  230. ################ END of Option-3 ################
  231.  
  232. #################### Option-4 #####################
  233.  
  234. plot_4 <- function(var1 = input$select[1], var2 = input$select[2], var3 = input$select[3], var4 = input$select[4], var5 = input$select[5], var6 = input$select[6]) {
  235.  
  236. myvars <- c(var1,var2,var3,var4,var5,var6)
  237. gg4 <- subset((aggregate(cbind(get(var1),get(var2),get(var3),get(var4),get(var5),get(var6))~Ei+Mi+hours,a(), FUN=mean)),Ei == input$experiment)
  238. ggl <- subset((aggregate(cbind(get(var1),get(var2),get(var3),get(var4),get(var5),get(var6))~Ei+Mi+hours,b(), FUN=mean)),Ei == input$experiment)
  239. names(gg4)[4] <- var1
  240. names(ggl)[4] <- var1
  241. names(gg4)[5] <- var2
  242. names(ggl)[5] <- var2
  243. names(gg4)[6] <- var3
  244. names(ggl)[6] <- var3
  245. names(gg4)[7] <- var4
  246. names(ggl)[7] <- var4
  247. names(gg4)[8] <- var5
  248. names(ggl)[8] <- var5
  249. names(gg4)[9] <- var6
  250. names(ggl)[9] <- var6
  251.  
  252. names(gg4)[3] <- "Day"
  253. names(ggl)[3] <- "Day"
  254. gg4$Day <- gg4$Day /24
  255. ggl$Day <- ggl$Day /24
  256.  
  257. ddp <- melt(gg4,id.vars=c("Ei","Mi","Day"), measure.vars=myvars, na.rm = TRUE)
  258. ddl <- melt(ggl,id.vars=c("Ei","Mi","Day"), measure.vars=myvars, na.rm = TRUE)
  259.  
  260.  
  261. print(ggplot(subset(ddp,!is.na(myvars)),aes(x=Day, y=value)) +
  262. geom_point(aes(color=factor(Mi)), size = 3, position = position_jitter(width = 0.1)) +
  263. geom_line(data = (ddl), size = 1) +
  264. #geom_smooth(stat= "smooth" , alpha = I(0.01), method="loess", color = "blue") +
  265. facet_wrap(~variable, nrow=3, ncol=2,scales = "free_y") +
  266. scale_color_manual("Mesocosm", values = c('#FF0000', '#00FF00', '#0000FF', '#FFFF00', '#FF00FF', '#808080', '#800000' , '#008000', '#008080')) +
  267. scale_y_continuous(breaks=pretty_breaks(n=6)) +
  268. guides(colour = guide_legend(override.aes = list(size=8))) +
  269. theme_bw() +
  270. theme (legend.position = "right", legend.title=element_text(size=14),legend.key.width = unit(5, "line"),
  271. legend.key.size = unit(0.2, "in"), legend.text = element_text(size=14),
  272. panel.border = element_rect(colour = "black"),strip.background = element_rect(fill="#CCCCFF"),
  273. strip.text.x = element_text(size=14, face="bold"),
  274. axis.text.y = element_text(colour="grey20",size=13,face="bold"),
  275. axis.text.x = element_text(colour="grey20",size=13,face="bold"),
  276. axis.title.x = element_text(colour="grey20",size=20,face="bold"),
  277. axis.title.y = element_text(colour="grey20",size=20,face="bold")) +
  278. scale_x_continuous(breaks=pretty_breaks(n=6), limits=c(input$slider[1],input$slider[2])) )
  279. }
  280. ################ END of Option-4 ################
  281. })
  282.  
  283. ###################################### END of Program##########################################
  284.  
  285. library(shiny)
  286. tabPanelAbout <- source("about.r")$value
  287. headerPanel_2 <- function(title, h, windowTitle=title) {
  288. tagList(
  289. tags$head(tags$title(windowTitle)),
  290. h(title)
  291. )
  292. }
  293.  
  294. shinyUI(fluidPage(
  295. headerPanel_2(
  296. HTML(
  297. '<div id="stats_header" align ="center">
  298. <font color="grey">
  299. <body style="background-color:black;">
  300. <h2 style="font-family:georgia;">
  301. BIOCHEMICAL MODELLING
  302. </body>
  303. </font>
  304. </div>'
  305. ), h3, "BIOCHEMICAL MODELLING"
  306. ),
  307. fluidRow(column(3,
  308. uiOutput("showMapPlot"),
  309. wellPanel(
  310. h4("Data Upload"),
  311. fileInput('file1', h5('Choose Your Model Data'), accept=c('text/csv','text/comma-separated-values,text/plain','.OUT')),
  312. fileInput('file2', h5('Choose Your Observation Data'), accept=c('text/csv','text/comma-separated-values,text/plain','.OUT'))
  313. ),
  314. wellPanel(
  315. sliderInput("slider", label = h4("Time (Days)"), min = 0, max = 552/24, value = c(0,20),animate = FALSE, width="100%", format = "#")
  316. ),
  317. wellPanel(
  318. radioButtons("radio", label = h4("Plot Options:"),
  319. choices = list("Choice 1 [Single var, all Exp and all Mesc]" = 1,
  320. "Choice 2 [Single var, compare Exp for all Mesc]" = 2,
  321. "Choise 3 [Two var, all Exp and all Mesc, line plot comparison]" = 3,
  322. "Choice 4 [Six variable comparison for all exp and all Mesc]"= 4),selected = 1)),
  323.  
  324. wellPanel(
  325. div(class="row-fluid",
  326. div(class="span6", uiOutput("select"))
  327. )),
  328. wellPanel(div(class="row-fluid", div(class="span6", downloadButton("Plotoutput", "Download Graphic"))))
  329. ),
  330. #Conditional Plots tab creation
  331. column(8,
  332. tabsetPanel(
  333. tabPanel("Conditional Plots",plotOutput("plot",height="auto"),value="barplots"),
  334. tabPanelAbout(),
  335. id="tsp")),
  336. #Helps to suppress the unwanted red Error messages on the Browser
  337. tags$style(type="text/css",
  338. ".shiny-output-error { visibility: hidden; }",
  339. ".shiny-output-error:before { visibility: hidden; }"
  340. )
  341.  
  342.  
  343. )))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!