I set up 2 actionButton in my shiny app to insert user input into database and delete one record from DB.
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Phase1",
column(4,uiOutput("Phase1", inline = FALSE),
wellPanel(
actionButton("P1_Add", "Add",icon=icon("plus-circle")),
actionButton("P1_Del", "Del",icon=icon("minus-circle"))
)),
column(6,h1("Phase1 Input data is put here"),dataTableOutput("Phase1_Data"))
),
tabPanel("Phase2",uiOutput("Phase2",inline=FALSE)),
tabPanel("Phase3")
)
)
and i also defined a observe in server.R to response my click. but seems not working
obs_p1_add<-observe({
if(input$P1_Add)
{
cat("just click add button")
cat("test")
print (input$P1_Add)
output$Phase2<- renderUI({
list(h4("ha! change"))
})
}
})
any one can teach me where went wrong? thanks so much!
Your code works for me!
ui.R:
library(shiny)
shinyUI(fluidPage(
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Phase1",
column(4,uiOutput("Phase1", inline = FALSE),
wellPanel(
actionButton("P1_Add", "Add",icon=icon("plus-circle")),
actionButton("P1_Del", "Del",icon=icon("minus-circle"))
)),
column(6,h1("Phase1 Input data is put here"),dataTableOutput("Phase1_Data"))
),
tabPanel("Phase2",uiOutput("Phase2",inline=FALSE)),
tabPanel("Phase3")
)
)
))
server.R:
library(shiny)
shinyServer(function(input, output) {
obs_p1_add<-observe({
if(input$P1_Add)
{
cat("just click add button")
cat("test")
print (input$P1_Add)
output$Phase2<- renderUI({
list(h4("ha! change"))
})
}
})
})
Text renders in second tab after click:
Related
Below I press the first actionButton() "Show" to display another actionButton() but I would like also a second actionButton() named "Hide" that will hide the actionButton() that is displayed after clicking the "Show".
library(shiny)
ui = shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("button1", label = "Show"),
actionButton("button1b", label = "Hide")
),
mainPanel(
# what should I write here?
uiOutput("button2")
)
)
))
server = shinyServer(function(input, output, session) {
observeEvent(input$button1, {
output$button2 <- renderUI({
actionButton("button2", label = "Press Button 2")
})
})
})
shinyApp(ui = ui, server = server)
One option is to put the second button inside a conditionalPanel and set a toggle to display/hide the panel. See working code below.
library(shiny)
ui = shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("button1", label = "Show"),
actionButton("button1b", label = "Hide")
),
mainPanel(
# what should I write here?
conditionalPanel(condition = "output.display",
actionButton("button2", label = "Press Button 2"))
)
)
))
server = shinyServer(function(input, output, session) {
r <- reactiveValues(
toggle = NULL
)
observeEvent(input$button1, {
r$toggle = 1
})
observeEvent(input$button1b, {
r$toggle = 0
})
output$display <- reactive({
r$toggle
})
outputOptions(output, "display", suspendWhenHidden = FALSE)
})
shinyApp(ui = ui, server = server)
Another option is to dynamically insert and remove UI elements. But that option requires creation/destruction of UI elements every time the buttons are clicked. See example here
i need to give flexibility to app user so that they can edit/modify a table . I am using the below codes
UI code:
tabItem(tabName = "manual_override",
fluidRow(
editableDTUI("table1")
Server Codes:
callModule(editableDT,"table1",data=reactive(bigtable),inputwidth=reactive(100))
but the problem is that bigtable has more than 15 columns to display and the horizontal scroll is not appearing
I have tried the same with library(DT) with 20 col.
If that solves your problem.
ui.r
library(shiny)
library(DT)
shinyUI(
fluidPage(
navbarPage("Big file upload + Horizental Scrolling",
tabPanel("Data Import",
fluidRow(
fileInput("file","Upload Your CSV",multiple = FALSE),
column(6,
div(style = 'overflow-x: scroll', DT::dataTableOutput('csv_data')))
)
)
)
)
)
server.r
library(shiny)
shinyServer(function(input, output) {
csv_data_fun<-eventReactive(input$file,{
df<-read.csv(input$file$datapath,
header =TRUE)
return(df)
})
output$csv_data<-DT::renderDataTable({
DT::datatable(csv_data_fun(),rownames = FALSE)%>%formatStyle(columns=colnames(csv_data_fun()),background = 'white',color='black')
})
})
output Screen
Please check whether you want this
I have done with editDT, But this time with default mtcars dataset.
Added the code in UI part
div(style = 'overflow-x: scroll',editableDTUI("table1"))
New Code
library(shiny)
library(editData)
if (interactive()) {
ui <- fluidPage(
textInput("mydata","Enter data name",value="mtcars"),
column(6,
div(style = 'overflow-x: scroll',editableDTUI("table1")
)
)
)
server <- function(input, output) {
df=callModule(editableDT,"table1",dataname=reactive(input$mydata),inputwidth=reactive(170))
output$test=renderPrint({
str(df())
})
}
shinyApp(ui, server)
}
Please check this time if this solves your problem. You can tweak the things to change according to your requirements.
Please accept the answer if solves your issue.
I have a Shiny App that takes a text input and shows it on the main panel (I used this answer to build it):
ui.r:
library(shiny)
shinyUI(fluidPage(
titlePanel("This is a test"),
sidebarLayout(
sidebarPanel(
textInput("text1", "Enter the text", ""),
actionButton("goButton", "Go")
),
mainPanel(
h3(textOutput("text1", container = span))
)
)
)
)
server.r:
shinyServer(function(input, output) {
cap <- eventReactive(input$goButton, {
input$text1
})
output$text1 <- renderText({
cap()
})
})
It worked great until I decided to add a Tabset panel, and show the input on one of the tabs. I modified mainPanel() in ui.r as:
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("t1"),
tabPanel("t2",
tabPanel("t3"), h3(textOutput("text1", container = span)),
)
)
After this change, I am getting an error when launching an app:
ERROR: cannot coerce type 'closure' to vector of type 'character'
Is there something I am missing?
You have to put the content within the tab within the call to tabPanel. Ex:
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel("t1"),
tabPanel("t2"),
tabPanel("t3", h3(textOutput("text1", container = span)))
)
)
Thus, server.R is unchanged from you question, and ui.R becomes:
library(shiny)
shinyUI(
fluidPage(
titlePanel("This is a test"),
sidebarLayout(
sidebarPanel(
textInput("text1", "Enter the text", ""),
actionButton("goButton", "Go")
),
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel("t1"),
tabPanel("t2"),
tabPanel("t3", h3(textOutput("text1", container = span)))
)
)
)
)
)
An example code:
ui.R
library(shiny)
shinyUI(
fluidRow(column(2, actionButton("add", "ADD details")),
fluidRow(uiOutput("ui"))
)
)
server.R
shinyServer(function(input, output,session){
observeEvent(
input$add,
output$ui <- renderUI({
isolate({
fluidRow(column(4, textInput("birthweight", label = "birth weight:", value = '')),
column(3, numericInput("height",label = "Height:",value='')),
column(2, actionButton("addnew", "ADD details to database"))
)
})
})
)
})
When the user enters the input to birthweight an error message should be displayed near the textInput box if it contains character data, similarly for numericInput Height. This must be displayed as soon as the user enters the data or when the user clicks the add details to database action button, but should be displayed as an error message near the textbox not in a pop up window.
Can this be done in R shiny?
The validate function is one options. Another options is use an extra UI to show a error message only if the textInput has a no-numeric value. In this case you can add you own CCS to the error message. Here is an example based on your code.
library(shiny)
ui <-shinyUI(
fluidRow(
column(2,
actionButton("add", "ADD details")),
fluidRow( uiOutput("ui"))
)
)
server <- shinyServer(function(input, output,session){
observeEvent( input$add,
output$ui <- renderUI({
isolate({
fluidRow(
column(4,
textInput("birthweight", label = "birth weight:", value = ''),
uiOutput("checkBirthweight")),
column(3,
numericInput("height",label = "Height:",value='')),
column(2,
actionButton("addnew", "ADD details to database"))
)
})
})
)
output$checkBirthweight <- renderUI({
if (nchar(input$birthweight) > 0 && is.na(as.numeric(input$birthweight)))
p("Error: birth weight must be numeric")
})
})
shinyApp(ui, server)
By the way, it is good idea to put your code as code in your questions, it will helps to others to identify the problem. You can find extra help about that at https://stackoverflow.com/editing-help
Also, I know that everybody has its own code style and I respect that, but I found these guidelines for coding in R very useful https://google.github.io/styleguide/Rguide.xml
In my R shiny application, I would like to have one button to submit one set of inputs (which affect one portion of the output) and another one to submit the remaining inputs (which affect a different portion of the output). The code in the widgets example of the Shiny tutorial uses a submitButton but it seems like all the inputs are delivered when that single button is pressed? Thanks in advance for your help.
Here is an example showing actionButtons controlling reactive components:
library(shiny)
runApp(list(
ui = fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
tags$form(
numericInput('n', 'Number of obs', 100)
, br()
, actionButton("button1", "Action 1")
)
, tags$form(
textInput("text", "enter some text", value= "some text")
, br()
, actionButton("button2", "Action 2")
)
),
mainPanel(
plotOutput('plot')
, textOutput("stext")
)
)
),
server = function(input, output) {
output$plot <- renderPlot({
input$button1
hist(runif(isolate(input$n)))
})
output$stext <- renderText({
input$button2
isolate(input$text )
})
}
)
)