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)
Related
I am using the actionButton() to move from the 1st tabItem() to the 2nd but while it seems to work I remain on the first tabItem().
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
),
dashboardSidebar(
collapsed = TRUE,
sidebarMenu(
id="inTabset",
menuItem("Workspace", tabName = "workspace", icon = icon("upload")),
menuItemOutput("tab2")
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "workspace",
fluidRow(
textInput("name", "", value = "Process model", placeholder = NULL),
actionButton("nextt","Next", icon("paper-plane")
)
)
)
),
tabItem(
tabName = "Process model",
)
)
)
server <- function(input, output,session) {
output$tab2 <- renderMenu({
menuItem(text = input$name, tabName = "Process model", icon = icon("diagram-project"))
})
observeEvent(input$nextt, {
updateTabItems(session, "inTabset", selected = "Process model")
})
output$tabtitle <- renderText({
if (input$name == "") {
"Process model"
} else {
paste(input$name)
}
})
observeEvent(input$nextt, {
updateTabItems(session, "inTabset", selected = "Process model")
})
}
shinyApp(ui, server)
While the name of the tab may have spaces, its value should not. This should now work i.e. Process_model:
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
),
dashboardSidebar(
collapsed = TRUE,
sidebarMenu(
id="inTabset",
menuItem("Workspace", tabName = "workspace", icon = icon("upload")),
menuItemOutput("tab2")
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "workspace",
fluidRow(
textInput("name", "", value = "Process model", placeholder = NULL),
actionButton("nextt","Next", icon("paper-plane")
)
)
)
,
tabItem(
tabName = "Process_model",
))
)
)
server <- function(input, output,session) {
output$tab2 <- renderMenu({
menuItem(text = input$name, tabName = "Process_model", icon = icon("diagram-project"))
})
observeEvent(input$nextt, {
updateTabItems(session, "inTabset", selected = "Process_model")
})
output$tabtitle <- renderText({
if (input$name == "") {
"Process model"
} else {
paste(input$name)
}
})
observeEvent(input$nextt, {
updateTabItems(session, "inTabset", selected = "Process_model")
})
}
shinyApp(ui, server)
Hello im relatively new to R Programming and Shiny.
I´m currently developing an shiny dashboard application.
I´m stuck a the moment with the problem of how to have multiple tabItems in one module.
In the real app I need to pass a lot more information's between the modules and the submenu's aren't alike. So is there a way to make this work?
Thanks so much for your help!
library(shiny)
library(shinydashboard)
library(shinydasboardPlus)
#submodules
submodule_ui <- function(id,tabName){
ns <- NS(id)
tabItem(
tabName = tabName,
boxPlus(
title = "some title",
textOutput(ns("some_output"))
)
)
}
submodule_server <- function(id,see){
moduleServer(
id,
function(input, output, session){
output$some_output <- renderText({
see
})
}
)
}
#module
module_ui <- function(id,tabName1,tabName2){
ns <- NS(id)
submodule_ui(ns("sub1"),
tabName = tabName1)
submodule_ui(ns("sub2"),
tabName = tabName2)
}
module_server <- function(id){
moduleServer(
id,
function(input, output, session){
submodule_server("sub1","hello")
submodule_server("sub2","world !")
}
)
}
#app
ui <- dashboardPagePlus(
header = dashboardHeaderPlus(
title = "dummy app"
),
sidebar = dashboardSidebar(
sidebarMenu(
menuItem(
text = "home",
tabName = "home"
),
menuItem(
text = "submodule1",
tabName = "subtab1"
),
menuItem(
text = "submodule2",
tabName = "subtab2"
),
menuItem(
text = "some other tabItems",
tabName = "some_other_tabItems"
)
)
),
body = dashboardBody(
tabItems(
tabItem(
tabName = "home",
box(
title = "home of the app",
width = "auto"
)
),
module_ui(
id = "module",
tabName1 = "subtab1",
tabName2 = "subtab2"
),
tabItem(
tabName = "some_other_tabItems",
box(
title = "some other content"
)
)
)
)
)
server <- function(input, output){
module_server("module")
}
shinyApp(ui,server)
´´´
It appears there was some issues with getting the tab item wrapper around the submodules - it was only producing the second submodule. Modules act like functions as they tend to produce the final call. You can wrap things in a list or taglist to return more items. In the meantime...
By moving the tabItems wrapper into the module, it was able to create the list properly and produce both tabs.
Note: I converted the functions to shinydashboard as I could figure out where the xxxPlus functions came from.
library(shiny)
library(shinydashboard)
#submodules
submodule_ui <- function(id,tabName){
ns <- NS(id)
tabItem(
tabName = tabName,
box(
title = "some title",
textOutput(ns("some_output"))
)
)
}
submodule_server <- function(id,see){
moduleServer(
id,
function(input, output, session){
output$some_output <- renderText({
see
})
}
)
}
#module
module_ui <- function(id,tabName1,tabName2){
ns <- NS(id)
### tabsItems now produced in module, submodules separated by comma
tabItems(
submodule_ui(ns("sub1"),
tabName = tabName1),
submodule_ui(ns("sub2"),
tabName = tabName2)
)
}
module_server <- function(id){
moduleServer(
id,
function(input, output, session){
submodule_server("sub1","hello")
submodule_server("sub2","world !")
}
)
}
#app
ui <- dashboardPage(
header = dashboardHeader(
title = "dummy app"
),
sidebar = dashboardSidebar(
sidebarMenu(
menuItem(
text = "submodule1",
tabName = "subtab1"
),
menuItem(
text = "submodule2",
tabName = "subtab2"
)
)
),
body = dashboardBody(
module_ui(
id = "module",
tabName1 = "subtab1",
tabName2 = "subtab2"
)
)
)
server <- function(input, output){
module_server("module")
}
shinyApp(ui,server)
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)
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)
})
}