how to render a box in shiny according to the data.
data is uploaded by user and it can have more data than this, so i have to create
a box dynamically.
i am running the below code and i am getting four box created in console not in shiny webpage.
please have a look, thankyou.
CODE
list_data <- list(c("AB","CD","EF","GH")) #data
ui <- dashboardPage(
dashboardHeader(title = "Text Mining"),
dashboardSidebar(
sidebarMenu(
menuItem("NLP Tree", tabName = "NLP")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "NLP",
fluidRow(
tabBox(width = 12,height="500",
tabPanel("Sentences",
uiOutput("nlp_sentences_tree")
)
)
)
)
)
)
)
server <- function(input, output) {
output$nlp_sentences_tree <- renderUI({
for(i in list_data[[1]]){
print(box(width = 8,
i
)
)
}
})
}
shinyApp(ui = ui, server = server)
Have a look here, I've added a button to each just so something is in there
library(shinydashboard)
library(shiny)
list_data <- list(c("AB","CD","EF","GH")) #data
ui <- dashboardPage(
dashboardHeader(title = "Text Mining"),
dashboardSidebar(
sidebarMenu(
menuItem("NLP Tree", tabName = "NLP")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "NLP",
fluidRow(
tabBox(width = 12,height="500",
tabPanel("Sentences",
uiOutput("nlp_sentences_tree")
)
)
)
)
)
)
)
server <- function(input, output) {
v <- list()
for (i in 1:length(list_data[[1]])){
v[[i]] <- box(width = 8, list_data[[1]][i],actionButton(i,i))
}
output$nlp_sentences_tree <- renderUI(v)
}
shinyApp(ui = ui, server = server)
Or with an lapply and tagList:
server <- function(input, output) {
output$nlp_sentences_tree <- renderUI({
a <- lapply(list_data[[1]], function(x) {
box(width = 8, x)
})
tagList(a)
})
}
Related
library(shiny)
library(tidyverse)
library(leaflet)
library(shinydashboard)
library(RColorBrewer)
library(viridis)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")
),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
# Boxes need to be put in a row (or column)
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
),
# Second tab content
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
The above example, the output renders when the tabs dashboard and widgets are clicked seperately. In the dashboard tab, i have my slider input in the body.
Now when I change my slider to have it at the sidebar:
library(shiny)
library(tidyverse)
library(leaflet)
library(shinydashboard)
library(RColorBrewer)
library(viridis)
library(shinyWidgets)
ui = dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
id = "sidebarmenu",
menuItem("menuItem1",
tabName = "tab1",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
,
menuItem("menuItem2", tabName = "tab2")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "tab1",
tableOutput("myTable"),
),
tabItem(tabName = "tab2",
h2("Placeholder Cloud"),
plotOutput("myPlot"))
)
)
)
server <- function(input, output, session) {
tableData = reactiveVal(data.frame(x = 1:10, y = LETTERS[1:10]))
plotData = reactiveVal()
observeEvent(input$sidebarmenu, {
if(input$sidebarmenu == "tab2"){
#Code for tab 2
req(is.null(plotData()))
print("Tab 2 code is run")
plotData(runif(100))
}
})
output$myTable = renderTable({
tableData()
})
set.seed(122)
histdata <- rnorm(500)
output$myPlot = renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
Problem here:
1) The text placeholder cloud, initially only rendered when the tab menuItem2 is clicked, now gets rendered together with the histogram which was supposed to render only when i clicked menuItem1
2) clicking on menuItem2 does not do anything. I would like to have tab2 when clicked, show a scatterplot as seen in this below block of code.
i.e., i would like to "integrate the below 3rd block of code" into the 2nd, the above so when i run the second block of code, when i click tab1, the input for the slider appears and renders the histogram. when i click tab2, the scatterplot will be rendered
library(shiny)
library(tidyverse)
library(leaflet)
library(shinydashboard)
library(RColorBrewer)
library(viridis)
library(shinyWidgets)
ui = dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
id = "sidebarmenu",
menuItem("menuItem1",
tabName = "tab1")
,
menuItem("menuItem2", tabName = "tab2")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "tab1",
tableOutput("myTable")),
tabItem(tabName = "tab2",
h2("Placeholder Cloud"),
plotOutput("myPlot"))
)
)
)
server <- function(input, output, session) {
tableData = reactiveVal(data.frame(x = 1:10, y = LETTERS[1:10]))
plotData = reactiveVal()
observeEvent(input$sidebarmenu, {
if(input$sidebarmenu == "tab2"){
#Code for tab 2
req(is.null(plotData()))
print("Tab 2 code is run")
plotData(runif(100))
}
})
output$myTable = renderTable({
tableData()
})
output$myPlot = renderPlot({
plot(plotData())
})
}
shinyApp(ui, server)
Any help is appreciated.I am new to Shiny.
for your 2nd part you said "clicking on menuItem2 does not do anything."... but you don't have any action for menuItem2 see
menuItem("menuItem2", tabName = "tab2")
I am trying to build a r shiny app where the user will get to know about each function in just a click. For this I have coded below in R . But print(??input$A) is not working. Could anyone help please
library(shinydashboard)
library(readxl)
out <- data.frame(baseFns = ls('package:base'))
ui <- dashboardPage(
dashboardHeader(title = "Loading data"),
dashboardSidebar(sidebarMenu(
menuItem("Analysis", tabName = "Analysis", icon = icon("chart-bar"))
)),
dashboardBody(
tabItems(tabItem(tabName = "Analysis",
fluidRow(box(selectInput("A","A",choices = c(levels(factor(out$baseFns))),width = "150px"),width = 2),
fluidRow(box(htmlOutput("Text"),width = 9)))
)
))
)
server <- function(input,output){
output$Text <- renderText({
print(??input$A)
})
}
shinyApp(ui, server)
Here is a way:
library(shiny)
library(shinydashboard)
library(gbRd) # for Rd_fun
library(tools) # for Rd2HTML
out <- data.frame(baseFns = ls('package:base'))
ui <- dashboardPage(
dashboardHeader(title = "Loading data"),
dashboardSidebar(sidebarMenu(
menuItem("Analysis", tabName = "Analysis", icon = icon("chart-bar"))
)),
dashboardBody(
tabItems(
tabItem(
tabName = "Analysis",
fluidRow(
box(selectInput("A", "Topic", choices = levels(factor(out$baseFns)),
width = "150px"),
width = 2),
fluidRow(box(htmlOutput("helpfun"), width = 9))
)
)
))
)
server <- function(input, output, session){
output$helpfun <- renderUI({
Rd <- Rd_fun(help(input$A))
outfile <- tempfile(fileext = ".html")
Rd2HTML(Rd, outfile, package = "",
stages = c("install", "render"))
includeHTML(outfile)
})
}
shinyApp(ui, server)
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 created the main dashboard already in R using the shinydashboard package. However, my main question is how do I upload an Excel Csv file (which contains all the data) into the dashboard? I have been trying to figure this out and I am having trouble. So far, I have the following script:
install.packages("shinydashboard")
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Analysis Project"),
dashboardSidebar(
menuItem("Dashboard", tabName = "dashboard"),
menuItem("Filter Page"),
menuItem("Data")
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard")
)
)
)
server <- function(input,output) { }
shinyApp(ui, server)
How about doing it this way?
library(shiny)
library(readxl)
ui <- fluidPage(
fileInput('file1', 'Insert File', accept = c(".xlsx")),
textInput('file1sheet','Name of Sheet (Case-Sensitive)'),
tableOutput("value")
)
server <- function(input, output) {
sheets_name <- reactive({
if (!is.null(input$file1)) {
return(excel_sheets(path = input$file1$datapath))
} else {
return(NULL)
}
})
output$value <- renderTable({
if (!is.null(input$file1) &&
(input$file1sheet %in% sheets_name())) {
return(read_excel(input$file1$datapath,
sheet = input$file1sheet))
} else {
return(NULL)
}
})
}
shinyApp(ui, server)
Try to make a code like that !
library(shiny)
library(shinydashboard)
header <- dashboardHeader(
title = "Analysis Project"
)
sidebar <- dashboardSidebar(
menuItem(text = "Importing file", tabName = "dashboard",icon = icon("file"),
menuSubItem(text = "Importing file", tabName = "dataset")
),
menuItem("Dashboard", tabName = "dashboard"),
menuItem("Filter Page"),
menuItem("Data")
)
body <- dashboardBody(
fluidPage(
tabItems(
tabItem(tabName = "dataset",
fluidRow(
box(width = 12,
fileInput(inputId = "file",
label = "Choose a file",
accept = c(".xlsx",".csv")
),
tableOutput(outputId = "Contents"),
verbatimTextOutput(outputId = "Data")
)
)
)
)
)
)
ui <- dashboardPage(header = header,
sidebar = sidebar,
body = body)
server <- function(input, output, session) {
output$Data <- renderPrint({
if(is.null(input$file)){
print("Import Excel data file")
} else {
inFile <- input$file
df <- read_excel(inFile$datapath)
print(df)
}
})
}
shinyApp(ui = ui, server = server)
Below is the code I have written. I am not able to use formattable in my shiny. formattable helps in formatting the tables and improves the visualization also.
library("shinydashboard")
library("shiny")
library("formattable")
body <- dashboardBody(
fluidRow(
column(width = 12,
box(tableOutput(formattable(test.table, list())))
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Column layout"),
dashboardSidebar(),
body
)
server <- function(input, output) {
test.table <- data.frame(lapply(1:8, function(x) {1:10}))
output$table <- renderTable({test.table})
}
shinyApp(ui = ui, server = server)
you have to use renderFormattable, formattableOutput and formattable, all three for it to work
library("shinydashboard")
library("shiny")
library("formattable")
body <- dashboardBody(
fluidRow(
column(width = 12,
box(formattableOutput("table"))
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Column layout"),
dashboardSidebar(),
body
)
server <- function(input, output) {
test.table <- data.frame(lapply(1:8, function(x) {1:10}))
output$table <- renderFormattable({formattable(test.table, list())})
}
shinyApp(ui = ui, server = server)