R Leaflet - How to combine text and figure in popup? - html

I would like to combine text and a figure in a Leaflet Popup. I saw this on a website of Deutsche Bahn: Multi-Object-Popup
Website:
strecken.info
For me it would be sufficient to combine two of these 4 shown "windows" -> One text (paste0()) and one ggplot-figure). Is this possible in R?
Best regards and thank you very much :)
My Code so far:
ll_maps %>%
addCircles(
data = df_temp,
lng = ~x_coord,
lat = ~y_coord,
weight = 1,
radius = 1000,
popup = ~lapply(leafpop::popupGraph(pic_list_temp, width = 500, height = 500), HTML),
label = ~lapply(paste0("<br><b>Textline1</b> = ", tl1_object,
"<br><b>Textline2</b> = ", tl2_object), HTML),
popupOptions = popupOptions(maxWidth = 500),
labelOptions = labelOptions(textsize = "12px"),
opacity = 1,
fillOpacity = 0.5,
color = "red")
Now I would like to combine the label and the popup into one popup so to speak :)

Related

Is it possible to arrange graphs and filters in an R plot output?

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!

Plotly, Changing the hover text

I am trying to change the hover text in plotly.
As an example there is
import plotly.graph_objects as go
fig = go.Figure(go.Scatter(
x = [1,2,3,4,5],
y = [2.02825,1.63728,6.83839,4.8485,4.73463],
hovertemplate =
'<i>Price</i>: $%{y:.2f}'+
'<br><b>X</b>: %{x}<br>'+
'<b>%{text}</b>',
text = ['Custom text {}'.format(i + 1) for i in range(5)],
showlegend = False))
fig.add_trace(go.Scatter(
x = [1,2,3,4,5],
y = [3.02825,2.63728,4.83839,3.8485,1.73463],
hovertemplate = 'Price: %{y:$.2f}<extra></extra>',
showlegend = False))
fig.update_layout(
hoverlabel_align = 'right',
title = "Set hover text with hovertemplate")
fig.show()
Can you see the part in blue where it says "trace 0". Where does that come from?
If you hover in the red curve you will notice that something similar does not appear.
I want to reproduce this, so I want to understand where that is coming from
You can enable/disable the trace0, trace1,... text for each set of points by removing/adding the <extra></extra> tag. The documentation for hover text customization can be found here.
To make trace1 appear on your second set of points, remove the <extra></extra> tag.
import plotly.graph_objects as go
fig = go.Figure(go.Scatter(
x = [1,2,3,4,5],
y = [2.02825,1.63728,6.83839,4.8485,4.73463],
hovertemplate =
'<i>Price</i>: $%{y:.2f}'+
'<br><b>X</b>: %{x}<br>'+
'<b>%{text}</b>',
text = ['Custom text {}'.format(i + 1) for i in range(5)],
showlegend = False))
## Remove the extra tag
fig.add_trace(go.Scatter(
x = [1,2,3,4,5],
y = [3.02825,2.63728,4.83839,3.8485,1.73463],
hovertemplate = 'Price: %{y:$.2f}',
showlegend = False))
fig.update_layout(
hoverlabel_align = 'right',
title = "Set hover text with hovertemplate")
fig.show()

How to effectively adjust graph margin or padding in dash plotly

I have plotted two graphs using plotly dash. But when the y-axis / x-axis tick size is more it gets cut off.
Y-axis :
Code :
data = [go.Scatter(x = df[df['S2PName-Category']==category]['S2BillDate'],
y = df[df['S2PName-Category']==category]['totSale'],
mode = 'markers+lines',
name = category) for category in df['S2PName-Category'].unique()]
layout = go.Layout(title='Category Trend',
xaxis = dict(title = 'Time Frame', tickformat = '%d-%b-%y'),
yaxis = dict(tickprefix= '₹', tickformat=',.2f',type='log'),
hovermode = 'closest',
plot_bgcolor = colors['background'],
paper_bgcolor = colors['background'],
font = dict(color = colors['text'])
)
X-Axis :
Code :
data = [go.Scatter(x = df[df['S2PName']==item]['S2BillDate'],
y = df[df['S2PName']==item]['totSale'],
mode = 'markers+lines',
name = item) for item in items]
layout = go.Layout(title='Category Trend',
xaxis = dict(title = 'Time Frame' , tickformat = '%d-%b'),
yaxis = dict(tickprefix= '₹', tickformat=',.2f',type='log',autorange = True),
hovermode = 'closest',
plot_bgcolor = colors['background'],
paper_bgcolor = colors['background'],
font = dict(color = colors['text'])
)
In the above 2 graphs , as the length of the tick value increases, it gets cut off . Is there a better way to handle this ?
Credit for #Flavia Giammarino in comments for the reference to the docs. I'm posting the answer for completeness.
https://plotly.com/python/setting-graph-size/
From that link the example below shows how to set margin:
fig.update_layout(
margin=dict(l=20, r=20, t=20, b=20),
)
Where l r t b correspond to left, right, top, bottom.
I had a similar problem with some Dash/Plotly charts and long y axis labels being truncated or hidden. There didn't seem to be much information or documentation on this issue, so it took a while to solve.
Solution: add this code to the layout settings to prevent truncation of the y axes labels:
fig.update_layout(
yaxis=dict(
automargin=True
)
)
or you can update the yaxes setting specifically:
fig.update_yaxes(automargin=True)
Update: I tried another version of Plotly (5.10 or above) which mentions setting the automargin setting to any combination of automargin=['left+top+right+bottom'] with similar results. This still seems a bit unstable and doesn't solve all possible scenarios or corner cases, but works fine in most cases, especially when the browser window is maximized.

Overwrite colorbar labels Bokeh

I tried to overwrite the colorbar labels, though I can not get it done, if someone could find out what is wrong in the code and let me know, it would be very appreciate. I can share the data if necessary. I also would like to know if it is possible to use widgets SELECT to select which county and hide the others, as callback.
Regards
palleteG = ['#39FF14', '#4CBB17', '#50C878', '#00A572','#2E8B57', '#0b6623'] #'#98FB98','#ffffff','#D0F0C0'
#color_mapper = LinearColorMapper(palette = palleteG, low = 25000, high = 450000)
color_mapper = LinearColorMapper(palette = palleteG, low = irl['2016'].min()*1.01, high = irl['2016'].max()*1.01)
color_bar = ColorBar(color_mapper=color_mapper, label_standoff=6,
width=500, height=20, border_line_color=None,
location='center', orientation='horizontal',
major_label_overrides=tick_labels,
bar_line_color='#50C878',
bar_line_alpha=0.7)
ps = figure(title = 'Irish Housing Stock 2016', tools = 'pan, wheel_zoom, box_zoom, reset, hover, save',
tooltips = [('County', '#COUNTY'),('Housing Stock','#2016'), ('Population','#Population'),
('Number of Social Housing necessary','#Solution')], #,],
x_axis_location = None, y_axis_location = None, plot_width=600, plot_height=800)
ps.patches('xs', 'ys', fill_alpha = 0.7, fill_color = {'field':'2016', 'transform':color_mapper}, line_color = 'black', line_width = 0.5,
source = geo_source) # fill_color = 'green'
ps.grid.grid_line_color=None
ps.add_layout(color_bar, 'below')
show(ps)
output_file('IHS.html', mode='inline')
The challenge now it's find the right tune for the bar.

Plot colours in HTML differ from within RStudio after knit

I am trying to generate a shareable HTML document generated from an R Script in RStudio.
The script makes use of interactive plots generated from networkD3 and collapsibleTree packages. In the RStudio viewer, the colour scheme for these plots is highly visible; colours such as blue and red for the items.
However, when rendered in HTML, the colour scheme becomes a washed out grey: practically white on white background, which makes it too hard to see or use.
Can I specify plot colours in the RScript using a knitr passthrough, I don't know, something like:
#+ colourscheme(RdBu)
or do I need to generate some kind of CSS file to control plot colours? I am unclear and not very knowledgeable in this HTML area, and a little confused why the colours would change at all!
Thanks in advance for any help.
-- edit (example provided)
In response to the request below, I've generated a tiny example. However (!) when this is rendered, it retains the correct colour scheme. I'm unclear now what it is causing this; colours are linked to "gp" in my main diagram, and I have only 3 groups so should see 3 colours. I'm not able to provide a full example due to size (data limitations), so here's the outline:
nodes <- data.frame(Name = c('Alpha', 'Beta', 'Charlie'),
ID = c(0,1,2),
gp = c(1,1,2),
n = c(10,15,20))
links <- data.frame(x = c(0, 0, 0, 1, 1, 2, 2),
y = c(0, 1, 2, 1, 2, 0, 2),
n = c(8, 9, 8, 9, 8, 9, 8))
require(networkD3)
require(RColorBrewer)
forceNetwork(height = 200, width = 400,
Links = links, Nodes = nodes,
Source = "x", Target = "y", Value = "n", # From Links df
NodeID = "Name", Group = "gp", Nodesize = "n", # From Nodes df
arrows = T,
linkWidth = JS("function(d) { return Math.sqrt(d.value); }"),
#linkWidth = JS(" d.value"),
radiusCalculation = JS(" d.nodesize"),
charge = -10,
fontSize = 16,
colourScale = JS("d3.scaleOrdinal(d3.schemeCategory10);"),
opacity = 0.9,
bounded = T)
I'm guessing (?) that there's a certain set of conditions that triggers the colours to fail.
I'm pretty sure this happens because collapsibleTree is adding CSS that affects the elements created by forceNetwork. Can you try putting this minimal example in a .Rmd file and knit it to see if shows a similar problem...
---
output: html_document
---
```{r echo=FALSE}
nodes <- data.frame(NodeID = c("Alpha", "Beta", "Charlie"),
Group = c(1, 2, 3),
Nodesize = c(10, 15, 20))
links <- data.frame(Source = c(0, 0, 1, 2),
Target = c(1, 2, 2, 0),
Value = c(9, 8, 8, 9))
library(networkD3)
forceNetwork(Links = links, Nodes = nodes,
Source = "Source", Target = "Target", Value = "Value",
NodeID = "NodeID", Group = "Group", Nodesize = "Nodesize",
colourScale = JS("d3.scaleOrdinal(d3.schemeCategory10);"),
width = 100, height = 100)
```
```{r echo=FALSE}
library(collapsibleTree)
collapsibleTree(warpbreaks, c("wool", "tension", "breaks"),
width = 100, height = 100)
```
if so, try installing the dev version of collapsibleTree with devtools::install_github('AdeelK93/collapsibleTree') and then try it again and see if the problem goes away (and your other problem). They added namespaced css in this commit which hasn't made it into a CRAN release yet.