Given below the code i used for displying selectizeInput and absolutePanel. selectizeInput is not getting merged with the page background. it is displaying above the absolutePanel. please help me to fix.
ui.r
library(shinydashboard)
shinyUI(
fluidPage(
dashboardPage(skin = c("blue"),
dashboardHeader(title = "R Tools"
),
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
box(
title = "Tools", status = "primary", solidHeader = TRUE,
collapsible = TRUE,width = 4,
uiOutput("showtxttruevalue"),
uiOutput("showddllalternate")
),
absolutePanel(
bottom = 20, right = 60,top=200, width = "auto",
draggable = TRUE,
wellPanel(
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
aa")
), style = "opacity: 0.9"
)
)
))
server.r
library(shiny)
library(ggplot2)
library(googleVis)
shinyServer(function(input, output, session) {
output$showtxttruevalue <- renderUI({
numericInput(inputId="txttruevalue", label="TrueValue", value = 0)
})
output$showddllalternate <- renderUI({
selectizeInput("ddllalternate", "Alternate:",c('unequal','less','greater'), selected='<>')
})
})
To fix it, use the 'left' parameter while positioning the absolutePanel(). Use the following to position it.
absolutePanel(
left = 500, bottom = 20, right = 60,top=200, width = "auto",
draggable = TRUE,
wellPanel(
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
aa")
), style = "opacity: 0.9"
Related
I have the shinydashboard below in which I have 3 tabPanels. In the 1st tabPanel "Resource Allocation" I want the left and right sidebar open by default. In the 2nd and 3rd tabpanels ("Time Series","Longitudinal View") I want only left sidebar and the right sidebar not just hidden but to not be able to open at all by pushing the "gears" icon above it which should be removed. And in the fourth panel "User Guide" I want no sidebar and no choise to open one of them at all.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
shinyApp(
ui = dashboardPage(
options = list(sidebarExpandOnHover = TRUE),
header = dashboardHeader(
titleWidth = "0px"
),
sidebar = dashboardSidebar(minified = TRUE, collapsed = F),
body = dashboardBody(
useShinyjs(),#tags$head(tags$script(src="format_number.js")),
tags$script("document.getElementsByClassName('sidebar-toggle')[0].style.visibility = 'hidden';"),
tabsetPanel(
tabPanel("Resource Allocation"),
tabPanel("Time Series"),
tabPanel("Longitudinal View"),
tabPanel("User Guide")
)
),
controlbar = dashboardControlbar(collapsed = F),
title = "DashboardPage"
),
server = function(input, output) { }
)
I have a solution for the left sidebar. I am sure you can spend sometime and figure out the solution for the right sidebar. Please note that this requires some more work to fine tune to your needs. Try this
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(DT)
ui <- shinydashboardPlus::dashboardPage(
options = list(sidebarExpandOnHover = TRUE),
shinydashboardPlus::dashboardHeader(
#titleWidth = "0px"
),
shinydashboardPlus::dashboardSidebar( disable = TRUE ,
sidebarMenu(
selectInput(
"countries", label = "Select Countries",
choices = c("B", "C", "A"), selected = "A",
multiple = TRUE
))
),# minified = TRUE, collapsed = F),
controlbar = shinydashboardPlus::dashboardControlbar(id = "controlbar", collapsed = F,
skin = "dark",
controlbarMenu(
id = "menu",
controlbarItem(
"Tab 1",
"Welcome to tab 1"
),
controlbarItem(
"Tab 2",
"Welcome to tab 2"
)
)
),
shinydashboard::dashboardBody(
useShinyjs(),
tabsetPanel( id="tabset",
tabPanel("Resource Allocation", value="tab1", plotOutput("plot")),
tabPanel("Time Series", value="tab2", plotOutput("plot2")),
tabPanel("Longitudinal View", value="tab3", DTOutput("ir")),
tabPanel("User Guide", value="tab4", DTOutput("mt"))
)
),
# controlbar = dashboardControlbar(collapsed = F),
title = "DashboardPage"
)
server <- function(input, output) {
output$plot <- renderPlot(plot(cars))
output$plot2 <- renderPlot(plot(pressure))
output$mt <- renderDT(mtcars)
output$ir <- renderDT(iris)
observeEvent(input[["tabset"]], {
if(input[["tabset"]] == "tab4"){
addClass(selector = "body", class = "sidebar-collapse")
updateControlbar("controlbar")
}else{
removeClass(selector = "body", class = "sidebar-collapse")
}
})
}
shinyApp(ui, server)
Hi I am using shinydashboard to build some visualization for some raster files. I am use leafletOutput to display the map.
Under the first tabItem, where it is called 'KmeansOutput', I would like to display the leaflet map. When I do not include selectInput, it display the map, but once I include the selectInput, it do not display the map. I am not sure which part went wrong. Thanks in advance!!
Here is the UI section of the code:
library(shinydashboard)
library(leaflet)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("KmeansOutput", tabName = "kmeans", icon = icon("kmeans"),
selectInput("run1",
"SoilAllWeatherAll",
choices = c('4' = 1, '5' = 2),
multiple = TRUE)
),
menuItem("HistoricalWeather", icon = icon("weather"), tabName = "weather"),
menuItem("SoilMap", icon = icon("soil"), tabName = "soil")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "kmeans",
leafletOutput("map", height = 700)
),
tabItem(tabName = "weather",
h2("weather")),
tabItem(tabName = "soil",
h2('soil'))
)
)
# Put them together into a dashboardPage
ui <- dashboardPage(
dashboardHeader(title = "Genome Prediction"),
sidebar,
body)
here is the server:
server <- function(input, output) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles()
})
}
shinyApp(ui, server)
You need to add a sub-item to your k-means siderbar item as follows.
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("KmeansOutput", #icon = icon("kmeans"),
menuSubItem(
"K-Means Map", tabName = "kmeans", icon = icon("calendar")
),
selectInput("run1",
"SoilAllWeatherAll",
choices = c('4' = 1, '5' = 2),
multiple = TRUE)
),
menuItem("HistoricalWeather", tabName = "weather"), #icon = icon("weather"),
menuItem("SoilMap", tabName = "soil")#, icon = icon("soil")
)
)
I have two tabs in my App and when I go to the video tab and click full screen and then go back to my leaflet page, the map is not displayed properly, please see the code and screenshot below.
step 1: click video tab
step 2: click full screen button (of the video)
step 3: hit ESC key
step 4: click dashboard tab
ui.R
library("shinydashboard")
library("shiny")
library("leaflet")
dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(disable = FALSE,
collapsed = FALSE,
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard"),
menuItem("Video", tabName = "video")
)
),
body = dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
fluidRow(
column(width = 9, box(width = NULL, solidHeader = TRUE, leafletOutput("map", height=700)))
)
),
tabItem(
tabName = "video",
fluidRow(
column(width = 9, tags$video(src = "http://mirrors.standaloneinstaller.com/video-sample/jellyfish-25-mbps-hd-hevc.mp4", type = "video/mp4", height = "320px",
weight = "640px", controls = "controls")
)
)
)
)
)
)
server.R
library("shinydashboard")
library("shiny")
library("leaflet")
function(input, output, session){
output$map <- renderLeaflet(
leaflet() %>%
addTiles() %>%
setView(lng = -77.0387185, lat = 38.8976763, zoom = 10)
)
}
Thanks
This seems like a bug to me, but I am not sure on which side, leaflet/shinydashboard or shiny, as this also seems to happen when using fluidPage and tabsetPanel.
A workaround would be to trigger a fake resize event on the window, as this apparently solves the problem, also when done manually.
The jscode waits for a click on the sidebar-menu list and triggers a new resize Event. Make sure to include the Jquery code in the HTML by adding tags$head(tags$script(jscode)) to the dashboardBody.
library(shinydashboard)
library(shiny)
library(leaflet)
jscode = HTML("
$(document).on('shiny:connected', function() {
$('.sidebar-menu li').on('click', function(){
window.dispatchEvent(new Event('resize'));
});
});
")
ui <- {dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(disable = FALSE,
collapsed = FALSE,
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard"),
menuItem("Video", tabName = "video")
)
),
body = dashboardBody(
tags$head(tags$script(jscode)),
tabItems(
tabItem(tabName = "dashboard",
fluidRow(
column(width = 9, box(width = NULL, solidHeader = TRUE, leafletOutput("map", height=700)))
)
),
tabItem(
tabName = "video",
fluidRow(
column(width = 9, tags$video(src = "http://mirrors.standaloneinstaller.com/video-sample/jellyfish-25-mbps-hd-hevc.mp4", type = "video/mp4", height = "320px",
weight = "640px", controls = "controls")
)
)
)
)
)
)}
server <- function(input, output, session){
output$map <- renderLeaflet(
leaflet() %>%
addTiles() %>%
setView(lng = -77.0387185, lat = 38.8976763, zoom = 10)
)
}
shinyApp(ui, server)
I have a shiny application, where in I am trying to provide a checkbox on top of a graph for the user to select. Currently, the check box is rendered below the title, whereas I want the title on the left hand side and the check box on the right hand side in the same line. I am sure it can be achieved through recoding CSS, but don't know how. The current code looks as follows:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
title = "MODULE",titleWidth = 225
),
dashboardSidebar(
width = 225,
sidebarMenu(id = "tabs",
menuItem("TOPLINES", tabName = "tplines", icon = shiny::icon("dashboard"))
)),
dashboardBody(
tabItems(
tabItem(
tabName = "tplines",
fluidRow(
box(
checkboxInput(inputId = "inventorytop8metrocheck", "Add to reports", value = FALSE),
width = 6, status = "info", title = "Inventory information",
div(plotlyOutput("inventorytop8metro"), width = "100%", height = "400px", style = "font-size:80%;")
)
)))))
server <- function(session,input,output){
}
shinyApp(ui,server)
Maybe you are just looking for the standard row partition with columns. The title arguement takes any ui elements, so we input a row that is half your original title and half the checkbox input. Thus, they are in line. Of course, the checkbox then has the same style as the title. If you don't want that, you can alter the style by setting a style parameter in the checkbox column.
library(shiny)
library(shinydashboard)
library(plotly)
ui <- dashboardPage(
dashboardHeader(
title = "MODULE",titleWidth = 225
),
dashboardSidebar(
width = 225,
sidebarMenu(id = "tabs",
menuItem("TOPLINES", tabName = "tplines", icon = shiny::icon("dashboard"))
)),
dashboardBody(
tabItems(
tabItem(
tabName = "tplines",
fluidRow(
box(
width = 6, status = "info", title = fluidRow(
column(6, "Inventory information"),
column(6, checkboxInput(inputId = "inventorytop8metrocheck", "Add to reports", value = FALSE))
),
div(plotlyOutput("inventorytop8metro"), width = "100%", height = "400px", style = "font-size:80%;")
)
)
)
)
)
)
server <- function(session,input,output){}
shinyApp(ui,server)
I am working with shinydashboard and using tabsetPanel, however strange name/number appears on the each tabPanel in the upper-left corner (like: tab-4750-1 and the number changes).
Does anyone know how i can remove it?
Hint: The problem appears in the menuItem: Tabelle & Plots
Code:
library(shiny)
library(shinydashboard)
library(ggplot2)
library(scales)
library(reshape2)
library(plyr)
library(dplyr)
library(DT)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Tabelle & Plots", icon = icon("area-chart"), tabName = "tabelle")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard"
),
tabItem(tabName = "tabelle",
tabsetPanel(id="tabs",width = NULL, height = "800px", selected = 1,
tabPanel(value=1,title="Tabelle filtern",
fluidRow(
column(12,
box(width = NULL, div(style = 'overflow-y: scroll; overflow-x: scroll;max-height: 650px; position:relative;',
dataTableOutput("tabelle")))))),
tabPanel("Plots", value = 2,
fluidRow(
column(12,
box(width = NULL, plotOutput("plot", height=650)),
box(status = "danger",width = NULL,div(style = 'overflow-x: scroll;position:relative;',
dataTableOutput("tabelle2")))))))
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
Thanks for help!
Cheers