From d339ac36561a5b3caf92c052908ce4a08fa0523d Mon Sep 17 00:00:00 2001 From: zankuralt Date: Fri, 6 Oct 2017 23:30:11 +0200 Subject: [PATCH 1/4] Added graphs to stats tab. They need to be modified though. --- app.R | 5 +++-- dynamic_ui.R | 28 ++++++++++++++++++++++++++++ 2 files changed, 31 insertions(+), 2 deletions(-) diff --git a/app.R b/app.R index d5c168f..40a9b85 100644 --- a/app.R +++ b/app.R @@ -6,6 +6,7 @@ library(DT) library(sp) library(rgdal) library(data.table) +library(ggplot2) source("global.R") source("functions.R") @@ -76,8 +77,8 @@ body <- dashboardBody( uiOutput("view_parentage") ), tabItem(tabName = "overview", - h3("Quick statistics of dataset"), - uiOutput("stats") + uiOutput("stats"), + uiOutput("graphs") ) ) ) diff --git a/dynamic_ui.R b/dynamic_ui.R index 65d30f7..1ece169 100644 --- a/dynamic_ui.R +++ b/dynamic_ui.R @@ -139,3 +139,31 @@ observe({ ) }) }) + +observe({ + xy <- allData() + par <- inputFileParentage() + + + if(nrow(xy) > 0) { + output$sps <- renderPlot({ + ggplot(xy) + + geom_bar(aes(sample_type)) + }) + output$opp <- renderPlot({ + ggplot(par) + + geom_bar(aes(offspring)) + }) + output$graphs <- renderUI({ + fluidRow( + box(solidHeader = TRUE, title = "Samples per sample type", + plotOutput("sps")), + box(solidHeader = TRUE, title = "Number of offspring per parent", + plotOutput("opp")) + ) + }) + } + + +}) + From 4742e1beaae0a6755ff07e34cbb7c4ae44957a54 Mon Sep 17 00:00:00 2001 From: Zan Kuralt Date: Sat, 7 Oct 2017 00:24:18 +0200 Subject: [PATCH 2/4] Only one graph is currently displayed --- app.R | 1 - dynamic_ui.R | 16 +++++++++------- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/app.R b/app.R index 40a9b85..21148f2 100644 --- a/app.R +++ b/app.R @@ -30,7 +30,6 @@ sidebar <- dashboardSidebar( ) ) - #### BODY #### body <- dashboardBody( tags$style(type = "text/css", "#map {height: 100% !important;}"), diff --git a/dynamic_ui.R b/dynamic_ui.R index 1ece169..5fae33a 100644 --- a/dynamic_ui.R +++ b/dynamic_ui.R @@ -148,18 +148,20 @@ observe({ if(nrow(xy) > 0) { output$sps <- renderPlot({ ggplot(xy) + + theme_bw() + geom_bar(aes(sample_type)) }) - output$opp <- renderPlot({ - ggplot(par) + - geom_bar(aes(offspring)) - }) + # output$opp <- renderPlot({ + # ggplot(par) + + # theme_bw() + + # geom_col(aes(x = unique(c(mother, father), y = offspring))) + # }) output$graphs <- renderUI({ fluidRow( box(solidHeader = TRUE, title = "Samples per sample type", - plotOutput("sps")), - box(solidHeader = TRUE, title = "Number of offspring per parent", - plotOutput("opp")) + plotOutput("sps")) + # box(solidHeader = TRUE, title = "Number of offspring per parent", + # plotOutput("opp")) ) }) } From 449bd1f16aa945327ae0f1db4df50530bad66646 Mon Sep 17 00:00:00 2001 From: Chuck Thompson Date: Sat, 7 Oct 2017 10:39:38 -0400 Subject: [PATCH 3/4] update fake data format to app requirements --- generate_fake_data.R | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/generate_fake_data.R b/generate_fake_data.R index 8c7eb64..5abd1be 100644 --- a/generate_fake_data.R +++ b/generate_fake_data.R @@ -8,32 +8,35 @@ N <- 5 # number of points per individual lng <- c(13.0, 16.6) lat <- c(45.4, 46.88) date <- as.Date(c("01.01.2010", "31.12.2017"), format = "%d.%m.%Y") -type <- c("scat", "urine", "saliva", "tissue") +sample_type <- c("scat", "urine", "saliva", "tissue") +sex <- c("M", "F") ind.pt <- data.frame(lat = runif(NIND, min = min(lat), max = max(lat)), - lng = runif(NIND, min = min(lng), max = max(lng))) + lng = runif(NIND, min = min(lng), max = max(lng))) ind.pt <- split(ind.pt, f = 1:nrow(ind.pt)) xy <- sapply(ind.pt, FUN = function(x, N) { - out <- data.frame(lng = rnorm(N, mean = x$lng, sd = 0.05), - lat = rnorm(N, mean = x$lat, sd = 0.05)) + out <- data.frame(x = rnorm(N, mean = x$lng, sd = 0.05), + y = rnorm(N, mean = x$lat, sd = 0.05)) tm <- sample(seq(from = min(date), to = max(date), by = "day"), 1) - typ <- sample(type, 5, replace = TRUE) - out$time <- tm + (1:N) - out$type <- typ + typ <- sample(sample_type, 5, replace = TRUE) + sex <- sample(sex, 5, replace = TRUE) + out$date <- tm + (1:N) + out$sample_type <- typ + out$sex <- sex out }, N = N, simplify = FALSE) xy <- do.call(rbind, xy) xy$animal <- sprintf("%.3d", rep(1:NIND, each = N)) -xy$id <- as.character(1:nrow(xy)) +xy$sample_name <- as.character(1:nrow(xy)) offspring <- data.frame(sibling = sprintf("%.3d", 5:NIND), - mother = c("001", "002"), - father = c("003", "004"), - cluster = c("1", "2")) + mother = c("001", "002"), + father = c("003", "004"), + cluster = c("1", "2")) write.table(x = xy, file = "data.csv", sep = ",", row.names = FALSE, quote = FALSE) write.table(x = offspring, file = "offspring.csv", sep = ",", row.names = FALSE, quote = FALSE) From 78733686dd7271034fddf0c75fbfafadc48072fa Mon Sep 17 00:00:00 2001 From: Chuck Thompson Date: Sat, 7 Oct 2017 12:00:32 -0400 Subject: [PATCH 4/4] add in zoom functionality when sample is selected --- leaflet.R | 9 +++++++++ view_data.R | 2 +- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/leaflet.R b/leaflet.R index 1fbdc8e..808f7a6 100644 --- a/leaflet.R +++ b/leaflet.R @@ -8,6 +8,15 @@ output$map <- renderLeaflet({ setView(lng = 14.815333, lat = 46.119944, zoom = 8) }) +observeEvent(input$uploadSampleData_row_last_clicked, { + x <- inputFileSamples() + selectedRow <- input$uploadSampleData_row_last_clicked + + leafletProxy('map') %>% + setView(lng = x[selectedRow, 'lng'], lat = x[selectedRow, 'lat'], zoom = 10) + +}, ignoreInit = TRUE) + # Add markers and lines for selected animals to map observe({ PS <- PS() diff --git a/view_data.R b/view_data.R index 84c0505..f9be68c 100644 --- a/view_data.R +++ b/view_data.R @@ -1,6 +1,6 @@ output$uploadSampleData <- renderDataTable({ x <- inputFileSamples() - DT::datatable(data = x, filter = "top", options = list(pageLength = 15)) + DT::datatable(data = x, filter = "top", options = list(pageLength = 15), selection = 'single') }) observe({