I'm trying to eliminate the space between this table and the left side of browser window, but when I do, it messes up the spacing of the nav bar links and title.
How can I remove padding/margin on the excelR table, without altering the padding/margin of the navbar/ui/li elements?
library(shiny)
library(excelR)
shinyApp(
ui = navbarPage("title", selected = "main",
position = "fixed-top",
tags$style(type="text/css", "body {padding-top: 70px;}"),
tags$head(
tags$style(
"body {overflow-y: hidden;}"
)
),
tags$head(
tags$style(type = "text/css", ".container-fluid {padding-left:0px;
padding-right:0px; margin-right:0px; margin-left:0px;}")
),
tabPanel("main", id = "main",
fluidPage(
excelOutput("table", width = "100%", height = "1000px")
#htmlOutput("table", width = "100%", height = "500px")
)
)
),
server = function(input, output, session) {
output$table <-renderExcel(
excelTable(
data = iris,
autoColTypes = FALSE,
autoFill = TRUE,
fullscreen = FALSE,
lazyLoading = TRUE,
search = TRUE,
tableHeight = "800px",
pagination <- NULL
)
)
}
)
You can simply add this additional css to your code:
tags$style(type = "text/css", ".navbar{padding-left:15px;
padding-right:15px ; margin-right:auto; margin-left:auto;}")
),
Hope this helps!
Related
I have this code:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(userOutput("user")),
sidebar = dashboardSidebar(shinyjs::useShinyjs(),uiOutput("sidebarpanel")),
body = dashboardBody(uiOutput("body")),
title = "DashboardPage"
),
server = function(input, output) {
output$user <- renderUser({
dashboardUser(
name = "Divad Nojnarg",
image = "https://adminlte.io/themes/AdminLTE/dist/img/user2-160x160.jpg",
title = "shinydashboardPlus",
subtitle = "Author",
footer = p("The footer", class = "text-center"),
fluidRow(
actionButton("personalInfo","Personal Info")
)
)
})
observeEvent(input$personalInfo, {
output$body <- renderUI({h4("Personal Info Dahsboard (no menuItem)")})
})
output$sidebarpanel <- renderUI({
sidebarMenu(id="tabs",
menuItem("Dashboard 1", tabName = "dashboard1", icon = icon("dashboard"))
,menuItem("Dashboard 2", tabName = "dashboard2", icon = icon("dashboard"))
)
})
output$body <- renderUI({
tabItems(
tabItem(tabName ="dashboard1",
fluidRow(box(width = 12, h4("Dashboard 1 (menuItem)"))))
,tabItem(tabName ="dashboard2",
fluidRow(box(width = 12, h4("Dashboard 2 (menuItem)"))))
)
})
}
)
I would like to do two things:
First: When I click on "Personal Info" button, then, prevent the menuItem to be shadowed (I assume I need to remove the class "selected" or "active" or something like that)
Second: I want to fix this: After pressing "Personal Info" button, the menuItems do not work:
As already shown in my earlier answer here we can use a hidden menuItem to modify the body content independent from the visibly selected menuItem.
Furthermore, I'd recommend to stop using renderUI in this scenario. In general it is slower to re-render a UI element instead of updating an existing element (here we can switch to the hidden menuItem via updateTabItems - however, this applies also to e.g. using updateSelectInput instead of renderUI({selectInput(...)})). In this context you should also question whether you really need the to create the dashboardUser on the server side.
If you really need a server side generated dashboardSidebar you still should not use renderUI - There are the renderMenu() / sidebarMenuOutput() functions available for this. Please see the related docs here.
library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(userOutput("user")),
sidebar = dashboardSidebar(shinyjs::useShinyjs(),
sidebarMenu(id="tabs",
menuItem("Tab 1", tabName = "tab1", icon = icon("dashboard")),
menuItem("Tab 2", tabName = "tab2", icon = icon("dashboard")),
hidden(menuItem("Personal Tab", tabName = "personal_tab", icon = icon("dashboard")))
)),
body = dashboardBody(useShinyjs(),
tabItems(
tabItem(tabName ="tab1",
fluidRow(box(width = 12, h4("Tab 1 (menuItem)")))),
tabItem(tabName ="tab2",
fluidRow(box(width = 12, h4("Tab 2 (menuItem)")))),
tabItem(tabName ="personal_tab",
fluidRow(box(width = 12, h4("Personal Info Dahsboard (no menuItem)"))))
)
),
title = "DashboardPage"
),
server = function(input, output, session) {
output$user <- renderUser({
dashboardUser(
name = "Divad Nojnarg",
image = "https://adminlte.io/themes/AdminLTE/dist/img/user2-160x160.jpg",
title = "shinydashboardPlus",
subtitle = "Author",
footer = p("The footer", class = "text-center"),
fluidRow(
actionButton("personalInfo","Personal Info")
)
)
})
observeEvent(input$personalInfo, {
shinydashboard::updateTabItems(session, inputId = "tabs", selected = "personal_tab")
})
}
)
I use the function flipBox from shinydashboardPlus to create flip box and I add a button. The user have to clik on it to flip the box. But the box also flip when we click on it and I would like to desactive it I mean prevent fliping by cliking on the box (the box must flip only when we click on the button). This is what I did :
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
actionButton("swich_id", "click to swich"), # click on the button to flip the box
flipBox(
id = "id1",
front = div(
class = "text-center",
height = "300px",
width = "100%",
h1("A"),
p("a table"),
DT::DTOutput('mytable')
),
back = div(
class = "text-center",
height = "300px",
width = "100%",
h1("B"),
p("a graphe"),
plotOutput("graph")
)
)
)
),
server = function(input, output, session) {
output$mytable <- DT::renderDT({
cars[1:5, 1:2]
})
output$graph <- renderPlot({
plot(cars$speed, cars$dist)
})
observeEvent(input$swich_id, {
updateFlipBox("id1")
})
}
)
Some help would be appreciated
There is no official way to do so. We need to have our own custom hacky way to change the source code of flipBox.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
flipBox <- function (id, front, back, trigger = c("click", "hover", "disable"), width = 6) {
if (is.null(id) || missing(id))
stop("card id cannot be null or missing!")
trigger <- match.arg(trigger)
shiny::column(width = width, shiny::tags$div(style = "position: relative",
class = "flipbox", id = id, `data-rotate` = trigger,
shiny::tags$div(class = "card-front active", style = "background-color: white;",
front), shiny::tags$div(class = "card-back", style = "background-color: white;",
back)))
}
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
useShinyjs(),
tags$script(HTML(
'
function _clickOnFront(el) {
$(el)
.find(".card-front")
.css({
"-webkit-transform": "perspective(1600px) rotateY(-180deg)",
transform: "perspective(1600px) rotateY(-180deg)"
})
.toggleClass("active");
$(el)
.find(".card-back")
.css({
"-webkit-transform": "perspective(1600px) rotateY(0deg)",
transform: "perspective(1600px) rotateY(0deg)"
})
.toggleClass("active");
}
function _clickOnBack(el) {
$(el)
.find(".card-front")
.css({ "-webkit-transform": "", transform: "" })
.toggleClass("active");
$(el)
.find(".card-back")
.css({ "-webkit-transform": "", transform: "" })
.toggleClass("active");
}
'
)),
actionButton("swich_id", "click to swich"), # click on the button to flip the box
flipBox(
id = "id1",
trigger = "disable",
front = div(
class = "text-center",
height = "300px",
width = "100%",
h1("A"),
p("a table"),
DT::DTOutput('mytable')
),
back = div(
class = "text-center",
height = "300px",
width = "100%",
h1("B"),
p("a graphe"),
plotOutput("graph")
)
)
)
),
server = function(input, output, session) {
output$mytable <- DT::renderDT({
cars[1:5, 1:2]
})
output$graph <- renderPlot({
plot(cars$speed, cars$dist)
})
observeEvent(input$swich_id, {
if(input$swich_id %% 2 != 0) return(runjs('_clickOnFront($("#id1"))'))
runjs('_clickOnBack($("#id1"))')
})
}
)
define our own flipBox function. Here we add one more option trigger = c("click", "hover", "disable") to allow us to choose methods other than click or hover.
Copy the flip functions from source code and define as JS functions that we have easy access with tags$script.
Use shinyjs to manually flip the box when the button is clicked.
I am facing a problem with the layout in R Shiny when I use the R Markdown file inside it I get the final result in a wired layout size (small and only in the middle of the screen ) as shown in the following photo:
Attached to you the code:
library(shiny)
library(shinydashboard)
library(knitr)
ui <-
dashboardPage(
dashboardHeader(title ='Virtual Excursion'),
dashboardSidebar( sliderTextInput(
inputId = "mySliderText",
label = "Story line",
grid = TRUE,
force_edges = TRUE,
choices = c('1','2')
)
),
dashboardBody(
fluidRow(
column(9,
box(
title = "Operations ",
closable = FALSE,
width = 9,
status = "primary",
solidHeader = FALSE,
collapsible = TRUE,
uiOutput("operations")
)
)
),
fluidRow(
column(9,
box(
title = "Challenges",
closable = FALSE,
width = 9,
status = "primary",
solidHeader = FALSE,
collapsible = TRUE,
uiOutput("challenges")
)
)
)
)
)
server <- function(input, output,session){
output$operations <- renderUI({
req(input$mySliderText==1)
HTML(markdown::markdownToHTML(knit('trial1.rmd', quiet = TRUE)))
})
}
shinyApp(ui = ui, server = server)
Could you please guide me on how to fix this problem!
The problem is that you are including an full html file within an html page. The conflicts between the two pages is causing the display problem. You need to output an html fragment which excludes the heading. Add fragment.only = TRUE to your markdown render function.
HTML(markdown::markdownToHTML(knit("trial1.rmd", quiet=T),fragment.only = T))
You can also add output: html_fragment in your yaml section inside the rmd file for good measure.
Is there a way to automatically upload the excel file.
Right now, the user has to manually upload the excel file(file.xlsx) that is kept under project folder.
Now the expected output is the moment the user clicks on "Automatically Upload the exceil file", the file should get uploaded.
Is there a way to achieve this? Let me know if this makes sense
library(tidyverse)
library(shiny)
library(shinydashboard)
library(DT)
ui <-
dashboardPage(
skin = "green",
dashboardHeader(
title = "Test",
titleWidth = 280
),
dashboardSidebar(
width = 280,
sidebarMenu(
menuItem(text = "File(s) Upload", tabName = "Files", icon = icon("file-upload")),
menuItem(text = "Output", tabName = "Out1", icon = icon("file-upload"))
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "Files",
fluidRow(
column(
width = 4,
inputPanel(
fileInput(inputId = "File1", label = "File", multiple = TRUE, accept = c(".xlsx")),
selectInput(inputId = "Sheet1", label = "Select sheet", choices = NULL, selected = NULL),
actionButton("sub", "Automatically Upload the exceil file")
)
)
)
),
tabItem(
tabName = "Out1",
fluidRow(column(width = 10, strong("Data")), align = "center"),
br(),
fluidRow(dataTableOutput("Data1"))
)
)
)
)
server <- function(input, output){
# Populate the drop down menu with the names of the different Excel Sheets, but
# only after a new file is supplied
observe({
sheet_names <- readxl::excel_sheets(input$File1$datapath)
shiny::updateSelectInput(
inputId = "Sheet1",
choices = sheet_names,
selected = sheet_names[[1]]
)
}) %>%
bindEvent(input$File1)
# When the drop down meny is populated, read the selected sheet from the Excel
# file
thedata <- reactive({
req(input$Sheet1)
readxl::read_xlsx(input$File1$datapath, sheet = input$Sheet1)
})
output$Data1 <-
renderDataTable(
thedata()
, extensions = "Buttons"
, options = list(
dom = "Bfrtip"
, buttons = c("copy", "csv", "excel", "pdf", "print")
)
)
# observe({
# print(reactiveValuesToList(input, all.names = FALSE))
# })
}
runApp(
list(ui = ui, server = server)
, launch.browser = TRUE
)
Lets take the example of the reference: https://rstudio.github.io/shinydashboard/structure.html#sidebar-menu-items-and-tabs. When put more items in the menuItem(), your associate tab don't works anymore. I tried in this simple modification in example below and just shown the widgets' tab:
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Dashboard",
tabName = "dashboard",
icon = icon("dashboard"),
selected = TRUE,
startExpanded = TRUE,
numericInput("num1",
"Put the First Number",
value = 1,
min = 0),
numericInput("num2",
"Put the Second Number",
value = 1,
min = 0)
),
menuItem("Widgets",
icon = icon("th"),
tabName = "widgets")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content"),
fluidRow(
valueBoxOutput("box1", width = 6),
valueBoxOutput("box2", width = 6)
)
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
# Put them together into a dashboardPage
ui <- dashboardPage(
skin = "green",
dashboardHeader(title = "Example"),
sidebar,
body
)
server <- function(input, output){
output$box1 <- renderValueBox({
valueBox(input$num1,
"First Number",
color = "aqua",
icon = icon("chart-line"))
})
output$box2 <- renderValueBox({
valueBox(input$num2,
"Second Number",
color = "aqua",
icon = icon("chart-line"))
})
}
shinyApp(ui, server)
That is because childfull menuItem behaves differently as noted here. Therefore, you need to define a menuItem or a menSubItem within that dashboard page so that your desired content can be displayed.
Try this
sidebarMenu(id = "tabs",
menuItem("Dashboard",
tabName = "dashboard",
icon = icon("tachometer-alt"),
selected = TRUE,
startExpanded = TRUE,
#icon = icon(fontawesome:::fa_tbl[[1]][505]),
menuItem("Sub-item 1", tabName = "subitem1"),
### menuSubItem("Sub-item 1", tabName = "subitem1"), ## it can be menuSubItem instead of menuItem
numericInput("num1",
"Put the First Number",
value = 1,
min = 0),
numericInput("num2",
"Put the Second Number",
value = 2,
min = 0)
),
menuItem("Widgets",
icon = icon("th"),
tabName = "widgets")
)
)
body <- shinydashboard::dashboardBody(
tabItems(
tabItem(tabName = "subitem1",
h2("Sub item1 tab content in Dashboard"),
fluidRow(
valueBoxOutput("box1", width = 6),
valueBoxOutput("box2", width = 6)
)
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
# Put them together into a dashboardPage
ui <- shinydashboard::dashboardPage(
skin = "green",
shinydashboard::dashboardHeader(title = "Example"),
sidebar,
body
)
server <- function(input, output, session){
output$box1 <- renderValueBox({
valueBox(input$num1,
"First Number",
color = "aqua",
icon = icon("chart-line"))
})
output$box2 <- renderValueBox({
valueBox(input$num2,
"Second Number",
color = "aqua",
icon = icon("chart-line"))
})
observe({print(input$tabs)})
}
shinyApp(ui, server)