argondash don't work with horizontal layout - r

Hi and thanks for reading me
I am working with a dashboard made with shiny, argondash and argonr, but I noticed that the horizontal layout does not work correctly, since the windows continue to be displayed vertically. Is there any way to correct this? I would expect it to look like this:
The code is the following:
library(shiny)
library(argonDash)
library(argonR)
shinyApp(
ui = argonDashPage(title = 'Sync the City',
description = 'Testing',
header = argonDashHeader(color = 'primary', separator = TRUE),
sidebar = argonDashSidebar(vertical = FALSE,
brand_logo = "https://elpacientecolombiano.com/wp-content/uploads/2015/09/LOGO-SALUD-MORADO.png",
id = 'sidebar',
argonSidebarHeader(title = 'Main Menu'),
argonSidebarMenu(
argonSidebarItem(tabName = 'landing_page', 'Landing Page'),
argonSidebarItem(tabName = 'map', 'Map'),
argonSidebarItem(tabName = 'network', 'Network')
)
)
),
server = function(input, output){}
)

I added the following arguments to your code :
size = "md" in argonDashSidebar()
style = "display:-webkit-inline-box;" in argonSidebarMenu()
library(shiny)
library(argonDash)
library(argonR)
shinyApp(
ui = argonDashPage(
title = 'Sync the City',
description = 'Testing',
header = argonDashHeader(color = 'primary', separator = TRUE),
sidebar = argonDashSidebar(
vertical = FALSE,
brand_logo = "https://elpacientecolombiano.com/wp-content/uploads/2015/09/LOGO-SALUD-MORADO.png",
id = 'sidebar',
size = "md",
argonSidebarHeader(title = 'Main Menu'),
argonSidebarMenu(
style = "display:-webkit-inline-box;",
argonSidebarItem(tabName = 'landing_page', 'Landing Page'),
argonSidebarItem(tabName = 'map', 'Map'),
argonSidebarItem(tabName = 'network', 'Network')
)
)
),
server = function(input, output){}
)

Related

modualized shiny app ui renders all plots on top of one another

I have a shiny app, fully built, that I had built all in one script. Everything was working, the ui, etc. and I wanted to modularize the app to make the code a bit more readable. Now all the plots render on top of each other and I can't figure out why. I've tried using pageContainer, sidbarLayout, sidePanel and mainPanel, fluidPage, fixedPage, etc. and none have worked. I'm also using pagePiling with my main ui, so not sure if that has sometimes to do with it? Any help would be much appreciated!
Please find the full code here: https://github.com/eoefelein/COVID_Business_Recovery_and_Social_Capital/tree/master/socialCapitalEmployment
Here is what my ui code looks like:
ui <- tagList(
pagePiling(
center = TRUE,
sections.color = c("#3333FF", "#E6E6E6"),
menu = c(
"Home" = "home",
"Map" = "map",
"Series" = "ts",
"PCA" = "pca",
"Predict" = "predict",
"About" = "about"
),
pageSectionImage(
center = TRUE,
img = "",
menu = "home",
h1(("title"), class = "header shadow-dark"),
h3(
class = "light footer",
"by",
tags$a("news-r", href = "https://news-r.org", class = "link")
)
),
pageSection(center = TRUE,
menu = "map",
mod_map_ui("map"),
br()),
pageSection(center = TRUE,
menu = "ts",
mod_ts_ui("ts"),
br()),
pageSection(center = TRUE,
menu = "pca",
mod_pca_ui("pca"),
br()),
pageSection(
center = TRUE,
menu = "predict",
mod_predict_ui("predict"),
),
pageSection(
center = TRUE,
menu = "about",
h1("About", class = "header shadow-dark"),
h2(
class = "shadow-light",
tags$a(
"The code",
href = "https://github.com/news-r/fopi.app",
target = "_blank",
class = "link"
),
"|",
tags$a(
"The API",
href = "https://github.com/news-r/fopi",
target = "_blank",
class = "link"
)
),
h3(
class = "light footer",
"by",
tags$a("news-r", href = "https://news-r.org", class = "link")
)
)
)
)
Here is my first module's ui:
mod_map_ui <- function(id) {
ns <- NS(id)
tagList(
fluidPage(
h1("Employment & Social Capital across the U.S by County"),
center = TRUE,
column(9, leafletOutput(ns("map"), height = "100vh")),
column(
3,
shinyWidgets::radioGroupButtons(
inputId = ns("idx"),
label = "Metric",
choices = c(unique(social_indices$name)),
checkIcon = list(yes = icon("ok",
lib = "glyphicon"))
)
)
))
}
And here is my second module's ui:
mod_ts_ui <- function(id) {
ns <- NS(id)
tagList(
fixedPage(
h2("Employment by County", align = "center"),
fixedRow(
column(
4,
selectizeInput(
inputId = ns("dataset"),
label = "Choose a county:",
choices = c(unique(employment["countyfips"])),
multiple = TRUE,
selected = "Travis County, Texas",
options = list(create = TRUE)
)
),
column(
8, (echarts4r::echarts4rOutput(ns("ts_plot")))
)
)
)
)
}
okay, so I fixed it and what I think fixed it was specifying a color for each section:
pagePiling(
center = TRUE,
sections.color = c("#7b959c", "#445768","#b9bdc9","#f6e7ea","#e2e2e2","#1e4356"),
menu = c(
"Home" = "home",
"Map" = "map",
"Series" = "ts",
"PCA" = "pca",
"Predict" = "predict",
"About" = "about"
),
Very strange, but after I did that, each plot presented as it should, in it's own section. Hope this helps someone in the future!

Leaflet not working in R Shiny Package fullPage

I am having trouble getting a leaflet map to display in R Shiny when using the fullPage package/theme. Anyone have any idea what could be going on here? Code works in all the othe Shiny themes I use, so I'm guessing it's something specific to fullPage? I only started playing around with this theme yesterday so certainly possible I'm missing something.
Full Example Below:
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
library(fullPage)
library(leaflet)
library(highcharter)
library(glue)
library(tidyverse)
img1 <- "https://live.staticflickr.com/8081/8312400018_f53f23dac9_b.jpg"
# Define UI for application that draws a histogram
options <- list(
sectionsColor = c('#F5F5F5'),
parallax = TRUE
)
ui <- fullPage(
menu = c("Home" = "home",
"About" = "about",
"Analytics" = "analytics",
"Buy" = "section3",
"Sell" = "section4",
"Rent" = "section5",
"Contact" = "contact"),
opts = options,
fullSectionImage(
img = img1,
menu = "home"
),
fullSection(
center = FALSE,
menu = "about",
br(),
br(),
fullContainer(
tags$h1("Example")
),
fullContainer(
fullRow(
fullColumn(
p('Some text.'),
br(),
p('More text.')
)
)
),
fullRow(
pre(
code(
img(src = 'https://pics.harstatic.com/office/395001.png', width = '50%', height = 'auto')
)
)
)
),
fullSection(
menu = "analytics",
fullRow(
fullColumn(
h3("Column 1"),
selectInput(
"dd",
"data points",
choices = c(10, 20, 30)
)
),
fullColumn(
plotOutput("hist")
),
fullColumn(
plotOutput("plot")
)
)
),
fullSection(
menu = "section3",
fullSlide(
fullContainer(
center = TRUE,
h3("With container"),
plotOutput("slideplot2"),
shiny::verbatimTextOutput("containerCode")
)
),
fullSlide(
center = TRUE,
h3("Without container"),
plotOutput("slideplot1")
)
),
fullSectionPlot(
menu = "section4",
center = TRUE,
"fp",
h3("Background plots"),
fullContainer(
sliderInput(
"fpInput",
label = "Input",
min = 10,
max = 100,
value = 74
)
)
),
fullSection(
menu = "section5",
fullSlidePlot(
"slideSectionPlot1",
center = TRUE,
h1("Slide background plot")
),
fullSlidePlot(
"slideSectionPlot2"
)
),
fullSection(
menu = "contact",
fullContainer(
leaflet::leafletOutput('map')
)
)
)
server <- function(input, output, session){
output$map <- leaflet::renderLeaflet({
leaflet() %>%
addTiles(group = "OSM (default)")
}
)
}
shinyApp(ui, server)

How to use modules in a argonDash dashboard

I've just discovered these amazing packages called argonR and argonDash, but ,unfortunatly, I haven't had succes so far using modules with it. Is it possible?
I've tried to ns it, but it doesnt work. It works locally, but It is not able to change tabs when deployed.
# rm(list = ls())
library(shiny)
library(shinydashboard)
library(argonR)
library(argonDash)
library(magrittr)
library(shinyjs)
# Modules
source("sidebar.R", encoding = "utf8")
source("navbar.R", encoding = "utf8")
source("header.R", encoding = "utf8")
source("footer.R", encoding = "utf8")
source("R/mod_home.R", encoding = "utf8")
source("R/mod_stats.R", encoding = "utf8")
source("R/mod_prob.R", encoding = "utf8")
source("R/mod_stat_econ.R", encoding = "utf8")
source("R/mod_econometria.R", encoding = "utf8")
source("R/mod_ML.R", encoding = "utf8")
source("R/mod_quiz.R", encoding = "utf8")
source("R/mod_sobre.R", encoding = "utf8")
# App
ui <- argonDashPage(
title = "TCM",
author = "Guilherme",
description = "Guig's TCM",
sidebar = argonDashSidebar(
vertical = TRUE,
skin = "light",
background = "white",
size = "md",
side = "left",
id = "my_sidebar",
brand_url = "http://www.google.com",
# brand_logo = "https://demos.creative-tim.com/argon-design-system/assets/img/brand/blue.png",
# brand_logo = ,
brand_logo = "https://kdrt.org/sites/default/files/styles/adaptive/public/Rocket%20Radio%20program%20picture.png?itok=-FHCim8R",
argonSidebarHeader(title = "Menu Principal"),
argonSidebarMenu(
argonSidebarItem(
tabName = "home_tab",
style="text-align:center",
"Home"
),
argonSidebarItem(
tabName = "stats_tab",
style="text-align:center",
"Estatística"
),
argonSidebarItem(
tabName = "prob_tab",
style="text-align:center",
"Probabilidade"
),
argonSidebarItem(
tabName = "stat_econ_tab",
style="text-align:center",
"Estatística Econômica"
),
argonSidebarItem(
tabName = "econometria_tab",
style="text-align:center",
"Econometria"
),
argonSidebarItem(
tabName = "ML_tab",
style="text-align:center",
"Machine Learning"
),
argonSidebarItem(
tabName = "quiz_tab",
style="text-align:center",
"Quiz"
),
argonSidebarItem(
tabName = "sobre_tab",
style="text-align:center",
"Sobre"
)
),
argonSidebarDivider(),
argonSidebarHeader(title = "#TCM Versão 0.1")
),
navbar = argonDashNavbar(
argonDropNav(
title = "Powered by R",
# src = "https://demos.creative-tim.com/argon-dashboard/assets/img/theme/team-4-800x800.jpg",
src = "https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcRCLcatfAURCtGHsd71IjruuQqMXjezkwwjZR5inocuNz0imUF5sA",
orientation = "right",
argonDropNavTitle(title = "Este app é formado por"),
argonDropNavItem(
title = "R",
src = "https://www.r-project.org/",
icon = argonIcon("single-02")
),
argonDropNavItem(
title = "RStudio",
src = "https://rstudio.com/",
icon = argonIcon("settings-gear-65")
),
argonDropNavDivider(),
argonDropNavItem(
title = "Guigo's código",
src = "#",
icon = argonIcon("calendar-grid-58")
)
)
),
header = argonDashHeader(
gradient = TRUE,
color = "primary",
separator = TRUE,
separator_color = "secondary"#,
# argonCard(
# title = "Olá, visitante!",
# src = "https://www.linkedin.com/in/guilherme-viegas-1b5b0495/",
# hover_lift = TRUE,
# shadow = TRUE,
# shadow_size = NULL,
# hover_shadow = FALSE,
# border_level = 0,
# # icon = argonIcon("atom"),
# icon = "https://scontent.ffln1-1.fna.fbcdn.net/v/t1.0-9/13669798_1073355219425752_3359245208514920392_n.jpg?_nc_cat=111&_nc_oc=AQk0e2H7_Cjzdx97Vq_sl2v_JrdqSZBK5oFe6Kj6VGu_OKOvO7zFTwta02RVm-Bz8Ck&_nc_ht=scontent.ffln1-1.fna&oh=bad62632b291289b4338d3aec456cbe2&oe=5E2B61E2",
# status = "primary",
# background_color = NULL,
# gradient = FALSE,
# floating = FALSE,
# "Seja muito bem vindo.\nEste é meu cartão, tome."
# )
),
body = argonDashBody(
argonTabItems(
argonTabItem(
tabName = "home_tab",
mod_home_ui("home_ui_1")
),
argonTabItem(
tabName = "stats_tab",
mod_stats_ui("stats_ui_1")
),
argonTabItem(
tabName = "prob_tab",
mod_prob_ui("prob_ui_1")
),
argonTabItem(
tabName = "stat_econ_tab",
mod_stat_econ_ui("stat_econ_ui_1")
),
argonTabItem(
tabName = "econometria_tab",
mod_econometria_ui("econometria_ui_1")
),
argonTabItem(
tabName = "ML_tab",
mod_ML_ui("ML_ui_1")
),
argonTabItem(
tabName = "quiz_tab",
mod_quiz_ui("quiz_ui_1")
),
argonTabItem(
tabName = "sobre_tab",
mod_sobre_ui("sobre_ui_1")
)
)
),
footer = argonDashFooter(
copyrights = "#Guilherme Viegas, 2019",
src = "https://www.linkedin.com/in/guilherme-viegas-1b5b0495/",
argonFooterMenu(
argonFooterItem("Linkedin", src = "https://www.linkedin.com/in/guilherme-viegas-1b5b0495/"),
argonFooterItem("Github", src = "https://github.com/Gui-go"),
argonFooterItem("Facebook", src = "https://www.facebook.com/guilherme.viegas.90"),
argonFooterItem("Instagram", src = "https://demos.creative-tim.com/argon-design-system/index.html")
)
)
)
server <- function(input, output) {
# observeEvent(input$my_sidebar, {
# if (input$my_sidebar != "sobre") {
# updateTabItems(session, inputId = "tabs", selected = "quiz")
# }
# })
callModule(mod_home_server, "home_ui_1")
callModule(mod_stats_server, "stats_ui_1")
callModule(mod_prob_server, "prob_ui_1")
callModule(mod_stat_econ_server, "stat_econ_ui_1")
callModule(mod_econometria_server, "econometria_ui_1")
callModule(mod_ML_server, "ML_ui_1")
callModule(mod_quiz_server, "quiz_ui_1")
callModule(mod_sobre_server, "sobre_ui_1")
}
shinyApp(ui = ui, server = server)
Although It works locally, when I deploy it, It simple doesnt work online. In other words, it works fine locally, but when deplyed it simple doesnt change the tabs. Weird right?
I have found the answer. As for October 2019, the CRAN package version does not allow change of tabs (It's a bug). This error was corrected in their Github package version, and soon will be on CRAN as well. It's just a bug, happens...
you can use modules like this!
I suppose global.R and app.R are in the same directory.
global.R
library(shiny)
library(argonR)
library(argonDash)
app.R
source(file.path("global.R"), local = TRUE)$value
shiny::shinyApp(
ui = argonDashPage(
title = "Argon App",
description = "Your description",
author = "You",
navbar = argonDashNavbar(),
sidebar = argonDashSidebar(
id = "sidebar",
side = "left",
size = "md",
skin = "light",
background = "white",
argonSidebarMenu(
argonSidebarItem(
tabName = "Tab1",
icon = argonIcon(name = "circle-08", color = "success"),
"Tab 1"
),
argonSidebarItem(
tabName = "Tab2",
icon = argonIcon(name = "atom", color = "success"),
"Tab 2"
)
)
),
header = argonDashHeader(),
body = argonDashBody(
argonTabItems(
argonTabItem(
tabName = "Tab1",
argonCard(
status = "primary",
width = 12,
title = "Card 1",
hover_lift = TRUE,
shadow = TRUE,
icon = argonIcon("check-bold"),
src = "#",
"Argon is a great free UI package based on Bootstrap 4
that includes the most important components and features."
)
),
argonTabItem(
tabName = "Tab2",
argonBadge(
text = "My badge",
src = "https://www.google.com",
pill = FALSE,
status = "success"
)
)
)
),
footer = argonDashFooter(copyrights = "Yourself")
),
server = function(input, output, session) {
}
)
The strategy has been fully inspired from https://github.com/daattali/advanced-shiny/tree/master/split-code

How to resize a datatable in order to fit it in a box() for shinyDashboard

I don't know how to make sure the size of my DT::renderDataTable fit in my box.
Here is a picture of my Shiny Render
Does anybody know how to make sure the table fit in the box ? Or can I add a slider under the table to scroll around other variables that are not on the screen ?
Here is my code:
server.R
output$table = DT::renderDataTable({
DT::datatable(
round(df,2),
rownames = TRUE,
extensions = 'Buttons',
options = list(
autoWidth = FALSE,
columnDefs = list(list(width = "125px", targets = "_all")),
dom = 'tpB',
lengthMenu = list(c(5, 15, -1), c('5', '15', 'All')),
pageLength = 15,
buttons = list(
list(
extend = "collection",
text = 'Show More',
action = DT::JS("function ( e, dt, node, config ) {
dt.page.len(50);
dt.ajax.reload();}")
),list(
extend = "collection",
text = 'Show Less',
action = DT::JS("function ( e, dt, node, config ) {
dt.page.len(10);
dt.ajax.reload();}")
)
)
)
)
})
body.R
box( title = "A little taste of the dataset",
width = 12,
DT::dataTableOutput("table") )
You can simply add scrollX = TRUE to the datatable options:
library(shiny)
library(shinydashboard)
DF <- data.frame(replicate(50, runif(1000, 0, 10)))
ui <- fluidPage(box(
title = "A little taste of the dataset",
width = 12,
DT::dataTableOutput("myTable")
))
server <- function(input, output, session) {
output$myTable = DT::renderDataTable({
DT::datatable(
round(DF, 2),
rownames = TRUE,
extensions = 'Buttons',
options = list(
autoWidth = FALSE, scrollX = TRUE,
columnDefs = list(list(
width = "125px", targets = "_all"
)),
dom = 'tpB',
lengthMenu = list(c(5, 15,-1), c('5', '15', 'All')),
pageLength = 15,
buttons = list(
list(
extend = "collection",
text = 'Show More',
action = DT::JS(
"function ( e, dt, node, config ) {
dt.page.len(50);
dt.ajax.reload();}"
)
),
list(
extend = "collection",
text = 'Show Less',
action = DT::JS(
"function ( e, dt, node, config ) {
dt.page.len(10);
dt.ajax.reload();}"
)
)
)
)
)
})
}
shinyApp(ui = ui, server = server)

Delaying and expiring a shinyBS::bsTooltip

Is it possible to delay a tooltip and expire after a few seconds?
require(shiny)
require(shinyBS)
shinyApp(ui = fluidPage(
shinyjs::useShinyjs(),
bsTooltip(id = 'input', title = "Lets delay this appearing for 1s and force disappear after 5s",
placement = "bottom", trigger = "hover", options = list(delay = list(show=1000, hide=3000))),
sidebarLayout(
sidebarPanel(
selectInput(inputId = 'input', label = 'input', choices = c('cats','dogs'))
),
mainPanel()
)
)
, server = function(input, output){})
shinyBS::bsTooltip fails to properly serialize nested options lists in https://github.com/ebailey78/shinyBS/blob/shinyBS3/R/Tooltips_and_Popovers.R#L129
The options object ends up looking like { delay: "list(show = 1000, hide = 3000)" }
Unfortunately it looks like shinyBS isn't maintained anymore, or a fix would be worth submitting.
I'll suggest a workaround - using shinyBS::addTooltip which does serialize options correctly.
require(shiny)
require(shinyBS)
shinyApp(
ui = fluidPage(
# shinyjs::useShinyjs(),
shinyBS:::shinyBSDep,
sidebarLayout(
sidebarPanel(
selectInput(inputId = 'input', label = 'input', choices = c('cats','dogs'))
),
mainPanel()
)
),
server = function(input, output, session) {
addTooltip(session, id = 'input', title = "Lets delay this appearing for 1s and force disappear after 5s",
placement = "bottom", trigger = "hover", options = list(delay = list(show=1000, hide=3000)))
}
)
Or just using Bootstrap directly.
I used tipify. So my code was like:
tipify(
element,
title = "some title",
options = list("delay" = 1000)
)
Problem was: delay has do be numeric but the function createTooltipOrPopoverOnUI (https://github.com/ebailey78/shinyBS/blob/shinyBS3/R/Tooltips_and_Popovers.R) will put quotesigns arround all arguments:
options = paste0("{'", paste(names(options), options, sep = "': '", collapse = "', '"), "'}")
So i did this: im not proud of it but it worked:
options = list("delay': 1000, 'it" = "sucks")

Resources