I've got a table that will initialize, but will not update. I use a few inputs, which then get called by a function to calculate the outputs. They will initialize with the correct values, but when I click the actionButton, nothing happens.
output$view<-renderTable({
tabSvol<-isolate(
data.frame(
S=c(
func1(input$in1),
func2(input$in2),
func3(input$in1,input$2)
)
)
)
tabSvol
})
Here's a MRE that allows you to add rows to a reactive table.
library(shiny)
library(tidyverse)
ui <- fluidPage(
numericInput("a", "A: ", value=NA),
selectInput("b", "B:", choices=c("X", "Y", "Z")),
actionButton("add", "Add row"),
tableOutput("table")
)
server <- function(input, output) {
rv <- reactiveValues(table=tibble(A=numeric(0), B=character(0)))
output$table <- renderTable({
rv$table
})
observeEvent(input$add, {
rv$table <- rv$table %>% add_row(A=input$a, B=input$b)
})
}
shinyApp(ui = ui, server = server)
Related
I want to update output data on update button every time.
Here is my code which show the output on update button for the first time I run the code but in runtime if the input is changed, the output is updated automatically.
library(shiny)
ui <- fluidPage(
titlePanel("My Shop App"),
sidebarLayout(
sidebarPanel(
helpText("Controls for my app"),
selectInput("item",
label = "Choose an item",
choices = list("Keyboard",
"Mouse",
"USB",
sliderInput("price",
label = "Set Price:",
min=0, max = 100, value=10),
actionButton ("update","Update Price")
),
mainPanel(
helpText("Selected Item:"),
verbatimTextOutput("item"),
helpText("Price"),
verbatimTextOutput("price")
)
)
)
server <- function(input, output) {
SelectInput <- eventReactive (input$update , {
output$item = renderText(input$item)
output$price = renderText(input$price)
})
output$item <- renderText(SelectInput())
output$price <- renderText(SelectInput())
}
shinyApp(ui = ui, server = server)
Either create a dependency and put them into the reactive and return it:
server <- function(input, output) {
SelectInput <- eventReactive(input$update,{
list(item = input$item, price = input$price)
})
output$item <- renderText(SelectInput()$item)
output$price <- renderText(SelectInput()$price)
}
Or you can isolate, but then you have to add the button reaction to each listener
server <- function(input, output) {
output$item <- renderText({
req(input$update)
input$update
isolate(input$item)
})
output$price <- renderText({
req(input$update)
input$update
isolate(input$price)
})
}
I'd like to have an actionButton that cycles its class between "btn-success", "btn-warning", "btn-danger" based on the button click. Unfortunately I can't seem to figure out how to get that value into the class argument of the actionButton.
library(shiny)
v <- reactiveValues(btn_status = "btn-secondary")
ui <- fluidPage(
# Application title
titlePanel("Change Button Color on click"),
# Create an action button that cycles through 3 bootstrap colors and can be reset
mainPanel(
actionButton("run","L", class = isolate(v$btn_status)),
actionButton("reset", "Clear"),
textOutput("status"),
)
)
server <- function(input, output) {
observeEvent(input$run, {
v$btn_status <- "btn-success"
})
observeEvent(input$reset, {
v$btn_status <- "NULL"
})
output$status <- renderText({
v$btn_status
})
}
shinyApp(ui = ui, server = server)
It's not entirely clear to me what you're trying to do (see my comment above); but I think you're after something like this:
library(shiny)
valid_status <- c("btn-success", "btn-warning", "btn-danger")
ui <- fluidPage(
titlePanel("Change Button Color on click"),
mainPanel(
uiOutput("statusButton"),
actionButton("reset", "Clear"),
textOutput("status"),
)
)
server <- function(input, output, session) {
v <- reactiveValues(button_idx = 1)
get_button_idx <- reactive(v$button_idx)
output$statusButton <- renderUI({
idx <- get_button_idx()
actionButton("run", "L", class = valid_status[idx])
})
observeEvent(input$run, {
v$button_idx <- ifelse(v$button_idx < 3, v$button_idx + 1, 1)
})
observeEvent(input$reset, {
v$button_idx <- 1
})
output$status <- renderText({
valid_status[v$button_idx]
})
}
shinyApp(ui = ui, server = server)
producing
The key is to use a reactive value within renderUI to update the class of the actionButton. To align the buttons you could use fluidRow if necessary.
I created a matrix, and I want to input an action button to enable the user to control the view.
please use this dataset and here is the error message as after clicking "transpose" button nothing happens:
Here is the code
library(shiny)
library(DT)
ui <- basicPage(
h2("India cities"),
DT::dataTableOutput("mytable"),
actionButton("go", "Transpose"),
dataTableOutput("mytabletranspose")
)
server <- function(input, output,session)
{output$mytable = DT::renderDataTable({
indiacities
})
observeEvent(input$go, {
})
output$mytabletranspose<-renderDataTable({
t(mytable)
})
}
Unsure what is the expected output. One option is to have the transposed table show up when the button is clicked in a new data table. This is relatively straight forward.
If you want the transposed table to appear as a new data table,
library(shiny)
library(DT)
ui <- basicPage(
h2("India cities"),
DT::dataTableOutput("mytable"),
actionButton("go", "Transpose"),
dataTableOutput("mytabletranspose")
)
server <- function(input, output,session){
indiacities <- data.frame(city = c("Mumbai","Bangalore"),population = c(18,8.4),area_code = c("+91-22","+91-080"))
output$mytable <- DT::renderDataTable({
indiacities
})
output$mytabletranspose <- DT::renderDataTable({
req(input$go)
t(indiacities)
})
}
shinyApp(ui = ui,server = server)
If you want to transpose the same table we will need to edit the original table indiacities. Because observer and reactive execute functions in their own environment we need to use the global assignment operator <<-
library(shiny)
library(DT)
ui <- basicPage(
h2("India cities"),
DT::dataTableOutput("mytable"),
actionButton("go", "Transpose"),
)
server <- function(input, output,session){
indiacities <- data.frame(city = c("Mumbai","Bangalore"),population = c(18,8.4),area_code = c("+91-22","+91-080"))
data <- reactive({
if(length(input$go) == 0){
#Executed when the app is initializes
return(indiacities)
}else{
indiacities <<- t(indiacities)
}
})
output$mytable <- DT::renderDataTable({
req(data())
data()
})
}
shinyApp(ui = ui,server = server)
Small question here: I know I can access selected rows by input$dfname_rows_selected it gives back the numbers of rows selected, but how do I read the rows names, not numbers? In my case they are generated not in the order I use them later, therefore I need to get the values inside to make it work.
edit: added example
ui <- shinyUI(fluidPage(
DT::dataTableOutput("table"),
actionButton("btn", "press me")
))
server <- function(input, output) {
observeEvent(input$btn, {
print(input$table_rows_selected)
})
output$table <- DT::renderDataTable({
mtcars %>%
datatable(selection = "multiple")
})
}
shinyApp(ui = ui, server = server)
Something like this:
library(shiny)
library(DT)
ui <- basicPage(
mainPanel(DT::dataTableOutput('mytable')),
textOutput("selected")
)
server <- function(input, output,session) {
mydata <- reactive({mtcars})
output$mytable = DT::renderDataTable(
datatable(mydata())
)
selectedRow <- eventReactive(input$mytable_rows_selected,{
row.names(mtcars)[c(input$mytable_rows_selected)]
})
output$selected <- renderText({
selectedRow()
})
}
runApp(list(ui = ui, server = server))
I don't think you can. What you could do is write a reactive, where all modifications to your dataframe take place, before creating the datatable. An example:
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
DT::dataTableOutput("table"),
textOutput("selectedcar")
)
)
server <- function(input, output,session) {
# the reactive where we filter/sort/modify the data
reactive_df <- reactive({
mtcars[order(mtcars$cyl),]
})
# This datatable uses the reactive directly, so no more modifications
output$table <- DT::renderDataTable({
DT::datatable(reactive_df())
})
# now we can get the row/rowname as follows:
output$selectedcar <- renderText({
paste0(rownames(reactive_df())[input$table_rows_selected], collapse = ", ")
})
}
shinyApp(ui, server)
Hope this helps!
I have a shiny app that a user can check whether they want the data table displayed in the main panel. Depending on the numericinput, if they select 1, only 1 datatable be displayed or if they select 2 it will display 2 datatables I am not so sure how to code this in shiny R since I am new to this. Thank you for looking into this.
Here is my code
library("shiny")
df1 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df1<-rbind(df1,setNames(as.list(c(10,20,30,40)), names(df2)))
df2 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df2<-rbind(df2,setNames(as.list(c(100,200,300,400)), names(df2)))
df3 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df3<-rbind(df3,setNames(as.list(c(1000,2000,3000,4000)), names(df2)))
ui <-fluidPage(
sidebarPanel(
checkboxInput("add_data", "Add Data Table(s)"),
conditionalPanel(condition="input.add_data === true",
numericInput("numofdata",
label="Number of Data Table(s):",
min = 1,
max = 3,
value = 1,
step = 1),
uiOutput("num_of_data"),
textOutput("see_ranges")
),
actionButton("submit", "Submit")
),
mainPanel(
titlePanel("Output Data Table"),
DT::dataTableOutput("datatable.view", width = "95%")
) # end of main panel
)
server <- function(input, output, session) {
output$num_of_data <- renderUI({
lapply(1:input$numofdata, function(i) {
print(trend_list())
})
})
output$see_ranges <- renderPrint({
print(trend_list())
})
data.filter <- reactive({
df(i)
})
output$datatable.view <- DT::renderDataTable(
{
input$submit
if (input$submit==0) return()
isolate({
for(i in 1:input$numoftrends) {
datatable(data.filter(i),
rownames=FALSE,
extensions = c("FixedColumns", "FixedHeader", "Scroller"),
options = list(searching=FALSE,
autoWidth=TRUE,
rownames=FALSE,
scroller=TRUE,
scrollX=TRUE,
pagelength=1,
fixedHeader=TRUE,
class='cell-border stripe',
fixedColumns =
list(leftColumns=2,heightMatch='none')
)
)
}
})
})
}
shinyApp(ui = ui, server = server)
You should look at this article:
http://shiny.rstudio.com/gallery/creating-a-ui-from-a-loop.html
You will seen then that one has to create multiple renderDataTable instead of muliple datatable within one renderDataTable().
Also in your code you call df like a function df() but it is only defined as a variable.
See a generic running example below.
EDIT: Changed dynamic part of UI.
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("amountTable", "Amount Tables", 1:10, 3)
),
mainPanel(
# UI output
uiOutput("dt")
)
)
)
server <- function(input, output, session) {
observe({
lapply(1:input$amountTable, function(amtTable) {
output[[paste0('T', amtTable)]] <- DT::renderDataTable({
iris[1:amtTable, ]
})
})
})
output$dt <- renderUI({
tagList(lapply(1:input$amountTable, function(i) {
dataTableOutput(paste0('T', i))
}))
})
}
shinyApp(ui, server)