When working with datatables everything is clear - I can choose 5, 10, 25, 50 or 100 entries.
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
dataTableOutput('table')
)
)
),
server = function(input, output) {
output$table <- DT::renderDataTable(iris)
}
)
Unfortunately, in rhandsontable I can not find proper solution. My only result looks that:
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
rHandsontableOutput('table')
)
)
),
server = function(input, output) {
output$table <- renderRHandsontable(
rhandsontable(iris, width = 550, height = 300)
)
}
)
How can I enforce rhandsontable to give me selectinput with number of entries?
You can pass min/max rows/columns to the function: https://github.com/handsontable/handsontable/issues/225
library(shiny)
library(rhandsontable)
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
sliderInput('input', label = "Rows",
min = 1, max = nrow(iris), value = 10)
),
column(12,
rHandsontableOutput('table')
)
)
),
server = function(input, output) {
output$table <- renderRHandsontable(
rhandsontable(iris, width = 550, height = 300, maxRows = input$input)
)
}
)
Related
In my App I would like to have 3 fileInput object per row. How should I modify the code ? currently even if I define the column width It just put one fileInput in each row :
library(shiny)
library(shinythemes)
library(shinydashboard)
library(shinyWidgets)
ui <- fluidPage(
theme = shinytheme("lumen"),
shinyWidgets::useShinydashboard(),
navbarPage("test theme",
tabPanel("tab1",
mainPanel(width = 12,
fluidRow(
box(width = 12,
title = "title", status = "primary", solidHeader = TRUE,
numericInput("num","Number of file input",value = 2),
column(width = 3,
uiOutput("fIn"))
)
)
)
)
)
)
server <- function(input, output, session) {
output$fIn <- renderUI({
ind = as.numeric(input$num)
lapply(1:ind, function(k) {
fileInput(paste0("fIn", k), paste('File:', k), accept=c("xlsx","text"))
})
})
}
shinyApp(ui, server)
Instead of wrapping the uiOutput in column wrap each single fileInput in a column:
library(shinyWidgets)
library(shiny)
library(shinydashboard)
ui <- fluidPage(
shinyWidgets::useShinydashboard(),
navbarPage(
"test theme",
tabPanel(
"tab1",
mainPanel(
width = 12,
fluidRow(
box(
width = 12,
title = "title", status = "primary", solidHeader = TRUE,
numericInput("num", "Number of file input", value = 2),
uiOutput("fIn")
)
)
)
)
)
)
server <- function(input, output, session) {
output$fIn <- renderUI({
ind <- as.numeric(input$num)
lapply(1:ind, function(k) {
column(
4,
fileInput(paste0("fIn", k), paste("File:", k), accept = c("xlsx", "text"))
)
})
})
}
shinyApp(ui, server)
I'm trying to use reactive selectizeInput by first time in shiny modules, but It's not working. I read the documentation of modules and reactive inputs, but I don't know how to work with it together. I made a simplify code to show my doubt. This is the code without modules, It's working well:
library(shiny)
library(shinydashboard)
library(highcharter)
a<- c(1,2,3,4,5)
b<- c(0.5,1,2,6,8)
dt <- seq(as.Date("2018-01-01"), as.Date("2018-01-05"), by = "days")
ts <- xts(a, dt )
names(ts)="a"
ts$b <- xts(b, dt )
ui<-dashboardPage(title= "Dashboard", skin= "green",
dashboardHeader(title="PROYECTO"),
dashboardSidebar(
sidebarMenu(id="sidebarID",
menuItem("OVERVIEW",tabName = "datos"
)
)
),
dashboardBody(
tabItems(tabItem(tabName = "datos",
fluidRow(
column(width = 6,
selectizeInput("select",
"Choose",
c("a"="1",
"b"="2")
)),
box(width=6, column( width=12,
column(width=12,highchartOutput("y"))
),
height = 400))
)
)))
server <- function(input, output,session) {
y_react<-reactive(
highchart(type="stock") %>%
hc_add_series(ts[,as.numeric(input$select)],
type = "line",
color="red")
)
output$y <-renderHighchart(y_react())
}
shinyApp(ui, server)
Now, I was trying to adapt it into modules. I created a module:
a<- c(1,2,3,4,5)
b<- c(0.5,1,2,6,8)
dt <- seq(as.Date("2018-01-01"), as.Date("2018-01-05"), by = "days")
ts <- xts(a, dt )
names(ts)="a"
ts$b <- xts(b, dt )
yUI<-function(id) {tagList(highchartOutput(NS(id,"y")))
}
yServer<-function(id){
moduleServer(id, function(input, output, session) {
y_react<-reactive(
highchart(type="stock") %>%
hc_add_series(ts[,as.numeric(input$select)],
type = "line",
color="red")
)
output$y <-renderHighchart(y_react())
})}
And shiny dashboard:
a<- c(1,2,3,4,5)
b<- c(0.5,1,2,6,8)
dt <- seq(as.Date("2018-01-01"), as.Date("2018-01-05"), by = "days")
ts <- xts(a, dt )
names(ts)="a"
ts$b <- xts(b, dt )
yUI<-function(id) {tagList(highchartOutput(NS(id,"y")))
}
yServer<-function(id){
moduleServer(id, function(input, output, session) {
y_react<-reactive(
highchart(type="stock") %>%
hc_add_series(ts[,as.numeric(input$select)],
type = "line",
color="red")
)
output$y <-renderHighchart(y_react())
})}
But It's not working.
The issue is that in the module server you are using input$select which however is created outside of the module. Doing so the server will look for a select in the module namespace. However, as there is no input with ID select in the module namespace you get an error.
To fix that you could pass the input$select to the module server as an argument:
``` r
library(shiny)
library(shinydashboard)
library(highcharter)
library(xts)
yUI <- function(id) {
tagList(
highchartOutput(NS(id, "y"))
)
}
yServer <- function(id, choice) {
moduleServer(id, function(input, output, session) {
y_react <- reactive(
highchart(type = "stock") %>%
hc_add_series(ts[, choice],
type = "line",
color = "red"
)
)
output$y <- renderHighchart(y_react())
})
}
ui <- dashboardPage(
title = "Dashboard", skin = "green",
dashboardHeader(title = "PROYECTO"),
dashboardSidebar(
sidebarMenu(
id = "sidebarID",
menuItem("OVERVIEW", tabName = "datos")
)
),
dashboardBody(
tabItems(tabItem(
tabName = "datos",
fluidRow(
column(
width = 6,
selectizeInput(
"select",
"Choose",
c(
"a" = "1",
"b" = "2"
)
)
),
box(
width = 6, column(
width = 12,
column(width = 12, yUI("y"))
),
height = 400
)
)
))
)
)
server <- function(input, output, session) {
yServer("y", as.numeric(input$select))
}
shinyApp(ui, server)
#>
#> Listening on http://127.0.0.1:3301
A second option and probably more in the spirt of what modules are meant for would be to include the selectizeInput in the module. Doing so the input with inputID select becomes part of the module namespace and can be accessed from within the module server using input$select. As you want to place the UI elements in different parts of your dashboard I decided for two module UI "functions" which adds the flexibility to place the UI elements individually:
yUI_plot <- function(id) {
tagList(
highchartOutput(NS(id, "y"))
)
}
yUI_select <- function(id) {
selectizeInput(
NS(id, "select"),
"Choose",
c(
"a" = "1",
"b" = "2"
)
)
}
yServer <- function(id) {
moduleServer(id, function(input, output, session) {
y_react <- reactive(
highchart(type = "stock") %>%
hc_add_series(ts[, as.numeric(input$select)],
type = "line",
color = "red"
)
)
output$y <- renderHighchart(y_react())
})
}
ui <- dashboardPage(
title = "Dashboard", skin = "green",
dashboardHeader(title = "PROYECTO"),
dashboardSidebar(
sidebarMenu(
id = "sidebarID",
menuItem("OVERVIEW", tabName = "datos")
)
),
dashboardBody(
tabItems(tabItem(
tabName = "datos",
fluidRow(
column(
width = 6,
yUI_select("y")
),
box(
width = 6, column(
width = 12,
column(width = 12, yUI_plot("y"))
),
height = 400
)
)
))
)
)
server <- function(input, output, session) {
yServer("y")
}
shinyApp(ui, server)
#>
#> Listening on http://127.0.0.1:7210
I am trying to build a shiny app where the user can decide how many tabs he wants to be shown. Here's what I have so far:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(glue)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sliderInput(inputId = "slider", label = NULL, min = 1, max = 5, value = 3, step = 1)
),
dashboardBody(
fluidRow(
box(width = 12,
p(
mainPanel(width = 12,
column(6,
uiOutput("reference")
),
column(6,
uiOutput("comparison")
)
)
)
)
)
)
)
server <- function(input, output) {
output$reference <- renderUI({
tabsetPanel(
tabPanel(
"Reference",
h3("Reference Content"))
)
})
output$comparison <- renderUI({
req(input$slider)
tabsetPanel(
lapply(1:input$slider, function(i) {
tabPanel(title = glue("Tab {i}"),
value = h3(glue("Content {i}"))
)
})
)
})
}
shinyApp(ui = ui, server = server)
This does not produce the desired results, as the comparison tabs are not shown properly.
I have already checked out these 2 threads:
R Shiny - add tabPanel to tabsetPanel dynamically (with the use of renderUI)
R Shiny dynamic tab number and input generation
but they don't seem to solve my problem. Yes, they create tabs dynamically with a slider, but they don't allow to fill these with content as far as I can tell.
What works for me is a combination for lapply and do.call
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(glue)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sliderInput(inputId = "slider", label = NULL, min = 1, max = 5, value = 3, step = 1)
),
dashboardBody(
fluidRow(
box(width = 12,
p(
mainPanel(width = 12,
column(6,
uiOutput("reference")
),
column(6,
uiOutput("comparison")
)
)
)
)
)
)
)
server <- function(input, output) {
output$reference <- renderUI({
tabsetPanel(
tabPanel(
"Reference",
h3("Reference Content"))
)
})
output$comparison <- renderUI({
req(input$slider)
myTabs = lapply(1:input$slider, function(i) {
tabPanel(title = glue("Tab {i}"),
h3(glue("Content {i}"))
)
})
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui = ui, server = server)
I have a shiny application where I want to build a conditional query system on a data frame.
First, I want to have a selectInput showing all available tables. After the user has chosen a table, I want another box to appear where he can select the column name he wants to filter for. This is what I have until now:
ui.r:
library(shiny)
library(shinydashboard)
source("global_variables.r")
ui=dashboardPage(
dashboardHeader(title="Test"),
dashboardSidebar(
sidebarMenu(
menuItem("Conditionals",tabName = "conditionals")
)
),
dashboardBody(
tabItems(
tabItem(tabName="conditionals",
fluidRow(
box(
title = "Conditionals",
width = 4,
selectInput("Con_tableName",choices=c("NONE",tableNames),label = "Table Name"),
tags$div(id = 'placeholder')
)
)
)
)
)
)
server.r:
library(shiny)
source("global_variables.r", local = FALSE)
Table1=data.frame();
shinyServer(
function(input, output,session) {
observe({
reactive(
if(input$Con_tableName!="NONE"){
insertUI( selector="#placeholder",
ui={
selectInput("Con_colName",choices=c("NONE",colnames(dynGet(input$Con_tableName))),label = "Column Name")
}
)
}
)
})
}
)
global_variables.r:
tableNames=c("Table1","Table2","Table3")
The problem is, that if I choose a value in the selectInput, observe doesnt get fired.
EDIT:
According to BigDataScientists comment,changed insertUI to renderUI. Updated files:
ui.r:
library(shiny)
library(shinydashboard)
source("global_variables.r")
ui=dashboardPage(
dashboardHeader(title="Test"),
dashboardSidebar(
sidebarMenu(
menuItem("Conditionals",tabName = "conditionals")
)
),
dashboardBody(
tabItems(
tabItem(tabName="conditionals",
fluidRow(
box(
title = "Conditionals",
width = 4,
selectInput("Con_tableName",choices=c("NONE",tableNames),label = "Table Name"),
uiOutput("conditionalUI")
)
)
)
)
)
)
server.r:
library(shiny)
source("global_variables.r", local = FALSE)
Table1=data.frame();
shinyServer(
function(input, output,session) {
observeEvent(input$Con_tableName,{
reactive(
if(input$Con_tableName!="NONE"){
output$conditionalUI=renderUI({
selectInput("Con_colName",choices=c("NONE",colnames(input$Con_tableName)),label = "Column Name")
})
}
)
})
}
)
You can use conditionalPanel(). Below there is a small example which might work in your case.
library(shiny)
shinyApp(
ui <- fluidPage(
mainPanel(
selectInput("input1", "Select something", choices = c('','1','2','3')),
conditionalPanel("input.input1!=''",
selectInput('input2', "Select something else", choices = c('4','5')))
)
),
server <- function(input, output){}
)
I'm trying to access an input field in mainPanel from the sidebarPanel, but I couldn't succeed.
Code:
shinyUI(pageWithSidebar{
sidebarPanel(
sliderInput("x", "X", min = 10, max = 100, value = 50)
),
mainPanel(
#this is where I wanna use the input from the sliderInput
#I tried input.x, input$x, paste(input.x)
)
})
Where seems to be the problem? Or isn't possible to use the input from the sidebarPanel in the mainPanel?
You can only use the inputs in the server side.
For example :
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("test"),
sidebarPanel(
sliderInput("x", "X", min = 10, max = 100, value = 50)
),
mainPanel(
verbatimTextOutput("value")
)
),
server = function(input, output, session) {
output$value <- renderPrint({
input$x
})
}
))
EDIT ::
Dynamically set the dimensions of the plot.
Use renderUi to render a plot output using the values of your inputs.
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("Test"),
sidebarPanel(
sliderInput("width", "Plot Width (%)", min = 0, max = 100, value = 100),
sliderInput("height", "Plot Height (px)", min = 0, max = 400, value = 400)
),
mainPanel(
uiOutput("ui")
)
),
server = function(input, output, session) {
output$ui <- renderUI({
plotOutput("plot", width = paste0(input$width, "%"), height = paste0(input$height, "px"))
})
output$plot <- renderPlot({
plot(1:10)
})
}
))