In this code:
library(shiny)
library(shinyMatrix)
if (interactive()) {
# UI
ui <- fluidPage(
selectInput('NumGrig',label = 'Matrix size', choices = c(2:10),selected = 5),
actionButton("add", "Add Martix"),
conditionalPanel(condition = "input.add > 0",
uiOutput("grid"))
)
# Server
server <- function(input, output, session) {
# adding Matrix
observe({
if (!is.null(input$add)) {
m = reactive({matrix('',ncol = input$NumGrig ,nrow = input$NumGrig)})
output$grid <- renderUI({
div(
matrixInput(inputId = "newGrid", value = m()),
actionButton("start", "Convert")
)
})
}
})
}
shinyApp(ui, server)
}
I want to create an editable matrix with prespecified dimension, but I get Error that says:
Error in matrix: non-numeric matrix extent
Why matrixInput is not receiving the input$NumGrig value that was selected in selectInput?
selectInput returns characters : you just have to convert is to numeric with as.numeric.
This works :
library(shiny)
library(shinyMatrix)
if (interactive()) {
# UI
ui <- fluidPage(
selectInput('NumGrig',label = 'Matrix size', choices = c(2:10),selected = 5),
actionButton("add", "Add Matrix"),
conditionalPanel(condition = "input.add > 0",
uiOutput("grid"))
)
# Server
server <- function(input, output, session) {
# adding Matrix
observe({
if (!is.null(input$add)) {
m = reactive({matrix('',ncol = as.numeric(input$NumGrig) ,nrow = as.numeric(input$NumGrig))})
output$grid <- renderUI({
div(
matrixInput(inputId = "newGrid", value = m()),
actionButton("start", "Convert")
)
})
}
})
}
shinyApp(ui, server)
}
Related
I currently have a table being generated and I would like the user to be able to create a pdf file when they click the download button.
I am currently getting an error where when I click the download button I get an html file that downloads the entire page of the app. I thought that using pdf(file) would work but it ignores the function.
Here is currently what I have.
library(shiny)
library(xlsx)
library(shinyWidgets)
population <- read.xlsx("population.xlsx", 1)
fieldsMandatory <- c("selectedCountry")
labelMandatory <- function(label) {
tagList(
label,
span("*", class = "mandatory_star")
)
}
appCSS <-
".mandatory_star {color: red;}"
ui <- fluidPage(
navbarPage(title = span("Spatial Tracking of COVID-19 using Mathematical Models", style = "color:#000000; font-weight:bold; font-size:15pt"),
tabPanel(title = "Model",
sidebarLayout(
sidebarPanel(
shinyjs::useShinyjs(),
shinyjs::inlineCSS(appCSS),
div(
id = "dashboard",
pickerInput(
inputId = "selectedCountry",
labelMandatory ("Country"),
choices = population$Country,
multiple = FALSE,
options = pickerOptions(
actionsBox = TRUE,
title = "Please select a country")
),
sliderInput(inputId = "agg",
label = "Aggregation Factor",
min = 0, max = 50, step = 5, value = 10),
actionButton("go","Run Simulation"),
)
),
mainPanel(
tabsetPanel(
tabPanel("Input Summary", verbatimTextOutput("summary"),
tableOutput("table"),
downloadButton(outputId = "downloadSummary", label = "Save Summary"))
)
)
)
)
)
)
server <- function(input, output, session){
observeEvent(input$resetAll, {
shinyjs::reset("dashboard")
})
values <- reactiveValues()
values$df <- data.frame(Variable = character(), Value = character())
observeEvent(input$go, {
row1 <- data.frame(Variable = "Country", Value = input$selectedCountry)
row2 <- data.frame(Variable = "Aggregation Factor", Value = input$agg)
values$df <- rbind(row1, row2)
})
output$table <- renderTable(values$df)
observe({
# check if all mandatory fields have a value
mandatoryFilled <-
vapply(fieldsMandatory,
function(x) {
!is.null(input[[x]]) && input[[x]] != ""
},
logical(1))
mandatoryFilled <- all(mandatoryFilled)
# enable/disable the submit button
shinyjs::toggleState(id = "go", condition = mandatoryFilled)
})
output$downloadSummary <- downloadHandler(
filename = function(file) {
paste('my-report.pdf', )
},
content = function(file) {
pdf(file)
}
)
}
shinyApp(ui,server)
Here's a minimal example:
library(shiny)
ui <- fluidPage(
downloadButton("savepdf", "Save pdf")
)
server <- function(input, output, session) {
output$savepdf <- downloadHandler(
filename = "test.pdf",
content = function(file) {
pdf(file)
plot(iris$Sepal.Length, iris$Sepal.Width)
dev.off()
}
)
}
shinyApp(ui, server)
Also see here.
Here is a minimal example with the package latexpdf. It will create the pdf table in the folder of the app.
library(shiny)
library(latexpdf)
dat <- head(iris, 5)
ui <- fluidPage(
br(),
actionButton("dwnld", "Create pdf"),
tableOutput("mytable")
)
server <- function(input, output, session){
output[["mytable"]] <- renderTable({
dat
})
observeEvent(input[["dwnld"]], {
as.pdf(dat)
})
}
shinyApp(ui, server)
I would like this app to add whatever number is selected (above zero) in the numeric input to a 1d vector every time that the button is pressed. It should then present that vector as a list of numbers in a box.
library(shiny)
options(shiny.autoreload = TRUE)
ui <- dashboardPage(
dashboardHeader(title = "minrep"),
dashboardSidebar(
numericInput("number",
label = "Enter a number",
value = 0,
min = 1,
max = 100000),
actionButton(
"add.number",
label = "add a number"
),
box(
title = "List of numbers",
span(
textOutput("numbers"),
style = "color:black"
)
)
),
dashboardBody()
)
server <- function(input, output, session) {
list_numbers <- c()
new_number <-
eventReactive(input$add.number, {
input$number
})
observeEvent(input$add.number,{
list_numbers <- append(list_numbers, new_number())
})
output$numbers <- renderText(
list_numbers
)
}
shinyApp(ui, server)
Sure, the trick will be to store our vector as a reactiveValue, so we can access it and change it from wherever we want.
library(shiny)
ui <- fluidPage(
numericInput("number", label = "Enter a number", value = 1, min = 1, max = 100000),
actionButton("add.number", label = "add a number"),
textOutput("numbers")
)
server <- function(input, output, session) {
#Reactive value to store our vector
reactives <- reactiveValues(
list_numbers = c()
)
#Button is pressed
observeEvent(input$add.number, {
reactives$list_numbers <- append(reactives$list_numbers, input$number)
})
#Textbox Output
output$numbers <- renderText(
reactives$list_numbers
)
}
shinyApp(ui, server)
I have a small Shiny app that generates some data whenever the New data button is pressed. The Show plot button shows a hidden plot. I would like the plot to be hidden again automatically whenever the New data button is pressed to make a new data set. A bonus would be for the plot to be hidden also as soon as the slider is changed. I am not looking for a toggle action.
I tried adapting this example that uses conditional panel but I could not successfully figure out how to correctly change the values$show between TRUE and FALSE.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
t <- eventReactive(input$new_data, {
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
p <- eventReactive(input$show_plot, {
plot(cars)
})
output$car_plot <- renderPlot({
p()
})
}
shinyApp(ui = ui, server = server)
You can use a reactive value and a if to control the plot.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
showPlot <- reactiveVal(FALSE)
t <- eventReactive(input$new_data, {
showPlot(FALSE)
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
observeEvent(input$number, {
showPlot(FALSE)
})
observeEvent(input$show_plot, {
showPlot(TRUE)
})
output$car_plot <- renderPlot({
if (showPlot())
plot(cars)
})
}
shinyApp(ui = ui, server = server)
Alternate solution using shinyjs which is handy in these situations.
library(shiny)
library(shinyjs)
ui <- fluidPage( shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
t <- eventReactive(input$new_data, {
hide("car_plot")
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
observeEvent(input$show_plot, {
show("car_plot")
})
output$car_plot <- renderPlot({
plot(cars)
})
}
shinyApp(ui = ui, server = server)
I am trying to create a conditional UI in Shiny that depends on the input of a user. I specifically want to do the if in the UI part and NOT in the server part.
Here is an example of what I aim to accomplish.
# app.R
library(shiny)
ui <- shiny::fluidPage(
shiny::headerPanel(title = "Basic App"),
shiny::sidebarPanel(
shiny::sliderInput(inputId = "a",
label = "Select an input to display",
min = 0, max = 100, value = 50
)
),
if(output$out < 50){
shinyjs::hide(shiny::mainPanel(h1(textOutput("text"))))
}else{
shiny::mainPanel(h1(textOutput("text")))
}
)
server <- function(input, output) {
output$text <- shiny::renderText({
print(input$a)
})
var <- shiny::reactive(input$a)
output$out <- renderText({ var() })
}
shiny::shinyApp(ui = ui, server = server)
Is there a way that I can use the reactive value in the UI part of the function?
I think conditionalPanel could be a good solution for what you want to do
library(shiny)
ui <- shiny::fluidPage(
shiny::headerPanel(title = "Basic App"),
shiny::sidebarPanel(
shiny::sliderInput(inputId = "a",
label = "Select an input to display",
min = 0, max = 100, value = 50
)
),
shiny::mainPanel(
conditionalPanel(
condition = "input.a > 50",
h1(textOutput("text")))
)
)
server <- function(input, output) {
output$text <- shiny::renderText({
print(input$a)
})
}
shiny::shinyApp(ui = ui, server = 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)