Related
I have a Shiny app where I have a first Selectizegroup module in the sidebar that filter my data on 3 variables. I want to put a second selectize or pickergroup module in a tabpanel to produce some plot with the data filtered on supplementary 2 variables. But I found no way to apply the pickerGroup module on the reactive data obtained with the first group module.
I already tried to achieve it with isolate(), update(), observeEvent(), but I always failed....
A minimal example of my database:
base <- structure(list(annee = c(2017, 2018, 2017, 2016, 2018, 2017,
2017, 2018, 2018, 2016),
code_composante = structure(c(2L, 1L,2L, 1L, 2L, 2L, 2L, 2L, 2L, 1L),
.Label = c("APS", "FSI"),
class = "factor"),
code_etape = structure(c(25L, 26L, 21L, 28L, 16L, 16L, 12L, 13L, 21L, 28L),
.Label = c("EP3CHE", "EP3EEE", "EP3GCE", "EP3INE", "EP3MAE", "EP3MEE", "EP3PHE", "EP40EE", "EP40GE", "EP40IE", "EP40KE", "EPCHIE", "EPCHSE", "EPEEAE", "EPGCCE", "EPINFE", "EPMACE", "EPMASE", "EPMATE", "EPMECE", "EPMIAE", "EPPHPE", "EPPHSE", "EPSDTE", "EPSDVE", "SP3SCE", "SP40PE", "SPAPSE"),
class = "factor"),
particularite = structure(c(3L,1L, 3L, 3L, 3L, 3L, 3L, 4L, 3L, 3L),
.Label = c("3LA", "4LA","Classique", "Parcours spécial"),
class = "factor"),
origine_gen2 = structure(c(1L, 3L, 3L, 4L, 4L, 3L, 4L, 1L, 3L, 3L),
.Label = c("Bacheliers antérieurs", "Flux latéral", "Néo-bacheliers", "Redoublement ", "Réorientation "),
class = "factor"),
code_resultat = structure(c(2L, 4L, 2L, 3L, 4L, 3L, 3L, 4L, 4L, 1L),
.Label = c("Admis", "Ajourné","Défaillant / démissionnaire", "Donnée manquante", "Réorientation (à affiner)"), class = "factor"),
poursuite = structure(c(4L, 3L, 4L,6L, 3L, 6L, 4L, 3L, 3L, 2L),
.Label = c("Année supérieure - Flux latéral","Année supérieure - Flux normal", "Non déterminé", "Redoublement", "Réorientation", "Sortie UPS - Echec", "Sortie UPS - Réussite" ),
class = "factor")),
class = c("tbl_df", "tbl", "data.frame" ),
row.names = c(NA, -10L))
And a little piece of the shiny app:
# contenu global ####
ui <- shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(title = "Devenir et réussite en L1",
titleWidth = 300),
# shiny::uiOutput("logout_button")),
shinydashboard::dashboardSidebar(tags$head(tags$style(HTML(".sidebar { position: fixed; width: 300px;}" ))),
width = 300,
div(h1("Filtres", style = "margin-left: 10px;")),
shinyWidgets::selectizeGroupUI(id = "filterset",
btn_label = "Remettre les filtres à zéro",
inline = FALSE,
params = list(
annee = list(inputId = "annee", title = "Année"),
composante = list(inputId = "code_composante", title = "Code composante"),
particularite = list(inputId = "particularite", title = "Type de L1"),
etape = list(inputId = "code_etape", title = "Code étape")))),
shinydashboard::dashboardBody(
#### onglet "tables" ####
shiny::tabsetPanel(id = "tabset",
shiny::tabPanel(title = "Tables des flux",
shiny::fluidRow(shinydashboard::box(width = 4,
title = "Origine des étudiants",
DT::DTOutput("table_origine")))),
#### onglet "flowchart"####
shiny::tabPanel(title = "Flow chart",
shinydashboard::box(width = 12,
shinyWidgets::pickerGroupUI(id = "filterset_flowchart",
btn_label = "Remettre les filtres à zéro",
params = list(
origine = list(inputId = "origine_gen2", title = "Origine"),
resultat = list(inputId = "code_resultat", title = "Résultat")))),
shinydashboard::box(width = 12, height = "700px", shiny::plotOutput("flowchart"))
))))
####SERVER####
server <- function(input, output, session) {
#first filter
filtered_data <- callModule(
module = shinyWidgets::selectizeGroupServer,
id = "filterset",
data = base ,
vars = c("annee", "code_composante", "particularite", "code_etape")
)
# box_origine ####
output$table_origine <- DT::renderDT({
effectif_origine <- filtered_data() %>%
dplyr::select(origine_gen2) %>%
dplyr::group_by(origine_gen2) %>%
dplyr::count()
DT::datatable(effectif_origine,
selection = 'single')
})
# flowchart ####
filtered_flowchart_data <- callModule(
module = shinyWidgets::pickerGroupServer,
id = "filterset_flowchart",
data = filtered_data() %>%
droplevels()%>%
dplyr::mutate_if(is.factor, as.character),
vars = c("origine_gen2", "code_resultat")
)
output$flowchart <- shiny::renderPlot({
actualized_data <- filtered_flowchart_data() %>%
dplyr::mutate_if(is.character, as.factor) %>%
dplyr::group_by(poursuite) %>%
dplyr::count()%>%
dplyr::ungroup()
pie_chart <- pie(actualized_data$n, labels = actualized_data$poursuite)
})}
shiny::shinyApp(ui, server)
In the 2nd tabPannel ("Flow chart") I would like the pickerGroup (filtered_flowchart_data) to work on the filtered data from the selectizeGroup (filtered_data()) from the sidebar but without affecting the data of other tabpanels of course :)
With the version provided of my code I obtain a message
Error in .getReactiveEnvironment()$currentContext() : Operation not allowed without an active reactive context.
I think there is possibly a way with a combination of observeEvent, update reactive and isolate but I didn't achieve it....
You can call the module inside a reactive conductor:
filtered_flowchart_data <- reactive({
x <- callModule(
module = shinyWidgets::pickerGroupServer,
id = "filterset_flowchart",
data = filtered_data() %>%
droplevels() %>%
dplyr::mutate_if(is.factor, as.character),
vars = c("origine_gen2", "code_resultat")
)
x()
})
If there's an issue you can also try
filtered_flowchart_data <- reactive({
callModule(
module = shinyWidgets::pickerGroupServer,
id = "filterset_flowchart",
data = filtered_data() %>%
droplevels() %>%
dplyr::mutate_if(is.factor, as.character),
vars = c("origine_gen2", "code_resultat")
)
})
and then you get the data by doing filtered_flowchart_data()().
Thanks for your answer Stéphane, the 2nd proposition achieves the job!
filtered_flowchart_data <- reactive({
callModule(
module = shinyWidgets::pickerGroupServer,
id = "filterset_flowchart",
data = filtered_data() %>%
droplevels() %>%
dplyr::mutate_if(is.factor, as.character),
vars = c("origine_gen2", "code_resultat")
)})
and get the data by using :
filtered_flowchart_data()()
I don't know if its very clean, I never used or saw double ()(), but the result is perfect :)
I have created a shiny app that pulls software components and their versions off of a list of nodes. The goal here is to make all of our nodes consistent when possible and this app helps us see which nodes are inconsistent.
Currently you can modify the version in the 'baseline' handsontable and it will reactively update the pivot table below with the change as well as the BaselineStats column within the handsontable. This works as expected. I have been asked to add the ability to upload a csv file that would overwrite the baseline table so a user does not have to change these 'baseline' versions each time they load the app.
In addition, there are some components that are 100% consistent. Currently those do not appear in the 'baseline' handsontable (since this is a tool to show inconsistency) but I have added a checkbox so that the user can still report on those components that are 100% consistent.
For some reason neither the fileUpload nor the checkboxInput are updating and no matter how much I poke and prod at my code, I cannot figure out why.
server.R
library(shiny)
library(rhandsontable)
library(rpivotTable)
library(dplyr)
library(stringr)
library(lubridate)
shinyServer(function(input, output) {
# Create dataframe
df.consistency <- structure(list(Node = structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L,
2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L), .Label = c("A", "B", "C",
"D"), class = "factor"), Component = structure(c(3L, 4L, 1L, 2L, 3L,
4L, 1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L, 1L, 2L), .Label = c("docker.version",
"kernel.version", "os.name", "os.version"), class = "factor"),
Version = structure(c(10L, 3L, 1L, 6L, 10L, 3L, 1L, 7L, 10L,
5L, 1L, 8L, 10L, 4L, 2L, 9L), .Label = c("1.12.1", "1.13.1",
"16.04", "17.04", "18.04", "3.10.0", "3.11.0", "3.12.0",
"3.13.0", "RedHat"), class = "factor")), class = "data.frame", row.names = c(NA,
-16L))
# Get Date Time
Report.Date <- Sys.Date()
df.baseline <- reactive({
inputFile <- input$uploadBaselineData
if(!is.null(inputFile)){
read.csv(inputFile$datapath, header = input$header)
} else{
if(input$showConsistent == FALSE){
# Count the number of occurrences for Version and Component, then remove the Components that are consistent (not duplicated => nn == 1) and then remove nn column
df.clusterCons.countComponent <- df.consistency %>%
add_count(Version, Component) %>%
add_count(Component) %>%
filter(nn > 1) %>%
select(-nn)
# Change back to dataframe after grouping
df.clusterCons.countComponent <- as.data.frame(df.clusterCons.countComponent)
# Components and Versions are shown for every node/cluster.
# Reduce this df to get only a unique Component:Version combinations
df.clusterCons.dist_tbl <- df.clusterCons.countComponent %>%
distinct(Component, Version, .keep_all = TRUE)
#Create a df that contains only duplicated rows (rows that are unique i.e. versions are consistent, are removed)
df.clusterCons.dist_tbl.dup <- df.clusterCons.dist_tbl %>%
filter(Component %in% unique(.[["Component"]][duplicated(.[["Component"]])]))
#Create a baseline df to be used to filter larger dataset later
#(baseline = max(n) for Version -- but must retain Component since that is the parameter we will use to filter on later)
df.clusterCons.baseline <- df.clusterCons.dist_tbl.dup[order(df.clusterCons.dist_tbl.dup$Component, df.clusterCons.dist_tbl.dup$n, decreasing = TRUE),]
df.clusterCons.baseline <- df.clusterCons.baseline[!duplicated(df.clusterCons.baseline$Component), ]
df.clusterCons.baseline <- df.clusterCons.baseline %>%
select(Component, Version)
}
else{
# Count the number of occurrences for Version and Component, then remove the Components that are consistent (not duplicated => nn == 1) and then remove nn column
df.clusterCons.countComponent <- df.consistency %>%
add_count(Version, Component) %>%
add_count(Component) %>%
select(-nn)
# Change back to dataframe after grouping
df.clusterCons.countComponent <- as.data.frame(df.clusterCons.countComponent)
# Components and Versions are shown for every node/cluster.
# Reduce this df to get only a unique Component:Version combinations
df.clusterCons.dist_tbl <- df.clusterCons.countComponent %>%
distinct(Component, Version, .keep_all = TRUE)
df.clusterCons.baseline <- df.clusterCons.dist_tbl[order(df.clusterCons.dist_tbl$Component, df.clusterCons.dist_tbl$n, decreasing = TRUE),]
df.clusterCons.baseline <- df.clusterCons.baseline[!duplicated(df.clusterCons.baseline$Component), ]
df.clusterCons.baseline <- df.clusterCons.baseline %>%
select(Component, Version)
}
}
})
df.componentVersionCounts <- df.consistency %>%
add_count(Component) %>%
rename("CountComponents" = n) %>%
add_count(Component, Version) %>%
rename("CountComponentVersions" = n) %>%
mutate("BaselineStats" = paste0("Baseline: ", round(CountComponentVersions / CountComponents * 100, 2), "% of Total: ", CountComponents)) %>%
select(Component, Version, BaselineStats) %>%
distinct(.keep_all = TRUE)
df.componentVersions_tbl <- reactive({
df.componentVersions_tbl <- df.baseline() %>%
distinct(Component, .keep_all = TRUE) %>%
select(Component, Version) %>%
left_join(df.componentVersionCounts, by = c("Component" = "Component", "Version" = "Version"))
})
# Report Date Output
output$reportDate <- renderText({
return(paste0("Report last run: ", Report.Date))
})
# handsontable showing baseline and allowing for an updated baseline
output$baseline_table <- rhandsontable::renderRHandsontable({
rhandsontable(df.componentVersions_tbl(), rowHeaders = NULL) %>%
hot_col("Component", readOnly = TRUE) %>%
hot_col("BaselineStats", readOnly = TRUE) %>%
hot_cols(columnSorting = TRUE) %>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE, filters = TRUE)
})
observe({
hot = isolate(input$baseline_table)
if(!is.null(input$baseline_table)){
handsontable <- hot_to_r(input$baseline_table)
df.clusterCons.baseline2 <- handsontable %>%
select(-BaselineStats)
df.componentVersions_tbl <- df.clusterCons.baseline2 %>%
left_join(df.componentVersionCounts, by = c("Component" = "Component", "Version" = "Version"))
output$baseline_table <- rhandsontable::renderRHandsontable({
rhandsontable(df.componentVersions_tbl, rowHeaders = NULL) %>%
hot_col("Component", readOnly = TRUE) %>%
hot_col("BaselineStats", readOnly = TRUE) %>%
hot_cols(columnSorting = TRUE) %>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE, filters = TRUE)
})
df.clusterIncons <- anti_join(df.consistency, handsontable, by = c("Component" = "Component", "Version" = "Version"))
df.clusterIncons <- df.clusterIncons
# Pivot Table showing data with inconsistencies
output$pivotTable <- rpivotTable::renderRpivotTable({
rpivotTable::rpivotTable(df.clusterIncons, rows = c("Cluster", "Node"), cols = "Component", aggregatorName = "List Unique Values", vals = "Version",
rendererName = "Table",
inclusions = list(Component = list("os.version", "os.name", "kernel.version", "docker.version")))
})
output$downloadBaselineData <- downloadHandler(
filename = function() {
paste('baselineData-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
baseline_handsontable <- handsontable %>%
select(-BaselineStats)
write.csv(baseline_handsontable, file, row.names = FALSE)
}
)
output$downloadPivotData <- downloadHandler(
filename = function() {
paste('pivotData-', Sys.Date(), '.csv', sep='')
},
content = function(file) {
write.csv(df.clusterIncons, file, row.names = FALSE)
}
)
}
})
})
ui.R
library(shiny)
library(shinydashboard)
library(rhandsontable)
library(rpivotTable)
dashboardPage(
dashboardHeader(title = "Test Dashboard", titleWidth = "97%"),
dashboardSidebar(
collapsed = TRUE,
sidebarMenu(
menuItem("App", tabName = "app", icon = icon("table"))
)
),
dashboardBody(
tabItems(
tabItem("app",
fluidRow(
box(width = 3, background = "light-blue",
"This box includes details to the user about how the application works", br(), br(), br(),
verbatimTextOutput("reportDate")
),
box(width = 7, status = "info", title = "Version baselines based on greatest occurance",
rHandsontableOutput("baseline_table", height = "350px")
),
column(width = 2,
fluidRow(
fileInput("uploadBaselineData", "Upload Other Baseline Data:", multiple = FALSE,
accept = ".csv")
),
fluidRow(
downloadButton("downloadBaselineData", "Download Baseline Data")
),
br(),
fluidRow(
downloadButton("downloadPivotData", "Download Pivot Table Data")
),
br(),
fluidRow(
checkboxInput("showConsistent", "Show Consistent Components in baseline")
)
)
),
fluidRow(
box(width = 12, status = "info", title = "Nodes with versions inconsistent with baseline",
div(style = 'overflow-x: scroll', rpivotTable::rpivotTableOutput("pivotTable", height = "500px"))
)
)
)
)
)
)
I have worked with reactivity quite often but I do not frequently use observe or isolate so that may be where I am running into an issue. I did also try out the new reactlog package but I am still not sure of a path forward.
Here is a picture of the reactlog output before I click the check box or upload new baseline data:
And after:
Actually the given structure of the Shiny App is very tangled and it does not use reactivity efficiently. So first we can start with a simpler app to make sure the basic components are working, then add more.
Some of the problems
the included dataframe df.consistency interferes with the real reactive components you want to add. For instance, the if/else flow is problematic because it always jumps to the first else since the csv does not exist when the app is launched and the expression to read it is not accurate, however df.consistency is always available.
there is duplication of the same component like output$baseline_table which is defined twice.
with read.csv, you passed an argument header = input$header which is not defined (if you took this from the example here, it refers to the checkbox, but it is not valid here).
Minimal app
If you want to start with a minimal app, you can start with the following code. This will allow you to:
use default data or upload a csv to override the default.
view the results in the rhandsontable in the middle.
Notice that:
baseline_data is reactive, that's why the other expressions that use it are also reactive.
if you want to have different calculations of df.componentVersionCounts depending on the checkbox, you can add the if/else inside the expression to write the calculations for both cases.
library(shiny)
library(rpivotTable)
library(dplyr)
library(stringr)
library(lubridate)
library(shinydashboard)
library(rhandsontable)
## UI ------------------------------------------------------------------------------
ui <- dashboardPage(
dashboardHeader(title = "Test Dashboard", titleWidth = "97%"),
dashboardSidebar(
collapsed = TRUE,
sidebarMenu(
menuItem("App", tabName = "app", icon = icon("table"))
)
),
dashboardBody(
tabItems(
tabItem("app",
fluidRow(
box(width = 3, background = "light-blue",
"This box includes details to the user about how the application works", br(), br(), br(),
verbatimTextOutput("reportDate")
),
box(width = 7, status = "info", title = "Version baselines based on greatest occurance",
rHandsontableOutput("baseline_table", height = "350px")
),
column(width = 2,
fluidRow(
fileInput("uploadBaselineData", "Upload Other Baseline Data:", multiple = FALSE,
accept = ".csv")
),
fluidRow(
checkboxInput("showConsistent", "Show Consistent Components in baseline")
)
)
)
)
)
)
)
## define default baseline data
df.consistency <- structure(list(Node = structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L,
2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L),
.Label = c("A", "B", "C",
"D"), class = "factor"), Component = structure(c(3L, 4L, 1L, 2L, 3L,
4L, 1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L, 1L, 2L), .Label = c("docker.version",
"kernel.version", "os.name", "os.version"), class = "factor"),
Version = structure(c(10L, 3L, 1L, 6L, 10L, 3L, 1L, 7L, 10L,
5L, 1L, 8L, 10L, 4L, 2L, 9L),
.Label = c("1.12.1", "1.13.1",
"16.04", "17.04", "18.04", "3.10.0", "3.11.0", "3.12.0",
"3.13.0", "RedHat"), class = "factor")), class = "data.frame", row.names = c(NA,
-16L))
## Server ------------------------------------------------------------------
server <- function(input, output) {
## Get Date Time
Report.Date <- Sys.Date()
baseline_data <- reactive({
inputFile <- input$uploadBaselineData
if(!is.null(inputFile)){
## WHEN A CSV IS UPLOADED
read.csv(inputFile$datapath)
}else{
## DEFAULT
df.consistency #or write the any other expression to read from a certain path or query
}
})
## df.componentVersionCounts ---------------------------------------------------------------
df.componentVersionCounts <- reactive({
req(baseline_data())
baseline_data() %>%
add_count(Component) %>%
rename("CountComponents" = n) %>%
add_count(Component, Version) %>%
rename("CountComponentVersions" = n) %>%
mutate("BaselineStats" = paste0("Baseline: ", round(CountComponentVersions / CountComponents * 100, 2), "% of Total: ", CountComponents)) %>%
select(Component, Version, BaselineStats) %>%
distinct(.keep_all = TRUE)
})
## df.componentVersions_tbl ------------------------------------------------------------
df.componentVersions_tbl <- reactive({
req(baseline_data())
baseline_data() %>% ##df.baseline()
distinct(Component, .keep_all = TRUE) %>%
select(Component, Version) %>%
left_join(df.componentVersionCounts(),
by = c("Component" = "Component", "Version" = "Version"))
})
# handsontable showing baseline and allowing for an updated baseline ---------------------
output$baseline_table <- rhandsontable::renderRHandsontable({
rhandsontable(df.componentVersions_tbl(), rowHeaders = NULL) %>%
hot_col("Component", readOnly = TRUE) %>%
hot_col("BaselineStats", readOnly = TRUE) %>%
hot_cols(columnSorting = TRUE) %>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE, filters = TRUE)
})
# Report Date Output -------------------------------------------------------
output$reportDate <- renderText({
return(paste0("Report last run: ", Report.Date))
})
}
# Run the application
shinyApp(ui = ui, server = server)
New R shiny user here..
I have 6 filters for a datatable and want to be able to have dynamic filters working in any direction. For instance: I have filters A, B, C, D, E, F. If I filter at A or B or C etc, I want all the other filters dynamically update to show unique() of filtered datatable and so on if I move through the filters in any direction.
I tried a bunch of different techniques and they all didn't seem to work well. Eventually I bit the bullet and wrote the most verbose code to account for all possible combinations of filter directions. So for example:
First in ui.R I set up selectInput for filters A, B, C, D, E, F
Then in server.R I easily filter the table
tt <- reactive({
dt <- mytable
dt <- dt[,input$ColumnsToShow2,drop=FALSE]
if (input$A != "All") {
dt <- dt[dt$A == input$A,]
}
if (input$B != "All") {
dt <- dt[dt$B == input$B,]
}
if (input$C != "All") {
dt <- dt[dt$C == input$C,]
}
if (input$D != "All") {
dt <- dT[dt$D == input$D,]
}
if (input$E != "All") {
dt <- dt[dt$E == input$E,]
}
if (input$F != "All") {
dt <- dt[dt$F == input$F,]
}
dt
})
and then I go -
observe({
#One filter is used:
If A!="All" && B && C && D && E && F are all =="All", then UpdateSelectInput filters B,C,D,E,F
If B!="All" and A && C && D && E && F are all == "All", then
UpdateSelectInput filters A,C,D,E,F
If C and so on, you get the logic
#Two filters are used:
If A!="All" && B!="All" && C && D && E && F are all == "All", then
UpdateSelectInput filters C, D, E, F
if A!="All" && C!="All" && B && D && E && F are all == "All", then
UpdateSelectInput filters B, D, E, F
#etc all the way through
if E!="All" && F!="All" && A && B && C && D are all == "All", then
UpdateSelectInput filters A, B, C, D.
#three filters are used...all the way through 5 filters are used
)}
You get the point now. I'm pretty sure you can set up a similar example to work with.
NB: When I tried to only use just 6 if != "All" without the additional "&&" conditions for the boolean (like I did to filter the datatable itself), it did not work.
I have the filters working perfectly this way like I want them, but my gut feeling is that I'm working too hard at this.
Thanks for reading all this and for your help!!
Addendum - here's an example that I was expecting to work but doesn't:
data <- structure(list(Country.Name = structure(c(1L, 1L, 1L, 1L, 1L,
1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L
), .Label = c("High income", "Low income", "Mid income"), class =
"factor"),
Country.Code = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L,
3L), .Label = c("HIC",
"LIC", "MIC"), class = "factor"), Indicator.Name = structure(c(10L,
9L, 11L, 8L, 6L, 4L, 7L, 5L, 3L, 2L, 18L, 19L, 1L, 17L, 16L,
12L, 20L, 13L, 14L, 15L, 3L), .Label = c("2005 PPP conversion factor,
GDP (LCU per international $)",
"2005 PPP conversion factor, private consumption (LCU per international
$)",
"Adequacy of social protection and labor programs (% of total welfare
of beneficiary households)",
"Adequacy of unemployment benefits and ALMP (% of total welfare of
beneficiary households)",
"Benefit incidence of social protection and labor programs to poorest
quintile (% of total SPL benefits)",
"Benefit incidence of unemployment benefits and ALMP to poorest
quintile (% of total U/ALMP benefits)",
"Coverage of social protection and labor programs (% of population)",
"Coverage of unemployment benefits and ALMP (% of population)",
"Coverage of unemployment benefits and ALMP in 2nd quintile (% of
population)",
"Coverage of unemployment benefits and ALMP in 3rd quintile (% of
population)",
"Coverage of unemployment benefits and ALMP in poorest quintile (% of
population)",
"DEC alternative conversion factor (LCU per US$)", "Net secondary
income (Net current transfers from abroad) (constant LCU)",
"Net secondary income (Net current transfers from abroad) (current
LCU)",
"Net secondary income (Net current transfers from abroad) (current
US$)",
"Official exchange rate (LCU per US$, period average)", "PPP conversion
factor, GDP (LCU per international $)",
"PPP conversion factor, private consumption (LCU per international $)",
"Price level ratio of PPP conversion factor (GDP) to market exchange
rate",
"Terms of trade adjustment (constant LCU)"), class = "factor"),
Indicator.Code = structure(c(21L, 20L, 19L, 18L, 17L, 16L,
15L, 14L, 13L, 12L, 11L, 10L, 9L, 8L, 7L, 6L,
5L, 4L, 3L,
2L, 1L), .Label = c("NY.GSR.NFCY.CN",
"NY.GSR.NFCY.KN", "NY.TAX.NIND.CD",
"NY.TAX.NIND.CN",
"NY.TAX.NIND.KN", "NY.TRF.NCTR.CD", "NY.TRF.NCTR.CN",
"NY.TRF.NCTR.KN",
"NY.TTF.GNFS.KN", "PA.NUS.ATLS", "PA.NUS.FCRF",
"PA.NUS.PPP",
"PA.NUS.PPP.05", "PA.NUS.PPPC.RF", "per_allsp.cov_pop_tot",
"per_lm_alllm.adq_pop_tot", "per_lm_alllm.ben_q1_tot",
"per_lm_alllm.cov_pop_tot",
"per_lm_alllm.cov_q1_tot",
"per_lm_alllm.cov_q2_tot", "per_lm_alllm.cov_q3_tot"
), class = "factor"), Source.no =
structure(c(3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 8L, 1L, 7L, 8L, 1L, 5L, 4L, 9L, 6L,
2L, 10L, 11L), .Label = c(" for Economic Co-operation and Development
(OECD).",
" nonresidents. Data are in current local currency.", "es include both
direct and indirect beneficiaries.",
"expressed in local currency units per U.S. dollar.", "local currency
units relative to the U.S. dollar).",
"nonresidents. Data are in constant local currency.", "onversion
factors are based on the 2011 ICP round.",
"rapolated estimates based on the latest ICP round.", "stant prices.
Data are in constant local currency.",
"to nonresidents. Data are in current U.S. dollars.", "to producers.
Data are in constant local currency."
), class = "factor"), Source.organization = structure(c(4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 2L, 5L,
3L, 3L, 3L, 3L, 3L), .Label = c("d Bank, International Comparison
Program database.",
"Monetary Fund, International Financial Statistics.", "ounts data, and
OECD National Accounts data files.",
"sehold surveys. (datatopics.worldbank.org/aspire/)", "stics,
supplemented by World Bank staff estimates."
), class = "factor")), .Names = c("Country.Name", "Country.Code",
"Indicator.Name", "Indicator.Code", "Source.no", "Source.organization"
), class = "data.frame", row.names = c(NA, -21L))
shinyApp(
ui = fluidPage(
fluidRow(
column(2,
selectInput("CN",
"Country name:",
c("All",
unique(as.character(data$Country.Name))))
),
column(2,
selectInput("CC",
"Country code:",
c("All",
unique(as.character(data$Country.Code))))
),
column(2,
selectInput("IN",
"Indicator name:",
c("All",
unique(as.character(data$Indicator.Name))))
),
column(2,
selectInput("IC",
"Indicator Code:",
c("All",
unique(as.character(data$Indicator.Code))))
),
column(2,
selectInput("SN",
"Source no:",
c("All",
unique(as.character(data$Source.no))))
),
column(2,
selectInput("SO",
"Source org:",
c("All",
unique(as.character(data$Source.organization))))
)
),
fluidRow(
div(DT::dataTableOutput("table1"),style="font-size: 100%",tags$head(tags$style(type="text/css", "#table table td {line-height:50%;}")) )
)
),
server = function(input, output,session) {
table_one <- reactive({
if (input$CN != "All") {
data <- data[data$Country.Name == input$CN,]
}
if (input$CC != "All") {
data <- data[data$Country.Code == input$CC,]
}
if (input$IN != "All") {
data <- data[data$Indicator.Name == input$IN,]
}
if (input$IC != "All") {
data <- data[data$Indicator.Code == input$IC,]
}
if (input$SN != "All") {
data <- data[data$Source.no == input$SN,]
}
if (input$SO != "All") {
data <- data[data$Source.organization == input$SO,]
}
data
})
output$table1 <- DT::renderDataTable(DT::datatable({
table_one()
},rownames = FALSE,
options = list(scrollX=TRUE,
autoWidth = TRUE,
columnDefs = list(list(width = '150px', targets = "_all")))
))
#filter code begin
#if all filters are "all"
observe({
if (input$CN=="All"&&input$CC=="All"&&input$IN=="All"&&input$IC=="All"&&input$SN=="All"&&input$SO=="All"){
updateSelectInput(session,"CN",choices = c("All",unique(as.character(data$Country.Name))))
updateSelectInput(session,"CC",choices = c("All",unique(as.character(data$Country.Code))))
updateSelectInput(session,"IN",choices = c("All",unique(as.character(data$Indicator.Name))))
updateSelectInput(session,"IC",choices = c("All",unique(as.character(data$Indicator.Code))))
updateSelectInput(session,"SN",choices = c("All",unique(as.character(data$Source.no))))
updateSelectInput(session,"SO",choices = c("All",unique(as.character(data$Source.organization))))
}
#otherwise
if (input$CN!="All"){
#updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
}
if (input$CC!="All"){
updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
#updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
}
if (input$IN!="All"){
updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
#updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
}
if (input$IC!="All"){
updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
#updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
}
if (input$SN!="All"){
updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
#updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
}
if (input$SO!="All"){
updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
#updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
}
})
}
)
Using the filter() function and piping from dplyr might be the answer. I used it inside of a renderPlot({}) server function, and it worked for me (I didn't try it in an observe function).
data = data %>% filter(if(input$CN == 'ALL'){Country.Name %in% c("countryname_1", "countryname_2",...,"countryname_n")} else {Country.Name == input$CN}) %>%
filter(if(input$CC == 'ALL'){Country.Code %in% c("countrycode_1",..,"countrycode_n")} else {Country.Code == input$CC}) %>%
and so on for each filter
There is probably a better way to get the unfiltered version in case you have a lot of countries than this part inside the if statement: Country.Code %in% c("countrycode_1",..,"countrycode_n") , but the if/else nested inside the filter, and filter statements for each attribute connected with %>% piping worked for me (and saved a LOT of space).
These links might help too:
filtering values
using filter with if/else statement
*edit update: I ended up put this filter function configuration in the observe function and it works great, seems more organized too
You dont have to code individually to update each dropdown. You can make the dataset reactive, and set the dropdowns choices as column values from that reactive dataset.
You might want to use Observe function, to update the SelectInput.
observe(
UpdateSelectInput(session,inputId,label, choices = c(unique(dataframe()$Column))
)
if you provide a reproducible example, it would be easier to demonstrate
Updated Solution
shinyApp(
ui = fluidPage(
fluidRow(
column(2,
selectInput("CN",
"Country name:",
c("All",
unique(as.character(data$Country.Name))))
),
column(2,
selectInput("CC",
"Country code:",
c("All",
unique(as.character(data$Country.Code))))
),
column(2,
selectInput("IN",
"Indicator name:",
c("All",
unique(as.character(data$Indicator.Name))))
),
column(2,
selectInput("IC",
"Indicator Code:",
c("All",
unique(as.character(data$Indicator.Code))))
),
column(2,
selectInput("SN",
"Source no:",
c("All",
unique(as.character(data$Source.no))))
),
column(2,
selectInput("SO",
"Source org:",
c("All",
unique(as.character(data$Source.organization))))
)
),
fluidRow(
div(DT::dataTableOutput("table1"),style="font-size: 100%",tags$head(tags$style(type="text/css", "#table table td {line-height:50%;}")) )
),
fluidRow(actionButton('reset','reset'))
),
server = function(input, output,session) {
rv = reactiveValues()
rv$data=data
observe({
#table_one <- data
if (input$CN != "All") {
rv$data <- rv$data[rv$data$Country.Name == input$CN,]
}
if (input$CC != "All") {
rv$data <- rv$data[rv$data$Country.Code == input$CC,]
}
if (input$IN != "All") {
rv$data <- rv$data[rv$data$Indicator.Name == input$IN,]
}
if (input$IC != "All") {
rv$data <- rv$data[rv$data$Indicator.Code == input$IC,]
}
if (input$SN != "All") {
rv$data <- rv$data[rv$data$Source.no == input$SN,]
}
if (input$SO != "All") {
rv$data <- rv$data[data$Source.organization == input$SO,]
}
})
observeEvent(input$reset,{
rv$data <- data
})
output$table1 <- DT::renderDataTable(DT::datatable({
rv$data
},rownames = FALSE,
options = list(scrollX=TRUE,
autoWidth = TRUE,
columnDefs = list(list(width = '150px', targets = "_all")))
))
#filter code begin
#if all filters are "all"
observe({
#if (input$CN=="All"&&input$CC=="All"&&input$IN=="All"&&input$IC=="All"&&input$SN=="All"&&input$SO=="All"){
updateSelectInput(session,"CN",choices = c("All",unique(as.character(rv$data$Country.Name))))
updateSelectInput(session,"CC",choices = c("All",unique(as.character(rv$data$Country.Code))))
updateSelectInput(session,"IN",choices = c("All",unique(as.character(rv$data$Indicator.Name))))
updateSelectInput(session,"IC",choices = c("All",unique(as.character(rv$data$Indicator.Code))))
updateSelectInput(session,"SN",choices = c("All",unique(as.character(rv$data$Source.no))))
updateSelectInput(session,"SO",choices = c("All",unique(as.character(rv$data$Source.organization))))
})
}
)
The code demonstrates how you can update the dropdowns using reactiveValues. I havent written up code to handle the 'All' situation, but have provided a Reset button as a workaround. You can add on code to capture the All situation without the need for a reset button.
I am creating a shiny app where I want the user to download data from the shiny app into one single excel file with multiple(more than one) datasets in the same sheet. I looked at the other similar questions but I am not able to get my code working with that help.
Datasets Used:
sample <- structure(list(type = structure(c(1L, 5L, 3L, 5L, 2L, 4L), .Label = c("add select multiple prompt using alphaOptions",
"add select multiple prompt using imageOptions", "add select one prompt using alphaOptions",
"add select one prompt using imageOptions", "add select one prompt using numOptions"
), class = "factor"), name = structure(c(4L, 5L, 3L, 6L, 1L,
2L), .Label = c("grid", "grid_two_columns", "quick_advance",
"select", "select1", "spinner"), class = "factor"), caption = structure(c(4L,
5L, 3L, 6L, 1L, 2L), .Label = c("grid widget", "grid with a maximum of two columns",
"quick advance select widget", "select multiple widget", "select one widget",
"spinner widget"), class = "factor"), hint = structure(c(4L,
6L, 1L, 3L, 2L, 5L), .Label = c("click a choice to select it and advance to the next question",
"click an image to select it (you must have the images on your sdcard to see them)",
"click the button to provide a response", "don't pick c and d together",
"regardless of screen size this widget will only show two columns of images",
"scroll down to see default selection"), class = "factor")), .Names = c("type",
"name", "caption", "hint"), class = "data.frame", row.names = c(NA,
-6L))
profile <- structure(list(Company.Name = structure(c(1L, 3L, 4L, 2L, 5L), .Label = c("Address",
"Assigned MB", "Contact Name", "Contact Phone", "Website"), class = "factor"),
ABC = structure(c(2L, 5L, 1L, 3L, 4L), .Label = c("(398) 657-8401",
"48,S St, Denver, CO, 80233", "Bob Harris, Active", "www.abc.com",
"John Gardner"), class = "factor")), .Names = c("Company.Name",
"ABC"), class = "data.frame", row.names = c(NA, -5L))
I have this same data as csv files.
Below is my code for excel with two sheets:
ui.R
shinyUI(pageWithSidebar(
headerPanel('Download'),
sidebarPanel(
downloadButton('downloadData', 'Download')
),
mainPanel(
)
))
server.R
sample <- read.csv("sample.csv")
profile <- read.csv("profile.csv")
shinyServer(function(input, output) {
output$downloadData <- downloadHandler(
filename = "test.xlsx",
content = function(file) {
write.xlsx2(profile, file, sheetName = "Sheet1")
write.xlsx2(sample, file, sheetName = "Sheet2", append = TRUE)
}
)
})
This is what I am trying for downloading both datasets in the same sheet.
shinyServer(function(input, output) {
output$downloadData <- downloadHandler(
filename = "test.xlsx",
content = function(file) {
write.xlsx2(profile, file, sheetName = "Sheet1")
write.xlsx2(sample, file, sheetName = "Sheet1", append = TRUE)
}
)
})
This is the error I get:
Error : java.lang.IllegalArgumentException: The workbook already contains a sheet of this name
Warning: Error in .jcall: java.lang.IllegalArgumentException: The workbook already contains a sheet of this name
Stack trace (innermost first):
I am expecting the profile and sample datasets to be one below the other in one sheet with some space between them something like in the image below:
I don't think append() works within a given sheet, but you can use the addDataFrame() function:
data <- data.frame(a = 1:3, b = 4:6, c = 7:9)
wb <- createWorkbook()
sheet <- createSheet(wb, sheetName="addDataFrame1")
addDataFrame(data, sheet, row.names = FALSE)
addDataFrame(data, sheet, startRow = nrow(data) + 3, , row.names = FALSE)
saveWorkbook(wb, file = "test.xlsx")
I have two map plots of 'Total Population' and 'Population Density' created using a shape file. Now, I'm trying to build a shiny app so that I can change from Total Population to Population Density and the plot should change accordingly. When I ran the code, i got following error code:
Warning: Error in : ggplot2 doesn't know how to deal with data of class matrix
Here's the code that i've been trying to use:
library(shiny)
library(ggplot2) #Loading necessary libraries
ui <- fluidPage(
selectInput("mr",
label="Type of Plot",
choices=c("Total Population", "Density"),
selected="Total Population"),
plotOutput("curv") #Giving an input name and listing out types to choose in the Shiny app
)
server <- function(input, output){
output$curv <- renderPlot({
ggplot() +
geom_polygon(data = final.plot==input$mr,
aes(x = long, y = lat, group = group, fill = Population),
color = "black", size = 0.20) +
coord_map()+
scale_fill_distiller(name="Population", palette = "YlGn")+
labs(title="Population in Australia")
}) # Output with the data file and input string to change when input changes.
}
shinyApp(ui = ui, server = server)
Any help is greatly appreciated.
UPDATE:
My dataset looks like this:
id long lat order hole piece
1 Ashmore and Cartier Islands 123.1169 -12.25333 1 FALSE 1
2 Ashmore and Cartier Islands 123.1206 -12.25611 2 FALSE 1
3 Ashmore and Cartier Islands 123.1222 -12.25861 3 FALSE 1
4 Ashmore and Cartier Islands 123.1239 -12.25528 4 FALSE 1
5 Ashmore and Cartier Islands 123.1258 -12.25333 5 FALSE 1
6 Ashmore and Cartier Islands 123.1275 -12.25619 6 FALSE 1
group Population Density
1 Ashmore and Cartier Islands.1 NA NA
2 Ashmore and Cartier Islands.1 NA NA
3 Ashmore and Cartier Islands.1 NA NA
4 Ashmore and Cartier Islands.1 NA NA
5 Ashmore and Cartier Islands.1 NA NA
6 Ashmore and Cartier Islands.1 NA NA
This is stored in the DataFrame called "final.plot". There's values of Population and Density for other states. I was able to create a static visualisation of Population and it looks like this:
There's a similar one for Density and I'm trying to create Shiny app where i can switch between these two so that the plot changes accordingly. Right now I've tried the following code:
library(shiny)
library(ggplot2) #Loading necessary libraries
ui <- fluidPage(
selectInput("pop",
label="Type of Plot",
choices=c("Population", "Density"),
selected="Total Population"),
plotOutput("curv") #Giving an input name and listing out types to choose in the Shiny app
)
server <- function(input, output){
output$curv <- renderPlot({
ggplot() +
geom_polygon(data = final.plot,
aes(x = long, y = lat, group = group, fill = input$pop),
color = "black", size = 0.25) +
coord_map()+
scale_fill_distiller(name="Density", palette = "Spectral")+
labs(title="Population in Australia")
})
}
shinyApp(ui = ui, server = server)
But I'm getting an error saying "Discrete value supplied to continuous scale".
UPDATE 2:
Here's the link for the dataset i'm using:
Dataset
I've had a quick look at your code and have a couple of suggestions.
1) When providing your data set you can use the function dput() - this writes a text representation of your data.frame which people answering your question can simply paste into R. For example:
dput(final.plot)
This will produce text output that I can assign to a dataframe by prefixing final.plot <- to the output. I have recreated your dataframe and used dput() to output it as text below. Now other users can quickly cut & paste your data:
Note this dataset is faulty - see below
final.plot <- structure(list(id = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = "Ashmore and Cartier Islands", class = "factor"),
long = c(123.1169, 123.1206, 123.1222, 123.1239, 123.1258, 123.1275),
lat = c(-12.25333, -12.25611, -12.25861, -12.25528, -12.25333, -12.25619),
order = 1:6, hole = c(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE),
piece = c(1L, 1L, 1L, 1L, 1L, 1L),
group = structure(c(1L, 1L, 1L, 1L, 1L, 1L),
.Label = "Ashmore and Cartier Islands.1", class = "factor"),
Population = c(NA, NA, NA, NA, NA, NA),
Density = c(NA, NA, NA, NA, NA, NA)),
.Names = c("id", "long", "lat", "order", "hole", "piece", "group", "Population", "Density"),
class = "data.frame",
row.names = c(NA, -6L))
The error "Discrete value supplied to continuous scale" is caused by two issues.
i) You are passing NA in both your Population and Density columns. The dataframe below adds some (unrealistic) numbers to these columns and the error is removed when I run the plotting code in isolation.
Corrected Toy Dataset
final.plot <- structure(list(id = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = "Ashmore and Cartier Islands", class = "factor"),
long = c(123.1169, 123.1206, 123.1222, 123.1239, 123.1258, 123.1275),
lat = c(-12.25333, -12.25611, -12.25861, -12.25528, -12.25333, -12.25619),
order = 1:6, hole = c(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE),
piece = c(1L, 1L, 1L, 1L, 1L, 1L),
group = structure(c(1L, 1L, 1L, 1L, 1L, 1L),
.Label = "Ashmore and Cartier Islands.1", class = "factor"),
Population = c(1, 2, 3, 4, 5, 6),
Density = c(7, 3, 9, 1, 3, 6)),
.Names = c("id", "long", "lat", "order", "hole", "piece", "group", "Population", "Density"),
class = "data.frame",
row.names = c(NA, -6L))
ii) When run interactively the error is caused because you are not passing appropriate data to fill in fill = input$pop. You should be passing the values from final.plot$Population or final.plot$Density depending on what was selected. You are instead passing the output of the dropdown box - "Population" or "Density". This can be corrected using a switch statement within renderPlot:
# User input assigns appropriate data to selectedData which can be passed to other functions:
selectedData <- switch(input$pop,
"Population" = final.plot$Population,
"Density" = final.plot$Density)
2) It would be helpful if you could provide the code which produced the static map you show in your Update above. When debugging Shiny code I find it easiest to get the function working non-interactively first and then to incorporate it into Shiny. I tried to extract your plotting code below but it is not producing the expected results:
library(ggplot2) #Loading necessary libraries
library(mapproj)
library(maps)
ggplot() +
geom_polygon(data = final.plot,
[![aes(x = long, y = lat, group = group, fill = Population),
color = "black", size = 0.25) +
coord_map()+
scale_fill_distiller(name="Density", palette = "Spectral")+
labs(title="Population in Australia")`
3) I am not familiar with plotting data onto maps in R but I believe your app will need to load in library(mapproj) and library(maps) to get the results you need. Here is all the above put together:
library(shiny)
library(ggplot2) #Loading necessary libraries
#I added the two lines below:
library(mapproj)
library(map)
ui <- fluidPage(
selectInput("pop",
label="Type of Plot",
choices=list("Population", "Density"),
selected="Population"), #NOTE: Total Population changed to Population so that it selects correct default value
plotOutput("curv") #Giving an input name and listing out types to choose in the Shiny app
)
server <- function(input, output){
#You will probably want to simply import your dataframe final.plot using read.table etc:
final.plot <- structure(list(id = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = "Ashmore and Cartier Islands", class = "factor"),
long = c(123.1169, 123.1206, 123.1222, 123.1239, 123.1258, 123.1275),
lat = c(-12.25333, -12.25611, -12.25861, -12.25528, -12.25333, -12.25619),
order = 1:6, hole = c(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE),
piece = c(1L, 1L, 1L, 1L, 1L, 1L),
group = structure(c(1L, 1L, 1L, 1L, 1L, 1L),
.Label = "Ashmore and Cartier Islands.1", class = "factor"),
Population = c(1, 2, 3, 4, 5, 6),
Density = c(7, 3, 9, 1, 3, 6)),
.Names = c("id", "long", "lat", "order", "hole", "piece", "group", "Population", "Density"),
class = "data.frame",
row.names = c(NA, -6L))
output$curv <- renderPlot({
#Assign value of selectedData based upon user input:
selectedData <- switch(input$pop,
"Population" = final.plot$Population,
"Density" = final.plot$Density)
ggplot() +
geom_polygon(data = final.plot,
aes(x = long, y = lat, group = group, fill = selectedData),
color = "black", size = 0.25) +
coord_map()+
scale_fill_distiller(name="Density", palette = "Spectral")+
labs(title="Population in Australia")
})
}
shinyApp(ui = ui, server = server)
Now all you need to do is substitute your code which produced the static map shown in your update for the faulty code in renderPlot in your shiny app.