I have a simple shiny app in which I use a numericInput() "tests" to add rows to the dataframe. Then I give the names of the "Label" column as choices to the selectInput() "Label2". The problem is that when I edit the names in column "Label" of the table the selectInput() choices are not updated accordingly. For example if I rename "Test 1" to "Test A" in the table I want it to change in the selectInput() as well.
#ui.r
library(shiny)
library(rhandsontable)
ui <- navbarPage(
"Application",
tabPanel("General",
sidebarLayout(
sidebarPanel(
uiOutput("tex2")
),
mainPanel(
rHandsontableOutput("hot3"),
uiOutput("book12")
)
)))
#server.r
server <- function(input, output,session) {
output$tex2<-renderUI({
numericInput("text2", "#tests", value = 1, min=1)
})
output$book12<-renderUI({
selectInput("bk12",
"Label2",
choices=(rt4()$Label))
})
rt4<-reactive({
DF <- data.frame(
Label=paste("Test",1:input$text2),
stringsAsFactors = FALSE)
})
output$hot3 <-renderRHandsontable(
rhandsontable(rt4())
)
}
This seems to work. You were not reading back the edited rhandsontable
in your code.
So i ve added an observe to do this
observe({
if(!is.null(input$hot3))
rt4$DF <- hot_to_r(input$hot3)
})
Also in the code, Ive added some req statements to check for NULL conditions at the time of initialisation, you can use the if..else mechanism that you have used in some of your other questions too.
#ui.r
library(shiny)
library(rhandsontable)
ui <- navbarPage(
"Application",
tabPanel("General",
sidebarLayout(
sidebarPanel(
uiOutput("tex2")
),
mainPanel(
rHandsontableOutput("hot3"),
uiOutput("book12")
)
)))
#server.r
server <- function(input, output,session) {
rt4<- reactiveValues()
output$tex2<-renderUI({
numericInput("text2", "#tests", value = 1, min=1)
})
output$book12<-renderUI({
selectInput("bk12",
"Label2",
choices=(rt4$DF$Label))
})
observe({
req(input$text2)
rt4$DF <- data.frame(
Test=paste(1:input$text2),
Label=paste("Test",1:isolate(input$text2)),
stringsAsFactors = FALSE)
})
output$hot3 <-renderRHandsontable({
req(input$text2)
rhandsontable(rt4$DF)
} )
observe({
if(!is.null(input$hot3))
rt4$DF <- hot_to_r(input$hot3)
})
}
shinyApp(ui,server)
Related
in Shiny I simply want to select which variable of a dataframe shall be plotted and I do not want to have to type all the variable names in the server switch part. Here is what I do:
ui <- fluidPage(
titlePanel("Hello World!"),
sidebarLayout(
sidebarPanel(
selectInput("variable", "Choose a variable:",
# choices = c("cyl", "mpg")),
choices = names(mtcars)),
),
mainPanel(
plotOutput(outputId = "BarPlot"),
)
)
)
server <- function(input, output) {
datasetInput <- reactive({
switch(input$variable,
"cyl" = mtcars[,"cyl"],
"mpg" = mtcars[,"mpg"])
})
output$BarPlot <- renderPlot({
x <- datasetInput()
barplot(table(x))
})
}
Instead of
switch(input$variable,
"cyl" = mtcars[,"cyl"],
"mpg" = mtcars[,"mpg"])
can I do something like
choices = mtcars[,get(choices)]
to cover all choices without having to type them one by one?
One approach is to use varSelectInput and pass the data frame as data (it will include all column names as the choices). Then you can extract the selected column from mtcars through mtcars[[input$variable]] in your example:
library(shiny)
ui <- fluidPage(
titlePanel("Hello World!"),
sidebarLayout(
sidebarPanel(
varSelectInput("variable",
"Choose a variable:",
data = mtcars),
),
mainPanel(
plotOutput(outputId = "BarPlot"),
)
)
)
server <- function(input, output) {
datasetInput <- reactive({
mtcars[[input$variable]]
})
output$BarPlot <- renderPlot({
x <- datasetInput()
barplot(table(x))
})
}
shinyApp(ui, server)
I have a simple shiny app in which I use a selectInput() "Label" to select a Label from the datatable and then change its name with textInput() "Change to". The problem is that I want the application to keep all the name changes I make and not returning to the default name when I choose another Label. I think the problem is that the DF exists only within rt4 function and not outside it so it's recreated at each rendering.
#ui.r
navbarPage(
"Application",
tabPanel("General",
sidebarLayout(
sidebarPanel(
uiOutput("book3"),
uiOutput("book6")
),
mainPanel(
DT::dataTableOutput("hot3")
)
)))
#server.r
library(shiny)
library(DT)
server <- function(input, output,session) {
output$book3<-renderUI({
selectInput("bk3",
"Label",
choices=(paste("Test",1:5)))
})
output$book6<-renderUI({
textInput("bk6", "Change to",
value=NULL
)
})
rt4<-reactive({
if(is.null(input$bk6)|input$bk6==""){
DF=data.frame(
Test=paste(1:5),
Label=paste("Test",1:5),
stringsAsFactors = FALSE)
}
else{
DF[DF==input$bk3]<-input$bk6
}
DF
})
output$hot3 <-DT::renderDataTable(
rt4(),
rownames= FALSE
)
}
Important changes:
- as you expected, DF is defined once, in the server, see shiny scoping rules
- use <<- to modify the global (server) DF
- use isolate() to react only to the change of input$bk6
library(shiny)
library(DT)
ui <- navbarPage(
"Application",
tabPanel("General",
sidebarLayout(
sidebarPanel(
uiOutput("book3"),
uiOutput("book6")
),
mainPanel(
DT::dataTableOutput("hot3")
)
)))
server <- function(input, output,session) {
DF <- data.frame(
Test=paste(1:5),
Label=paste("Test",1:5),
stringsAsFactors = FALSE)
output$book3<-renderUI({
selectInput("bk3", "Label", choices=(paste("Test",1:5)))
})
output$book6<-renderUI({
textInput("bk6", "Change to", value=NULL)
})
rt4<-reactive({
if(!is.null(input$bk6) && input$bk6!=""){
DF[DF$Label==isolate(input$bk3), "Test"] <<- input$bk6
}
DF
})
output$hot3 <-DT::renderDataTable(
rt4(),
rownames= FALSE
)
}
shinyApp(ui, server)
I have a simple shiny app:
#ui.r
navbarPage(
"Application",
tabPanel("General",
sidebarLayout(
sidebarPanel(
uiOutput("tex2"),
uiOutput("book3"),
uiOutput("book6")
),
mainPanel(
DT::dataTableOutput("hot3")
)
)))
#server.r
library(shiny)
library(DT)
server <- function(input, output,session) {
output$tex2<-renderUI({
numericInput("text2","#tests",
value = 1,
min=1
)
})
output$book3<-renderUI({
selectInput("bk3",
"Label",
choices=(paste("Test",1:input$text2)))
})
output$book6<-renderUI({
textInput("bk6", "Change to",
value=NULL
)
})
rt4<-reactive({
if(is.null(input$bk6)){
DF=data.frame(
Label=paste("Test",1:input$text2),
stringsAsFactors = FALSE)
}
else{
DF=data.frame(
Label=paste("Test",1:input$text2),
stringsAsFactors = FALSE)
DF[DF==input$bk3]<-input$bk6
DF
}
})
output$hot3 <-DT::renderDataTable(
rt4(),
selection=list(mode="single")
)
}
As you can see I add a row every time by the numericInput() "tests". And then I use the selectInput() "Label" to choose one of the tests. When I choose a test then I rename it by the third textInput() "Change to".
The problem is that I want my textInput() to be empty by default as it is. So if this is empty then the "Label" in the datatable should take its name normaly by Label=paste("Test",1:input$text2) and not be empty as it is.
For example when the app is initially loaded the Label in 1st row should be "Test 1" and not null.
The problem occurs because your initialization is NULL however when the input$bk6 is called it is not NULL but an empty character "". You can fix this by doing something like the following with your reactive dataframe. Note the change to is.null(input$bk6)|input$bk6==""
rt4<-reactive({
if(is.null(input$bk6)|input$bk6==""){
DF=data.frame(
Label=paste("Test",1:input$text2),
stringsAsFactors = FALSE)
}
else{
DF=data.frame(
Label=paste("Test",1:input$text2),
stringsAsFactors = FALSE)
DF[DF==input$bk3]<-input$bk6
DF
}
})
However you might want to work on the initialization to fix this. Something like the following might get rid of some of the warnings you get during startup.
#ui.r
navbarPage(
"Application",
tabPanel("General",
sidebarLayout(
sidebarPanel(
uiOutput("tex2"),
uiOutput("book3"),
uiOutput("book6")
),
mainPanel(
DT::dataTableOutput("hot3")
)
)))
#server.r
library(shiny)
library(DT)
server <- function(input, output,session) {
output$tex2<-renderUI({
numericInput("text2","#tests",
value = 1,
min=1
)
})
output$book3<-renderUI({
if(!is.null(input$text2)){
selectInput("bk3",
"Label",
choices=(paste("Test",1:input$text2)))
}})
output$book6<-renderUI({
textInput("bk6", "Change to",
value=""
)
})
rt4<-reactive({
if(!is.null(input$bk6)){
if(input$bk6==""){
DF=data.frame(
Label=paste("Test",1:input$text2),
stringsAsFactors = FALSE)
}
else{
DF=data.frame(
Label=paste("Test",1:input$text2),
stringsAsFactors = FALSE)
DF[DF==input$bk3]<-input$bk6
DF
}
}
})
output$hot3 <-DT::renderDataTable(
rt4(),
selection=list(mode="single")
)
}
I have a simple shiny app:
#ui.r
navbarPage(
"Application",
tabPanel("General",
sidebarLayout(
sidebarPanel(
uiOutput("tex2"),
uiOutput("book3")
),
mainPanel(
DT::dataTableOutput("hot3")
)
)))
#server.r
library(shiny)
library(DT)
server <- function(input, output,session) {
output$tex2<-renderUI({
numericInput("text2","#tests",
value = 1,
min=1
)
})
output$book3<-renderUI({
selectInput("bk3",
"Change Name",
choices=(rt1()[,1]))
})
rt1<-reactive({
data.frame(
Label=paste("Test",1:input$text2),
stringsAsFactors = FALSE)
})
output$hot3 <-DT::renderDataTable(
rt1(),
editable = TRUE
)
}
As you can see I have an editable datatable and I pass its label values to the selectInput() "Change Name". The problem is that when I edit the Labels in the datatable the values in the selectInput() do not change accordingly.
If I correctly understand what you want to do, I think this is not possible with DT.
This is possible with the D3TableFilter package (available on Github only so far). Please run this code and say me if this is indeed what you want to do:
library(shiny)
library(htmlwidgets)
library(D3TableFilter) # devtools::install_github("ThomasSiegmund/D3TableFilter")
ui <- navbarPage(
"Application",
tabPanel("General",
sidebarLayout(
sidebarPanel(
uiOutput("tex2"),
uiOutput("book3")
),
mainPanel(
d3tfOutput("hot3")
)
)
)
)
server <- function(input, output, session) {
output$tex2<-renderUI({
numericInput("text2", "#tests", value = 1, min=1)
})
rt1 <- reactiveVal(
data.frame(
Label = "Test 1",
stringsAsFactors = FALSE)
)
observe({
if(is.null(input$text2)) return(NULL)
rt1(
data.frame(
Label = paste("Test", 1:input$text2),
stringsAsFactors = FALSE)
)
})
output$book3 <- renderUI({
selectInput("bk3", "Change Name", choices=rt1()[,1])
})
output$hot3 <- renderD3tf({
# Define table properties. See http://tablefilter.free.fr/doc.php for a complete reference
tableProps <- list(
btn_reset = TRUE,
col_types = c("string", "string") # alphabetic sorting for the row names column
)
d3tf(rt1(),
tableProps = tableProps,
extensions = list(
list(name = "sort")
),
showRowNames = TRUE,
tableStyle = "table table-bordered",
edit = TRUE)
})
observe({
if(is.null(input$hot3_edit)) return(NULL);
edit <- input$hot3_edit;
isolate({
# need isolate, otherwise this observer would run twice for each edit
row <- as.integer(edit$row);
val <- edit$val;
dat <- rt1()
dat[,"Label"][row] <- val
rt1(dat)
})
})
}
shinyApp(ui, server)
Adapting the answer from Stéphane Laurent using DT gives the below:
library(shiny)
library(DT)
ui <- navbarPage(
"Application",
tabPanel("General",
sidebarLayout(
sidebarPanel(
uiOutput("tex2"),
uiOutput("book3")
),
mainPanel(
DTOutput("hot3")
)
)
)
)
server <- function(input, output, session) {
output$tex2<-renderUI({
numericInput("text2", "#tests", value = 1, min=1)
})
rt1 <- reactiveVal(
data.frame(
Label = "Test 1",
stringsAsFactors = FALSE)
)
observe({
if(is.null(input$text2)) return(NULL)
rt1(
data.frame(
Label = paste("Test", 1:input$text2),
stringsAsFactors = FALSE)
)
})
output$book3 <- renderUI({
selectInput("bk3", "Change Name", choices=rt1()[,1])
})
output$hot3 <- renderDT({
datatable(rt1(), editable = TRUE)
})
observe({
if(is.null(input$hot3_cell_edit)) return(NULL);
edit <- input$hot3_cell_edit;
isolate({
# need isolate, otherwise this observer would run twice for each edit
row <- as.integer(edit$row);
val <- edit$value;
dat <- rt1()
dat[,"Label"][row] <- val
rt1(dat)
})
})
}
shinyApp(ui, server)
I am trying to add a second inputpanel in my shiny application which content depend on the input of the first inputpanel choice, I tried tout use condional panel with no luck.
ui.R
TO <- read.csv("~/TO/TO/TO.csv", sep=";")
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("dasboard"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("country", label = h4("Pays"),
choices = levels(as.factor(TO$Pays))),
conditionalPanel(
condition = "input.country == 'Allemagne'",
selectInput("to", label = h4("Tour opérateur"),
choices = levels(as.factor(as.character(TO[as.character(TO$Pays)=="Allemagne",]$TO))))),
conditionalPanel(
condition = "input.country == 'Angleterre'",
selectInput("to", label = h4("Tour Operator"),
choices = levels(as.factor(as.character(TO[as.character(TO$Pays)=="Angleterre",]$TO)))))
...
The solution that I found is to create a conditionalPanel for every value of the first inputPanel But is the second inputPanel output is only correct for the first value.
Does anyone have a solution?
I know the approach below is not via the conditional panels, as I think it would be simpler to do it via examples given below.
First you can use updateSelectInput to update your entries, something like this
rm(list = ls())
library(shiny)
runApp(list(
ui = bootstrapPage(
selectInput('data', 'Data', c('mtcars', 'iris')),
selectInput('Cols', 'Columns', "")
),
server = function(input, output, session){
outVar <- reactive({
mydata <- get(input$data)
names(mydata)
})
observe({
updateSelectInput(session, "Cols",choices = outVar()
)})
}
))
Other way you can use renderUI to create the selectInput and populate it like so:
rm(list = ls())
library(shiny)
runApp(list(
ui = bootstrapPage(
selectInput('data', 'Data', c('mtcars', 'iris')),
uiOutput('columns')
),
server = function(input, output){
output$columns <- renderUI({
mydata <- get(input$data)
selectInput('columns2', 'Columns', names(mydata))
})
}
))
Edit: how to add multiple widgets inside the renderUI
You need to wrap your divs inside the tagList() like so:
rm(list = ls())
library(shiny)
runApp(list(
ui = bootstrapPage(
selectInput('data', 'Data', c('mtcars', 'iris')),
uiOutput('columns')
),
server = function(input, output){
output$columns <- renderUI({
mydata <- get(input$data)
tagList(
selectInput('columns2', 'Columns', names(mydata)),
selectInput('columns3', 'Columns 2', names(mydata)))
})
}
))