Hi,
I need to put a logo in this red place, I already tried:
cabecalho <- dashboardHeader(title = "Test", titleWidth = '300px')
cabecalho$children[[2]]$children <- tags$a(href='http://mycompanyishere.com',
tags$img(src='logo.png',height='50',width='100'))
But this gave me the image inside the "Test" title.
I solved this problem just adding this to dashboardHeader:
dashboardHeader(title = "Report", titleWidth = '240px',
tags$li(a(href = 'http://www.site.com.br',
img(src = 'logo.png',
title = "Company Home", height = "30px"),
style = "padding-top:10px; padding-bottom:10px; padding-right:17px;"),
class = "dropdown")
)
Related
I have created a small dashboard using bscols( from the crosstalkpackage. It consists of plotly graphs and their respective filter_checkboxes.
It looks pretty messy now, as the filters are not vertically aligned with their corresponding plots.
HTML_graphic
As indicated, I would like the first two checkbox sets to appear next to the second line graph (nothing to appear next to the first line graph); and the second two checkbox sets to appear next to the third line graph.
Also, I would like to create some vertical space between the three elements, as indicated by the brown and black horizontal lines.
The best solution would be to set the height of the html elements inside the bscols() command. Because in the future, I would like to programmatically save multiple of these outputs using htmltools::save_html.
The next best would be to have the output of that command somehow converted to html and add html code like line breaks or heights.
Neither I know how to do.
I came across this related question but it is unanswered: Arrange crosstalk graphs via bscols
Any suggestions on how to solve my problem?
My code
{r 002_Auto App Doc Vol_Invoice group delta plot - plot code, echo = FALSE}
# Setup of the legend for invoice plot
invoice_plot_legend <- list(
font = list(
family = "sans-serif",
size = 12,
color = "#000"),
title = list(text="<b> Delta previous month by division </b>"),
bgcolor = "#E2E2E2",
bordercolor = "#FFFFFF",
borderwidth = 2,
layout.legend = "constant",
traceorder = "grouped")
# The Shared Data format is needed for crosstalk to be able to filter the dataset upon clicking the checkboxes (division filters):
shared_invoice <- SharedData$new(Auto_App_Doc_Vol_invoiceg_plotting_tibble)
shared_invoice_KPI <- SharedData$new(Auto_App_Doc_Vol_KPI)
shared_abs <- SharedData$new(Auto_App_Doc_Vol_plotting_tibble_diff_abs)
# Setup of a bscols html widget; widths determines the widths of the input lists (here, 2: the filters, 10: the plot and legend)
# Overall KPI and invoice group plot
library(htmlwidgets)
crosstalk::bscols(
widths = c(2, 10),
list(
crosstalk::filter_checkbox("Division",
label = "Division",
sharedData = shared_invoice,
group = ~Division),
crosstalk::filter_checkbox("Rechnungsgruppe",
label = "Invoice group",
sharedData = shared_invoice,
group = ~Rechnungsgruppe),
crosstalk::filter_checkbox("Rechnungsgruppe",
label = "Invoice group",
sharedData = shared_abs,
group = ~Rechnungsgruppe),
crosstalk::filter_checkbox("Division",
label = "Division",
sharedData = shared_abs,
group = ~Division)
)
,
list(
plot_ly(data = shared_invoice_KPI, x = ~Freigabedatum_REAL_YM, y = ~KPI_current_month, meta = ~Division,
type = "scatter",
mode = "lines+text",
text = ~KPI_current_month,
textposition='top center',
hovertemplate = "%{meta}",
color = ~Diff_KPI_pp)
%>%
layout(legend = invoice_plot_legend,
title = "Automatically Approved Document Volume",
xaxis = list(title = 'Release date'),
yaxis = list(title = '%'))
,
plot_ly(data = shared_invoice, x = ~Freigabedatum_REAL_YM, y = ~n,
type = "scatter",
mode = "lines",
text = ~Rechnungsgruppe_effort,
hoverinfo = "y+text",
color = ~Difference_inline
)
%>%
layout(legend = invoice_plot_legend,
title = " ",
xaxis = list(title = 'Release date'),
yaxis = list(title = '# of Approved Documents'))
,
plot_ly(data = shared_abs, x = ~Freigabedatum_REAL_YM, y = ~n,
type = "scatter",
mode = "lines",
text = ~Lieferantenname,
hoverinfo = "y+text",
color = ~Lieferantenname_text
)
%>%
layout(legend = vendor_plot_legend,
title = "by vendor absolute delta previous month all documents",
xaxis = list(title = 'Release date'),
yaxis = list(title = '# of Approved Documents w/ & w/o effort')
)
)
)
Thank you so much!
Please help check this issue and recommend any library to make it work. I have used showtext library but not help.
Sample Data & Code
category_name total_readers
មនោសញ្ចេតនា 267867
ស្នេហា 239880
ព្រឺព្រួច 222031
អាថ៌កំបាំង 127858
គុននិយម 101888
df %>%
ggplot(aes(area = total_readers, fill = category_name, label = category_name)) +
geom_treemap() + theme(legend.position = "bottom", ) +
geom_treemap_text(fontface = "italic", colour = "white", place = "centre", grow = FALSE)
I'm developing a shiny app and I want to add an "infobox" next to a selectInput(). Basically I want to add a small "info" icon to the selectInput() label and when a user move the mouse hover the info icon, a box with some text appears. I've found here on stackedoverflow a solution with tags$span and tags$i and if I add only text it works fine, but if I want to add an html link, or simply another tags (like tags$strong), it doesn't work. Here a reproducible example.
library(shiny)
shinyApp(
ui = fluidPage(
br(),
selectInput("works",
label = tags$span(
"This works",
tags$i(
class = "glyphicon glyphicon-info-sign",
style = "color:#0072B2;",
title = "Further information "
)),
choices = c("a","b")),
selectInput("notwork",
label = tags$span(
"This not works",
tags$i(
class = "glyphicon glyphicon-info-sign",
style = "color:#0072B2;",
title = list("Further information ",
tags$a(href = "https://www.google.com", "here", .noWS = "after"))
)),
choices = c("a","b")),
selectInput("notwork2",
label = tags$span(
"Neither this",
tags$i(
class = "glyphicon glyphicon-info-sign",
style = "color:#0072B2;",
title = p("Further information ",
strong("here"))
)),
choices = c("a","b")),
),
server = function(input, output) {
}
)
It looks I can't pass any other html tags to that value.
You try to put HTML in a normal HTML title attribute, which is never supported. what you need is some sort of Tooltip. You can use bsButton in combination with bsPopover from the ShinyBS package. I did not bother for the styling, but I am pretty sure you can get it done from here.
library(shiny)
library(ShinyBS)
shinyApp(
ui = fluidPage(
br(),
selectInput("works",
label = tags$span(
"This works",
tags$i(
class = "glyphicon glyphicon-info-sign",
style = "color:#0072B2;",
title = "Further information "
)),
choices = c("a","b")),
selectInput("worksnow",
label = tags$span("This works now too", bsButton("thisworks", label = "", icon = icon("info"), style = "info", size = "extra-small")),
choices = c("a","b")
),
bsPopover(
id = "thisworks",
title = "More information",
content = paste0(
"Any HTML can be here ",
a("ShinyBS", href = "https://ebailey78.github.io/shinyBS/index.html", target="_blank")
),
placement = "right",
trigger = "hover",
options = list(container = "body")
)
),
server = function(input, output) {
}
)
I am trying to add a loess curve to a bar plot.
After loading the ggplots2 package, I first create the bar plot:
test<-read.csv("tseries.csv", header = TRUE)
barplot(test$tn90p, beside = TRUE,ylim =c(-6,6))
lo<-loess(tn10p~year, test) pred<-predict(lo, se = TRUE)
a<-order(test$year)
So far so good, until I try to add the smoothed curve:
lines(test$year[a], pred$fit[a], col = "red", lwd = 2)
When I do that, no error message, the prompt comes back, but no line is added.
What am I missing?
Thanks for your help.
Note: when I dput(test), I have this:
structure(list(year = 1951:1980, tn90p = c(3.126667391, 4.091391006,
3.11420404, 5.117428018, 2.281128013, 2.654342884, 4.189742845,
-0.448909654, 1.634574903, -1.324893538, -0.675205784, -1.876889174,
-2.689793785, 0.364812684, -1.859920287, -1.736813462, -1.527857975,
-3.214404324, -4.189742845, 0.448909654, -1.634574903, 1.324893538,
0.675205784, 1.876889174, -0.436873606, -4.45620369, -1.254283753,
-3.380614556, -0.753270038, 0.560061439)), .Names = c("year",
"tn90p"), class = "data.frame", row.names = c(NA, -30L))
Finally I could make it work:
test<-read.csv("tseries.csv", header = TRUE)
attach(test)
p = barplot(test$tn90p, names.arg=test$year, beside = TRUE, ylim =c(-6,6))
lo<-loess(tn90p~year)
lines(p, predict(lo), col="red", lwd=3)
abline (h=0, lwd=1)
In my shiny app I want to add an option to let users jump to a specific element in the app (a table, a plot, just anything with an id), on current or different tab, by clicking on infoBox (or any other object I want).
My solution was to surround infoBox with div and add thehref=#id_of_element attribute. Unfortunately this solution works only for tabs with an extra "data-toggle" = "tab" attribute (it also does not change the opened tab to active), but that's not what I want.
My question is: how can I add the mentioned option and why this solution isn't working? Here is a small example what I want to do:
UI
library(shiny)
library(shinydashboard)
shinyUI(
dashboardPage(
skin = "blue",
dashboardHeader(title = "Example"),
dashboardSidebar(
sidebarMenu(id = "sidebarmenu",
menuItem("Tab1", icon = icon("line-chart"),
menuSubItem("SubTab1", tabName = "sub1", icon = icon("bar-chart")),
menuSubItem("SubTab2", tabName = "sub2", icon = icon("database"))),
menuItem("Tab2", tabName = "tab2", icon = icon("users"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "sub1",
tags$div(href="#s2t2",
infoBox(value = "Go to table 2 in SubTab2 (not working)",title = "Click me")),
tags$div(href="#shiny-tab-tab2", "data-toggle" = "tab",
infoBox(value = "Go to Tab2 (this works)",title = "Click me"))
),
tabItem(tabName = "sub2",
tableOutput("s2t1"),
tableOutput("s2t2")
),
tabItem(tabName = "tab2",
tableOutput("t2t1"),
tableOutput("t2t2")
)
)
)
)
)
SERVER:
shinyServer(function(input, output,session) {
output$s2t1<- renderTable(mtcars)
output$s2t2<- renderTable(mtcars)
output$t2t1<- renderTable(mtcars)
output$t2t2<- renderTable(mtcars)
} )
I found my answer:
$(document).ready(function() {
$("#div1").click(function() {
$(".sidebar-menu a[href=\'#shiny-tab-tab2\']").tab("show");
setTimeout(function(){
var top = $("#t2t2").position().top;
$(window).scrollTop( top );
}, 300);
});
});
where div1 is div around infoBox