R/banana_pipeline/banana_shinyApp.R

   1 library(shiny)\r
   2 library(DT)\r
   3 library(knitr)\r
   4 library(ggplot2)\r
   5 library(leaflet)\r
   6 library(shinythemes)\r
   7 library(dplyr)\r
   8 library(tidyr)\r
   9 library(data.table)\r
  10 library(lubridate)\r
  11 # datasets\r
  12 Overall <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\bananadata.csv")\r
  13 plantlets <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\plantlets.csv") \r
  14 FloweringD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\all_flowering.csv")\r
  15 FirstpollinationD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\firstpollination.csv")\r
  16 RepeatPolln <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\repeatpollination.csv")\r
  17 HarvestedD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\harvesting.csv")\r
  18 RipenedD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\ripening.csv")\r
  19 Plant_statusD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\status.csv")\r
  20 Seed_extractionD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\extraction.csv")\r
  21 EmbryorescueD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\rescued.csv")\r
  22 Germinating_two_weeksD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\germinating2weeks.csv")\r
  23 Germinating_6weeksD <-  read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\germinating6weeks.csv")\r
  24 SubcultureD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\subculture.csv")\r
  25 RootingD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\rooting.csv")\r
  26 HardeningD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\hardening.csv")\r
  27 ScreenhouseD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\screenhouse.csv")\r
  28 OpenfieldD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\openfield.csv")\r
  29 ContaminationD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\Contamination.csv")\r
  30 StatusD <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\status.csv")\r
  31 \r
  32 All_data <- Overall %>% \r
  33   select("crossnumber","mother", "mother_accessionName", "father", "father_accessionName", "firstpollination_date",\r
  34          starts_with("Male"),starts_with("repeatPollinationDate"), starts_with("Male_accessionName"),"harvesting_date", "days_to_maturity","ripen_date",\r
  35          "days_harvest_ripening","seed_extraction_date","number_seeds", "good_seeds","badseeds", "days_ripening_extraction","number_rescued",\r
  36          "rescue_date", "days_extraction_rescue","germination_after_2weeks_date","actively_germination_after_two_weeks","days_rescue_2weeksGermination",\r
  37          "germination_after_6weeks_date","actively_germination_after_6weeks","days_2weeksGermination_6weeksGermination",\r
  38          "subculture_date", "subcultures", "days_6weeks_Germination_subculture")\r
  39 all_plantlets = plantlets %>%\r
  40   select("crossnumber","plantletID","subculture_date","date_rooting","days_subculture_rooting","screenhse_transfer_date","days_rooting_screenhse",\r
  41          "hardening_date","days_scrnhse_hardening","date_of_transfer_to_openfield","days_hardening_openfield")\r
  42 Flowering <- FloweringD[,5:8]\r
  43 colnames(Flowering) <- c("plot_number","accession_name","flowering_date","sex")\r
  44 FirstPollination <- FirstpollinationD[,8:13]\r
  45 colnames(FirstPollination) <- c("mother_plotNumber","mother_acc_name","father_plotNumber","father_acc_name","crossnumber","firstpollination_date")\r
  46 Firstpollination <- FirstPollination[,c(5,1,2,3,4,6)]\r
  47 RepeatPollination <- RepeatPolln[,-1]\r
  48 Harvested <- HarvestedD[,c(4,6:7,3)]\r
  49 Ripened <- RipenedD[,c(4,6:7,3)]\r
  50 Seed_extraction <- Seed_extractionD[,c(4,6:8,3)]\r
  51 Embryorescue <- EmbryorescueD[,c(4,6:10,3)]\r
  52 Germinating_two_weeks <- Germinating_two_weeksD[,c(4,6:8,3)] \r
  53 Germinating_6weeks <- Germinating_6weeksD[,c(4,6:8,3)]\r
  54 Subculture <- SubcultureD[,c(4,6:8,3)]\r
  55 Rooting <- RootingD[,c(4,6:7,3)]\r
  56 Screenhouse <- ScreenhouseD[,c(4,6:7,3)]\r
  57 Hardening <- HardeningD[,c(4,6:7,3)]\r
  58 Openfield <- OpenfieldD[,c(4,6:7,3)]\r
  59 Contamination <- ContaminationD[,c(4,6:7,3)]\r
  60 Plant_status = StatusD[,c(5:7,3)]\r
  61 \r
  62 # # NUMBER OF ACCESSION IN DIFFERENT STAGES OF PROJECT\r
  63 nTable = read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\nTable.csv", stringsAsFactors = F)\r
  64 # DATA EXPLORER\r
  65 cleantable <- read.csv("D:\\github\\ODK_bananaCrossingTool\\Analysis\\cleantable.csv", stringsAsFactors = F)\r
  66 \r
  67 # ui\r
  68 library(shinyjs)\r
  69 \r
  70 ui <- navbarPage("BP - TOOL", theme = shinytheme("united"),\r
  71                  tabPanel("DASHBOARD",\r
  72                           fluidRow(\r
  73                                    column(6,h4("Total submissions per day"),\r
  74                                           plotOutput("tsubs", height = 250),\r
  75                                           \r
  76                                        h5("Activities per contributor"),\r
  77                                               plotOutput("csubs", height = 300)),\r
  78                                    column(4,offset = 1, h4("Number of accessions in different stages of project"),\r
  79                                           hr(),\r
  80                                           DT::dataTableOutput("nAccessions"))\r
  81                           )),\r
  82                  tabPanel("TODAY'S REPORT",\r
  83                           fluidRow(\r
  84                             column(3, h4("Table: Today summary"), br(),tableOutput("dsumTable")),\r
  85                             column(6, h4("Table: Today's records"),br(), tableOutput("dTable"))\r
  86                             ),\r
  87                           fluidRow( column(10, offset = 1, htmlOutput("text")))\r
  88                           ),\r
  89                  navbarMenu("DATA TABLES",\r
  90                             tabPanel("Crosses datasets",\r
  91                                      fluidRow(\r
  92                                        column(2,offset=1, \r
  93                                               selectInput("select_activity", "Crosses datasets", \r
  94                                                           choices = c("All crosses data","Flowering","Firstpollination","RepeatPollination","Harvested",\r
  95                                                                       "Ripened","Seed_extraction","Embryorescue","Germinating_two_weeks",\r
  96                                                                       "Germinating_6weeks","Subculture")))),\r
  97                                       fluidRow(\r
  98                                         hr(),\r
  99                                         column(10,offset=1, \r
 100                                               div(style = c('overflow-x: scroll', "font-size: 75%; width: 75%"),\r
 101                                                   DT::dataTableOutput("crossesTable")),\r
 102                                               downloadButton('downloadcrosses', 'Download data')))\r
 103                                      ),\r
 104                             tabPanel("Plantlets datasets",\r
 105                                      fluidRow(\r
 106                                        column(2, offset = 1,\r
 107                                               selectInput("plantlets","Plantlets datasets", \r
 108                                                           choices = c("All plantlets data","Rooting","Screenhouse","Hardening","Openfield")))),\r
 109                                      hr(),\r
 110                                      fluidRow(\r
 111                                        column(10,offset=1, \r
 112                                               div(style = c('overflow-x: scroll', "font-size: 75%; width: 75%"),\r
 113                                                   DT::dataTableOutput("plantletsTable")),\r
 114                                               downloadButton('downloadplantlets', 'Download data')))\r
 115                                      ),\r
 116                             tabPanel("Status and contamination",\r
 117                                       fluidRow(           \r
 118                                        column(2, offset = 1,\r
 119                                               selectInput("statusCont","Status and contamination", choices = c("Status","Contamination")))\r
 120                                      ),\r
 121                                      hr(),\r
 122                                      fluidRow(\r
 123                                        column(10,offset=1, \r
 124                                               div(style = c('overflow-x: scroll', "font-size: 75%; width: 75%"),\r
 125                                                   DT::dataTableOutput("statusConTable")),\r
 126                                               downloadButton('downloadstatusCont', 'Download data')))\r
 127                                      )\r
 128                             ),\r
 129                   tabPanel("DATA EXPLORER",\r
 130                                      fluidRow(\r
 131                                        column(3,selectInput("locations", "locations", c("All locations"="", unique(cleantable$location)), multiple=TRUE)),\r
 132                                        column(3,conditionalPanel("input.locations",\r
 133                                                                  selectInput("activities", "Activities", c("Activities"=""), multiple=TRUE))),\r
 134                                        column(3,conditionalPanel("input.locations",\r
 135                                                                  selectInput("accessions", "Accessions", c("Accessions"=""), multiple=TRUE)))\r
 136                                      ),\r
 137                                      fluidRow(\r
 138                                        column(10, offset = 1,\r
 139                                               DT::dataTableOutput("dataExplorer"))\r
 140                                      )\r
 141                             )\r
 142                  \r
 143 )\r
 144 \r
 145 server <- function(input, output, session){\r
 146   output$tsubs <- renderPlot({\r
 147     qplot(data=cleantable, x=date) + ylab("Submission Count") + theme(legend.position = "bottom")\r
 148   })\r
 149  output$csubs <- renderPlot({\r
 150     qplot(data=cleantable, x=contributor, fill=activity) + theme(legend.position = "right") \r
 151   })\r
 152  output$nAccessions <- DT::renderDataTable({\r
 153    nTable\r
 154  })\r
 155  \r
 156   crossesInput <- reactive({\r
 157     switch(input$select_activity, "All crosses data" = All_data,\r
 158            "Flowering" = Flowering,"Firstpollination" = Firstpollination,\r
 159            "RepeatPollination" = RepeatPollination,\r
 160            "Harvested" = Harvested,"Ripened" = Ripened,"Seed_extraction" = Seed_extraction,\r
 161            "Embryorescue" = Embryorescue,"Germinating_two_weeks" = Germinating_two_weeks,\r
 162            "Germinating_6weeks" = Germinating_6weeks,"Subculture" = Subculture)\r
 163   })\r
 164   \r
 165   plantletsInput <- reactive({\r
 166     switch(input$plantlets, "All plantlets data" = all_plantlets,\r
 167            "Rooting" = Rooting,"Screenhouse" = Screenhouse,"Hardening" = Hardening,"Openfield" = Openfield)\r
 168   })\r
 169   statusConInput <- reactive({\r
 170     switch(input$statusCont,"Status" = Plant_status,"Contamination" = Contamination)\r
 171   })\r
 172   \r
 173   output$crossesTable <- DT::renderDataTable({\r
 174     crossesInput()\r
 175   })\r
 176   output$plantletsTable <- DT::renderDataTable({\r
 177     plantletsInput()\r
 178   })\r
 179   output$statusConTable <- DT::renderDataTable({\r
 180     statusConInput ()\r
 181   })\r
 182   \r
 183   \r
 184   output$downloadData <- downloadHandler(\r
 185     filename = function() { paste(input$datasets, '.csv', sep='') },\r
 186     content = function(file) {\r
 187       write.csv(datasetInput(), file)\r
 188     })\r
 189   \r
 190   todaydata = dplyr::filter(cleantable, cleantable$date==Sys.Date())\r
 191   \r
 192   if (dim(todaydata)[1]==0)\r
 193   {\r
 194     output$text <- renderText({paste("No activity was recorded today")})\r
 195   }\r
 196   else{\r
 197     mytable = table(todaydata$location,todaydata$activity)\r
 198     dtable = as.data.frame(mytable)\r
 199     names(dtable) = c("location","Activity","N")\r
 200     output$dsumTable <- renderTable(dtable)\r
 201     output$dTable <- renderTable(todaydata)\r
 202   }\r
 203   output$dPlot <- renderPlot({\r
 204     s<- ggplot(todaydata, aes(activity, fill=contributor))\r
 205     s + geom_bar(position = 'stack') +  theme(legend.position = "bottom") + coord_flip()\r
 206   })\r
 207   ggplot(todaydata, aes(x = reorder(activity, -accession), y = accession, fill = activity)) + \r
 208     geom_bar(stat = "identity")\r
 209   \r
 210 # Data explorer\r
 211   observe({\r
 212     activities <- if (is.null(input$locations)) character(0) else {\r
 213       filter(cleantable, location %in% input$locations) %>%\r
 214         `$`('activity') %>%\r
 215         unique() %>%\r
 216         sort()\r
 217     }\r
 218     stillSelected <- isolate(input$activities[input$activities %in% activities])\r
 219     updateSelectInput(session, "activities", choices = activities,\r
 220                       selected = stillSelected)\r
 221   })\r
 222   \r
 223   observe({\r
 224     accessions <- if (is.null(input$locations)) character(0) else {\r
 225       cleantable %>%\r
 226         filter(location %in% input$locations,\r
 227                is.null(input$activities) | activity %in% input$activities) %>%\r
 228         `$`('accession') %>%\r
 229         unique() %>%\r
 230         sort()\r
 231     }\r
 232     stillSelected <- isolate(input$accessions[input$accessions %in% accessions])\r
 233     updateSelectInput(session, "accessions",choices = accessions,\r
 234                       selected = stillSelected)\r
 235   })\r
 236   \r
 237   output$dataExplorer <- DT::renderDataTable({\r
 238     df <- cleantable %>%\r
 239       filter(\r
 240         is.null(input$locations) | location %in% input$locations,\r
 241         is.null(input$activities) | activity %in% input$activities,\r
 242         is.null(input$accessions) | accession %in% input$accessions\r
 243       ) #%>%\r
 244     #mutate(Action = paste('<a class="go-map" href="" data-lat="', Lat, '" data-long="', Long, '" data-zip="', Zipcode, '"><i class="fa fa-crosshairs"></i></a>', sep=""))\r
 245     action <- DT::dataTableAjax(session, df)\r
 246     \r
 247     DT::datatable(df, options = list(ajax = list(url = action)), escape = FALSE)\r
 248   })\r
 249 } \r
 250 shinyApp(ui = ui, server = server)