Can I use RShiny to open RMarkdown Files? - r

Is there a way I can embed RMarkdown documents in an RShiny app? That way when someone clicks on the document it opens in a new window? I know it's straightforward to embed RShiny into RMarkdown documents, but does it go the other way?
I'm working in a RShiny Dashboard, and I'd like to be able to open my menuSubItem and have the list of Rmds there.
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "MWE"),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Menu1", tabName = "dashboard", icon = icon("folder-open"),
menuSubItem("Sub Menu 1",icon = icon("folder-open"), tabName = "subMenu1")
)
)
),
dashboardBody(
tabItems(
tabItem(tabName = "subMenu1",
h2("How do I list RMarkdown files here?")
)
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)

Related

Data table will not work in shinydashboard

If shinydashboard was a person I would like to meet him in a dark alley with a baseball bat. I am simply trying show a data frame as a table in my shiny app so I looked online at a bunch websites and questions on stack exchange and this is what I got.
UI
library(shiny)
library(shinydashboard)
library(data.table)#For fread.
library(tidyverse)
library(htmlwidgets)
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',
DT::dataTableOutput("overviewtable")
),
tabItem(tabName = 'weather',
fluidRow(
)
)
)
)
# UI ---------------------------------------------------------------------------|
ui = dashboardPage(
header,
sidebar,
body
)
shinyApp(ui,server)
Server
server <- function(input,output){
#Table for overview
output$overviewtable<- DT::renderDataTable({
DT::datatable(tib1)
})
}
I have tried using tableOutput and renderTable
I have tried to see if my tib1 was somehow the problem so I tried using the data set mpg. That didnt work. I tried placing DT::dataTableOutput("overviewtable") in a column(), in a fluidRow. I tried reinstalling the packages for DT and refreshing R but that didnt work. I looked at the gallery website from R here. I took that code and ran it and I was able to see their table they made but when I ran my code I cant see my table at all or other tables for that matter. I have a feeling it has something to do with shinydashboard because it seems that when I ran the code from the website above that was just using shiny it worked.
The problem is a typo in the tabName = argument:
sidebar<-dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabName ="overview", icon = icon("dashboard")),
menuItem("Weather", tabName ="weather", icon = icon("bolt"))
)
)

Shiny Dashboard- How to add text for Sidebar items

I was trying to add website information on my shiny dashboard and for the "About" section (See image) I want few lines to be displayed on the dashboard body when clicked on that tab. how could i possibly achieve it? I could successfully add href for the "contact" section.
Maybe I do not understand your question properly, but what about:
library(shiny)
library(shinydashboard)
header <- dashboardHeader()
sidebar <- dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("About", icon = icon("info"), tabName = "about"),
menuItem("Contact", icon = icon("phone"), tabName = "contact")
)
)
)
body <- dashboardBody(
tabItems(
tabItem("about",
h1("About")),
tabItem("contact",
h1("Contact"))
)
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) { }
)
When you click on About you get a new tab in the dashboardBody where you can display whatever you want.
Update
Based on your clarification you can use shinyjs to hide/show the relevant part:
library(shiny)
library(shinydashboard)
library(shinyjs)
header <- dashboardHeader()
sidebar <- dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("About", icon = icon("info"), tabName = "about"),
menuItem("Contact", icon = icon("phone"), tabName = "contact")
)
)
)
body <- dashboardBody(
useShinyjs(),
fluidPage(
fluidRow(id = "mainContent",
column(12, h1("Main Content"))
),
hidden(fluidRow(id = "contact", h1("Contact Info")))
)
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) {
observe({
if (input$tabs == "contact") {
hideElement("mainContent")
showElement("contact")
} else {
hideElement("contact")
showElement("mainContent")
}
})
}
)
When you now click on Contact the main part is hidden and the contact is shown. I have, however, the feeling that is a bit mis-using the idea of shinydashboard.
#thothal, it did not allow me to add as a comment coz of the length, hence posting my comment(below) as an answer.
I am sorry if I was unclear. However, your answer helped me partially. I have incorporated tabItems part in my dashboardBody section, as shown below:
dashboardBody(
fluidPage(
fluidRow(
column(12, div(dataTableOutput("dataTable")))
)
),
tabItems(
tabItem("About", h1("text to be displayed"))
)
)
but the "text to be displayed" shows up below the table.
What I want is, About section (when clicked) should display only the text and not the table. I understand this is just formatting of the code in dashboardBody section but I don't know how to do it.
Just to be more clear, my dashboard's section should display the datatable at all times and the about section when clicked should show up the text and not the datatable. I really hope this is clear. Thanks a ton for your help :)

Change the font inside tags in a shiny app

How can I set the font in a text in a shiny app? Should I change it for every tags$ or is there a generic way?
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
),
dashboardBody(
)
)
server <- function(input, output) {
tags$h3(style="color:black","font-family:Calibri", "Text")
}
shinyApp(ui, server)
this is sample of the part that I want to edit:
output$tabers<-renderUI({
if(input$sec=="Introduction"){
tabsetPanel(id="I",type="tabs",tabPanel("Start", id = "StartHR",
tags$br(),
img(src='Alpha-Architect.png', align = "center",height="100%", width="50%"),
tags$br(),
tags$br(),
tags$h3(style="color:black", "About this Dashboard"),
br(),
p(style="text-align:justify; color:black;'",'Produced by',a("Alpha Architect.",
href = "https://alphaarchitect.com"),"and",a("RStudio.",
href = "http://www.reproduciblefinance.com/")),
#br(),
br(),
p(style="text-align:justify; color:black;'",'Please read our full disclosures',a("here",
href = "https://alphaarchitect.com/disclosures")),
Why do you write it in server?
To globally apply styles, you need to add styles in head of HTML.
Add this as your dashboard body:
dashboardBody(
tags$head(
tags$style("h3 {font-family:Calibri}")
)
)

How to enable a particular sub-menu in Rshiny?

I am developing a shinyApp using a dashboard package. In that a menu item has 2 sub-menus and the application has to react according to the selection of the sub-menu. But without selecting the sub-menu I have my data displayed. Can anyone help me to resolve this issue?
This is the code snippet used. Thanks in advance.
dashboardSidebar(
sidebarMenu(
menuItem('Modify',
menuSubItem('Edit details', tabName = 'edit'),
)
)),
dashboardBody(
tabItems(
tabItem(tabName = 'edit',
hotable('hotable1'),
downloadButton('downloadData', 'Download')
)
)
I don't think I completely understand your question but from what I gather you are questioning why the table appears on application initialization without the user clicking the menuSubItem. This is the default behavior in Shiny Dashboard, the app will start with the first menuSubItem as the default value, if you desire a particular menuSubItem as the starting sub-tab that can be achieved using the selected option under menuItem
Here is a reproducible example exhibiting the same behavior, in order to explicitly highlight this behavior I've used startExpanded = TRUE. Here you can observe the first subMenuItem is selected by default. More on childfull menuItem() can be referred here
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("Modify",startExpanded = TRUE,
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")
)
)
),
dashboardBody(
tabItems(
tabItem("subitem1", "Sub-item 1 tab content"),
tabItem("subitem2", "Sub-item 2 tab content")
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)

daterangeinput without fluidpage in shiny dashboard

I have an issue while creating a shiny web app using semantic.dashboard library.
Below is the code for my app.
library(semantic.dashboard)
# Define UI
header <- dashboardHeader(
)
sidebar <- dashboardSidebar(
side = "left",
sidebarMenu(
menuItem(tabName = "overview", text = "Overview", icon = icon("home")),
menuItem(tabName = "analysis", text = "Analysis", icon = icon("chart bar"))
)
)
body <- dashboardBody(
dateRangeInput("datepicker", NULL, start = Sys.Date()-30, end = Sys.Date()-1)
)
tabItems(
tabItem(
tabName = "overview",
fluidRow(
)
),
tabItem(
tabName = "analysis",
fluidRow(
)
)
)
ui <- dashboardPage(
header,
sidebar,
body,
title = "My Dashboard",
theme = "lumen"
)
# Define server logic
server <- function(input, output, session) {
session$onSessionEnded(stopApp)
}
# Run the application
shinyApp(ui = ui, server = server)
The result is in the screenshot below:
The main problem is that the dates inside the daterangeinput widget are just like simple text inside textbox.
I can't click on them to change the dates.
Using fluidPage() would resolve the problem, but the whole web page isn't filled totally by the app (and for this app, responsiveness isn't really useful).
Below is the screenshot of the app when I use fluidPage(), you can see that there's so much space between the sidebar and the border, and beetween the sidebar and the body.
app with fluidPage()
I'd like to know if it's possible to use daterangeinput without using fluidPage() or, if not possible, know how to remove the padding between the border and the sidebar when using fluidPage.
Thanks in advance for your help.
Above example doesn't work because it uses bootstrap framework styles - contrary to shiny.semantic or semantic.dashboard packages.
Please check my PR to shiny.semantic package. I've implemented there simple date input with usage of semantic-ui components. You can also use it to create simple date range (added quick example in PR).

Resources