I wanted to embed a pdf file to Shinydashboard and it displays as expected when there is only one tab or I just use shiny without using dashboard. When I have two tabs, the PDF will display as a skinny bar (see the screenshot) under the second tab though I could click the button on the screen to adjust its size. Can someone help figure out what goes wrong? This only happens in Chrome but works fine in Edge or IE. Thanks in advance!
Sample code:
dashboardPage(
dashboardHeader(title = "Test"),
ui<-dashboardSidebar(
sidebarMenu(
menuItem("Model", tabName = "model"),
menuItem("Instruction", tabName = "inst"),
id = "tabm"
)
),
dashboardBody(
tabItems(
tabItem(tabName = "model",
h2("first tab content"),
tags$iframe(style="height:650px; width:100%; scrolling=yes",
src="shinyTexManual.pdf")
),
tabItem(
tabName = "inst",
fluidPage(
sliderInput("slider", "Slider", 1, 100, 50),
tags$iframe(style="height:650px; width:100%; scrolling=yes",
src="shinyTexManual.pdf")
)
)
)
)
)
server <- function(input, output) { }
Related
I have a shiny app with popovers that contain useful information on interpretation of plot output. However, i have to close the popover "manually" everytime. Otherwise the popover of tab "dash1" will stay even if i switch to tab "dash2".
library(shiny)
library(bs4Dash)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard",
titleWidth = 550,
disable= FALSE,
sidebarIcon = NULL
),
dashboardSidebar(
sidebarMenu(
menuItem("dash1", tabName= "dashboard1"),
menuItem("dash2", tabName= "dashboard2")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard1",
box(
title = "Interpretation",
popover(
actionButton("goButton", "Click here"),
title = "Important information",
placement = "right",
content = "popover text bla bla"
)
)
),
tabItem(tabName = "dashboard2",
box(
title = "Interpretation",
popover(
actionButton("goButton2", "Click here"),
title = "Important information",
placement = "right",
content = "popover text bla bla"
)
)
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
How can i prevent this "behavior"? Do i necessarily have to specify addPopover and removePopover within the server part?
I solved the problem with the help of this issue:
Display Text only on hover
What i need is a tooltip rather than a popover.
In essence, I would like to replace the icon in each menuItem() in a shinydashboard with an image. More specifically, I just need each menuItem() to have an image then text next to it.
Here's some moderately successful attempts I have tried (commented in code below);
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard MenuItems"),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem(
"Dashboard",
tabName = "dashboard",
## creates a drop down w/ no image
# label = img(src = "logo.png",
# title = "logo", height = "35pt")
## creates a drop down with the images
# `tag$` isn't needed
# tags$img(src = "logo.png",
# title = "logo", height = "35pt")
),
menuItem(
"Not Dashboard",
tabname = "not_dashboard"
)
) # end sidebarMenu
), # end dashboardSidebar
dashboardBody(
fluidRow(
box(
title = "stuff goes here",
width = 12
)
)
) # end dashboardBody
)
server <- function(input, output, session) {
message("You can do it!")
}
shinyApp(ui, server)
I successfully used action buttons with background images to simulate the behavior, but I would prefer to find a solution using menuItem()s, if possible.
I was hoping there would be a similar method to add the image to the background of the menuItem() or concatenate the image with the text within the menuItem().
I am not good with shiny tags. I don't really know much about HTML/CSS/JS or Bootstrap, most of the time I can find a solution here and hack my way to what I want, but this one has eluded me.
Any ideas?
You can keep your images in the www folder and use a div to wrap the image along with the text as shown below.
ui <- dashboardPage(
dashboardHeader(title = "Dashboard MenuItems"),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem( div(tags$img(src = "YBS.png", width="20px"), "Dashboard2"),
tabName = "dashboard" # , icon=icon("b_icon")
),
menuItem(
div(tags$img(src = "mouse.png", width="35px"),"Not Dashboard"),
tabname = "not_dashboard" #, icon=icon("home")
)
) # end sidebarMenu
), # end dashboardSidebar
dashboardBody(
fluidRow(
box(
title = "stuff goes here",
width = 12
)
)
) # end dashboardBody
)
server <- function(input, output, session) {
message("You can do it!")
}
shinyApp(ui, server)
My goal is to create a dashboard that has in one of the tabs a table based on date inputs from the user. I want this to be specifically in the tab called Overview in the dashboard.
I have 3 r scripts, one called data cleaning thats basically a table loaded into a data frame called trans. The other 2 are called ui and server. They are the following:
ui.R
library(shiny)
library(shinydashboard)
library(data.table)#For fread.
library(tidyverse)
library(DT)#For the interactive table.
# Header -----------------------------------------------------------------------|
header<-dashboardHeader( title = "Marketing Dashboard"
)
# Sidebar ----------------------------------------------------------------------|
sidebar<-dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabname ="overview", icon = icon("dashboard")),
menuItem("Weather", tabname ="weather", icon = icon("bolt"))
)
)
# Body -------------------------------------------------------------------------|
body<-dashboardBody(
tabItems(
tabItem(tabName = 'Overview',
fluidRow(
dateRangeInput("date",
label = 'Date range input',
start = Sys.Date() - 7, end = Sys.Date()
),
dataTableOutput("overviewtable")
)
),
tabItem(tabName = 'weather',
fluidRow(
)
)
)
)
# UI ---------------------------------------------------------------------------|
ui = dashboardPage(
header,
sidebar,
body
)
shinyApp(ui,server)
server.R
server <- function(input,output){
#Reactive for dates in overview
overviewdata<- reactive({
trans %>% filter(ymd_hms(start_time) >= input$date[1] & ymd_hms(end_time)<= inpute$date[2])
})
#Table for overview
output$overviewtable<- renderDataTable(
datatable({
overviewdata
})
)
}
My problem is when I run the app I see only a blank dashboard with two tabs. One for Overview and one for Weather. I don't see any table or any place where it gives me the option to input the dates. This is my first time working with shiny and I am trying to learn on the go. It is also my first time working with multiple r scripts.
I have looked at other examples online from r gallery and from stack overflow but I am not sure what I am doing wrong.
You should place the dateRangeInput inside the menuItem if you want to see it inside the tab. Here's what it would look like under the "Overview" tab.
library(shiny)
library(shinydashboard)
library(data.table)#For fread.
library(tidyverse)
library(DT)#For the interactive table.
# Header -----------------------------------------------------------------------|
header<-dashboardHeader( title = "Marketing Dashboard"
)
# Sidebar ----------------------------------------------------------------------|
sidebar<-dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabname ="overview", icon = icon("dashboard"),
dateRangeInput("date",
label = 'Date range input',
start = Sys.Date() - 7, end = Sys.Date()
)),
menuItem("Weather", tabname ="weather", icon = icon("bolt"))
)
)
# Body -------------------------------------------------------------------------|
body<-dashboardBody(
tabItems(
tabItem(tabName = 'Overview',
fluidRow(
dataTableOutput("overviewtable")
)
),
tabItem(tabName = 'weather',
fluidRow(
)
)
)
)
# UI ---------------------------------------------------------------------------|
ui = dashboardPage(
header,
sidebar,
body
)
shinyApp(ui,server)
I would like to open a second dashboard by pressing the action button on the first dashboard. I was able to do that using the code below but the dashboards are connected to each other. E.g. if I close the sidebar on the second dashboard, the sidebar of the first one closes, too.
This is the server.R file:
function(input, output, session) {
# some more code
# react to clicking on button show2
observeEvent(input$show2, {
# here is some more code
showModal(settngsModal())
})
settngsModal <- function() {
modalDialog(
withTags({
dashboardPage(
dashboardHeader(
title = "Second Dashboard"
),
dashboardSidebar(
sidebarMenu(
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)),
dashboardBody(
tabItem(tabName = "widgets",
h1("Widgets tab content")
)
)
)
}),
title = "Settings",
fade = TRUE)
}
}
This is the ui.R file:
dashboardPage(
dashboardHeader(
title = "First dashboard"
),
dashboardSidebar(collapsed = TRUE,sidebarMenu()),
dashboardBody(),
h1('Headline'),
actionButton("show2", "Show second dashboard", size = 'lg')
)
)
Is it possible to have an "independent" dashboard?
Maybe even having two dashboards that can be used side by side (because now the second dashboard is a popup and the first dashboard can only be used if the second one is closed)?
You could use shinyjs to toggle between the two dashBoardPage tags.
Below is an example of switching between two Dashboards, there's a decent issue thread around rendering UI dashboardPage elements reactively.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- tagList(
useShinyjs(),
div(id = "dashboard_two",
style = "display:none",
dashboardPage(
dashboardHeader(
title = "Second dashboard"
),
dashboardSidebar(collapsed = TRUE,sidebarMenu()),
dashboardBody(fluidRow(actionButton("show1", "Show first dashboard")),
fluidRow(box(title = "Dash Two", height = 300, "Testing Render")) )
)
),
div(id = "dashboard_one",
style = "display:none",
dashboardPage(
dashboardHeader(
title = "First dashboard"
),
dashboardSidebar(collapsed = TRUE, sidebarMenu()),
dashboardBody(actionButton("show2", "Show second dashboard")
)
)
)
)
server <- function(input, output) {
shinyjs::show("dashboard_one")
observeEvent({ input$show1; input$show2}, {
shinyjs::toggle("dashboard_one")
shinyjs::toggle("dashboard_two")
})
}
shinyApp(ui, server)
There is a wrong display in shiny dashboard for the below code. The title "Yet to do" is getting displayed as soon as i run the app. I need that when I click on Bivariate Analysis. What is the issue here. This happened when I introduced selectinput under menu item. Earlier it was working well
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Data Analysis"),
dashboardSidebar(
sidebarMenu(
menuItem("Univariate Analysis", tabName = "Univariate", icon =
icon("question"),selectInput("Factors",h5("Factors"),choices =
c("","A","B"))),
menuItem("Bivariate Analysis", tabName = "Bivariate", icon =
icon("question")))
),
dashboardBody(
tabItems(
tabItem(tabName = "Univariate",fluidRow(box(plotOutput("Plot1"),width =
1000,height = 1000),
box(plotOutput("Plot2"),width =
1000,height = 1000))),
tabItem(tabName = "Bivariate",h1("Yet to do")))
))
server <- function(input, output) {
}
shinyApp(ui, server)
It is related having selectInput() as menuItem(). I tried some options like creating menuSubItem etc. but couldn't get it to work. This is probably some bug so you may have to look around for a fix. For now, I'd suggest moving the selectInput inside dashboardBody() -
ui <- dashboardPage(
dashboardHeader(title = "Data Analysis"),
dashboardSidebar(
sidebarMenu(
menuItem("Univariate Analysis",
tabName = "Univariate", icon = icon("question")
# removing selectInput from here fixes the issue
# ,selectInput("Factors", h5("Factors"), choices = c("","A","B"))
),
# an option is to have selectInput by itself but probably not the layout you want
# selectInput("Factors", h5("Factors"), choices = c("","A","B")),
menuItem("Bivariate Analysis",
tabName = "Bivariate", icon = icon("question")
)
)
),
dashboardBody(
tabItems(
tabItem(tabName = "Univariate",
fluidRow(
# add selectInput somewhere on Univariate page
selectInput("Factors", h5("Factors"), choices = c("","A","B")),
box(plotOutput("Plot1"), width = "50%", height = "50%"),
box(plotOutput("Plot2"), width = "50%", height = "50%")
)
),
tabItem(tabName = "Bivariate",
h1("Yet to do")
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)