Spinner loading before action button is pressed - r

Below is the sample application where I have put spinner loading. But the issue is , even before the action button is pressed, the spinner is been seen. Actually, only when action button is pressed, it should come. I know this can be achieved by adding eventReactive, but is there a way to achieve this only by using observeEvent
library(shiny)
library(dplyr)
library(shinycssloaders)
library(DT)
ui <- fluidPage(
actionButton("plot","plot"),
withSpinner(dataTableOutput("Test"),color="black")
)
server <- function(input, output, session) {
observeEvent(input$plot, {
output$Test <- DT::renderDT(DT::datatable(head(iris),
rownames = FALSE, options = list(dom = 't',
ordering=FALSE)))
})
}
shinyApp(ui = ui, server = server)

One solution is to use uiOutput so that the ui for the spinner and the table are created only when you click on the button:
library(shiny)
library(dplyr)
library(shinycssloaders)
library(DT)
ui <- fluidPage(
actionButton("plot","plot"),
uiOutput("spinner")
)
server <- function(input, output, session) {
observeEvent(input$plot, {
output$spinner <- renderUI({
withSpinner(dataTableOutput("Test"), color="black")
})
output$Test <- DT::renderDT({
Sys.sleep(3)
DT::datatable(head(iris),
rownames = FALSE, options = list(dom = 't', ordering=FALSE))
})
})
}
shinyApp(ui = ui, server = server)

Related

Another datatable inside the main datatable

IS there a way to get datatable when the user clicks on the row. Basically when the user clicks on any row, the last 4 columns of that specific row should be displayed in a modal (in datatable format)
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("mydatatable")
)
server <- function(input, output, session) {
mycars = head(mtcars)
output$mydatatable = DT::renderDataTable(mycars, selection = 'single',
rownames = FALSE, options = list(dom = 't'))
observeEvent(input$mydatatable_rows_selected,
{
showModal(modalDialog(
title = "You have selected a row!",
mycars[input$mydatatable_rows_selected,]
))
})
}
shinyApp(ui, server)
You can use renderDataTable inside modalDialog.
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput("mydatatable")
)
server <- function(input, output, session) {
mycars = head(mtcars)
output$mydatatable = DT::renderDataTable(mycars, selection = 'single',
rownames = FALSE, options = list(dom = 't'))
observeEvent(input$mydatatable_rows_selected,
{
showModal(modalDialog(
title = "You have selected a row!",
DT::renderDataTable({
DT::datatable(mycars[input$mydatatable_rows_selected, (ncol(mycars) - 3):ncol(mycars)])
})
))
})
}
shinyApp(ui, server)

In R shiny, How to create action button to transpose matrix if the view want to switch it?

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)

R Shiny observeEvent continues to trigger

I'm struggling to get an observeEvent process to run only once after it's triggering event - a button click. This illustrates:
require(shiny)
ui = fluidPage(
textInput("input_value", '1. input a value. 2. click button. 3. input another value', ''),
actionButton("execute", 'execute'),
textOutput('report')
)
server = function(input, output, session) {
observeEvent(input$execute, {
output$report = renderText(input$input_value)
})
}
shinyApp(ui = ui, server = server, options = list(launch.browser = T))
You'll see that after the button has been clicked once, the textOutput becomes responsive to textInput changes rather than button clicks.
I've tried this approach:
server = function(input, output, session) {
o = observeEvent(input$execute, {
output$report = renderText(input$input_value)
o$destroy
})
}
No effect. I've also tried employing the isolate function with no luck. Grateful for suggestions.
You probably had your isolate() call wrapped around renderText() instead of input$input_value. This should do it for you:
require(shiny)
ui = fluidPage(
textInput("input_value", '1. input a value. 2. click button. 3. input another value', ''),
actionButton("execute", 'execute'),
textOutput('report')
)
server = function(input, output, session) {
observeEvent(input$execute, {
output$report = renderText(isolate(input$input_value))
})
}
shinyApp(ui = ui, server = server, options = list(launch.browser = T))
Alliteratively you can bring the reactive values into an isolated scope of observeEvent() as below:
library(shiny)
ui = fluidPage(
textInput("input_value", '1. input a value. 2. click button. 3. input another value', ''),
actionButton("execute", 'execute'),
textOutput('report')
)
server = function(input, output, session) {
observeEvent(input$execute, {
# bringing reactive values into an isolated scope
inp_val <- input$input_value
output$report <- renderText(inp_val)
})
}
shinyApp(ui = ui, server = server, options = list(launch.browser = T))

Adjust the position of actionButton widget in R shiny DT table

The given R shiny script creates a simple data table as in the snapshot with an actionButton in the center. I want to place the button a little below it's current position such that it is in perfect horizontal inline position to the search bar. Thanks and please help.
library(DT)
library(shiny)
library(shinyBS)
library(rpivotTable)
library(bupaR)
ui <- basicPage(
h2("The mtcars data"),
column(5,offset = 5,actionButton("CR1_S1", "Button")),
dataTableOutput("mytable1")
)
server <- function(input, output) {
output$mytable1 <- DT::renderDataTable({
DT::datatable(iris)
})
}
shinyApp(ui, server)
You can put the button inside the datatable in this way:
ui <- basicPage(
h2("The mtcars data"),
actionButton("CR1_S1", "Button"),
DTOutput("mytable1")
)
server <- function(input, output) {
output$mytable1 <- renderDT({
datatable(iris, callback = JS("$('div.button').append($('#CR1_S1'));"),
options = list(
dom = '<"row"<"col-sm-4"l><"col-sm-4 text-center"<"button">><"col-sm-4"f>>tip'
))
})
}
shinyApp(ui, server)

Reset ratingInput in shiny app

I want to use a rating Input in conjunction with the shinyjs::reset()function. Everthing works fine except the reset functionality. Any hints?
Here is my minimal example:
library(shiny)
devtools::install_github("stefanwilhelm/ShinyRatingInput")
library(ShinyRatingInput)
library(shinyjs)
ui <- shinyUI(bootstrapPage(
useShinyjs(),
ratingInput("movieRating", label="Rate this movie...", dataStop=5),
htmlOutput("movieRatingout"),
actionButton("resetbtn", "reset")
))
#the corresponding server.R
server <- shinyServer(function(input, output, session) {
output$movieRatingout <- renderText({
paste("The movie was rated ",input$movieRating)
})
observeEvent(input$resetbtn, {
reset("movieRating")
})
})
shinyApp(ui, server)
You can create reset action manualy
1) Add js to reset icons ( set width of foreground ==0)
jsCode <-"shinyjs.reset_1 = function(params){$('.rating-symbol-foreground').css('width', params);}"
2) add this js to app using extendShinyjs
3) add session$sendInputMessage to reset input ( set value == NULL)
Working example
jsCode <-"shinyjs.reset_1 = function(params){$('.rating-symbol-foreground').css('width', params);}"
ui <- shinyUI(bootstrapPage(
useShinyjs(),
extendShinyjs(text = jsCode),
ratingInput("movieRating", label="Rate this movie...", dataStop=5),
htmlOutput("movieRatingout"),
actionButton("resetbtn", "reset")
))
#the corresponding server.R
server <- shinyServer(function(input, output, session) {
output$movieRatingout <- renderText({
paste("The movie was rated ",input$movieRating)
})
observeEvent(input$resetbtn, {
session$sendInputMessage("movieRating", list(value = NULL))
js$reset_1(0)
})
})

Resources