Is there any way to customize legend histogram using tm_layout - r

Please see the map I drew below using the tmap package. I did not any find parameters that I can use to customize the font of the histogram legend. From the code below, you can see that I've already set the legend.text.fontface = 'bold'. However, this did not work.
psp1 <- tm_shape(province) +
tm_borders(col = 'black') +
tm_shape(county) +
tm_polygons(col = '+1 °C', title = 'Changes in %', style = 'pretty', aes.palette = 'div', n=5, legend.hist = T) +
tm_compass(north = 0, type = 'arrow', show.labels =0, position = c('right','top')) +
tm_layout(legend.format = list(fun = function(x) formatC(x, digits = 1, format = "f")),
legend.outside = T, legend.outside.position = 'bottom',
legend.hist.width = 1,
legend.hist.height = 0.5,
legend.stack = 'horizontal',
legend.title.fontface = 'bold',
legend.text.fontface = 'bold')

Very interesting question. Indeed, it does not seem possible to change the font of the labels for the histogram using legend.text.fontface = 'bold'
Hopefully, it is possible to change this using the base R library grid on which the tmap library is based on.
So, please find below one possible solution to your request (hoping that this answer does not come too late and that it will still be useful to you)
Preliminary note for other Stackoverflow users: to run the reprex below correctly you will need to first download the data made available by the OP in this post.
Reprex
STEP 1 - BUILDING THE MAP WITH THE LEGEND
library(sf)
library(tmap)
library(RColorBrewer)
setwd("Add the path to your working directory")
# Import data
province <- st_read("province.shp")
county <- st_read("county.shp")
# Split the 'sf' object 'county' into a list of five 'sf' objects
county_warm_list <- split(county , f = county$warming)
# Build the map with the legend
psp1 <- tm_shape(province) +
tm_borders(col = 'black') +
tm_shape(st_sf(county_warm_list[[3]])) + # using the scenario +3°C
tm_polygons(col = 'estimate',
title = 'Changes in %',
style = 'pretty',
aes.palette = 'div',
n=5,
legend.hist = TRUE,
midpoint = 0) +
tm_compass(north = 0,
type = 'arrow',
show.labels =0,
position = c('right','top')) +
tm_layout(legend.show = TRUE,
legend.format = list(fun = function(x) formatC(x, digits = 1, format = "f")),
legend.outside = TRUE,
legend.outside.position = 'bottom',
legend.hist.width = 1,
legend.hist.height = 0.5,
legend.stack = 'horizontal',
legend.title.fontface = 'bold',
legend.text.fontface = 'bold')
STEP 2 - BOLD ALL THE LABELS IN THE LEGEND (i.e. including those in the histogram)
library(grid)
# Convert the 'tmap' object psp1 into a 'grob' object ('grob' = 'grid graphical object')
psp1 <- tmap_grob(psp1)
# Find the name of the element we want to change using 'grid.list()' which
# returns a listing of 'grobs' (including gTree)
grid.ls(psp1)
#> GRID.gTree.41
#> multiple_1
#> BG
#> mapBG
#> mapElements
#> GRID.gTree.11
#> tm_polygons_1_2
#> GRID.gTree.12
#> tm_polygons_1_3
#> GRID.rect.13
#> meta_with_bg
#> meta
#> GRID.gTree.16
#> GRID.gTree.15
#> compass
#> GRID.polygon.14
#> outside_legend !!!! "outside_legend" element !!!!
#> meta_with_bg
#> meta
#> legend
#> GRID.rect.39
#> GRID.gTree.40
#> GRID.gTree.19
#> GRID.gTree.18
#> GRID.text.17
#> GRID.gTree.23
#> GRID.gTree.22
#> GRID.rect.20
#> GRID.text.21
#> GRID.gTree.38
#> GRID.gTree.37
#> GRID.gTree.36
#> GRID.gTree.25
#> GRID.rect.24
#> GRID.gTree.27
#> GRID.polyline.26
#> GRID.gTree.29
#> GRID.text.28
#> GRID.gTree.33
#> GRID.gTree.30
#> GRID.lines.31
#> GRID.polyline.32
#> GRID.gTree.35
#> GRID.text.34
In the listing of grob objects just above, you can see an element named "outside_legend". So, we will modify it to bold the fonts of the legend:
# Edit the 'outside_legend' element of the 'grob' object 'psp1' using
# 'editGrob()' and save it in the new 'grob' object 'my_map'
my_map <- editGrob(psp1, gPath("outside_legend"), gp = gpar(fontface = "bold"))
# Draw the 'grob' object 'my_map'
# !!!! NB: may take a few seconds to be displayed in the graphic device !!!!
grid.draw(my_map)
STEP 3 - SAVING THE MAP EITHER MANUALLY OR PROGRAMMATICALLY
(in the latter case, you need to install the rstudioapi library)
rstudioapi::savePlotAsImage(
"my_map.png", # add the path if different of the working directory
format = "png", # other possible formats: "jpeg", "bmp", "tiff", "emf", "svg", "eps"
width = 670,
height = 710
)
And that's it :-)
Created on 2022-01-30 by the reprex package (v2.0.1)

Related

How to add polygon to 3D Map in r rayshader?

I am new to geo spatial data and just manage to plot in small bits & pieces by looking at few articles on web.
I am trying to plot polygon boundaries on the 3D plot which I have built using rayshader package but facing issues with displaying polygon boundaries on top.
Shape file used is 2011_Dist.shp which can be downloaded from Shapefile Github link
Code I have tried:
library(tidyverse)
library(sf)
library(elevatr)
library(raster)
library(rayshader)
library(osmdata)
# read districts shape file
ind_distirct_shp <- sf::st_read("local path/2011_Dist.shp")
ind_distirct_shp
# filter State
delhi_district_shp <- ind_distirct_shp %>%
sf::st_as_sf() %>%
filter(ST_NM %in% c("NCT of Delhi"))
# this shows the polygon boundaries that I need on top of map
plot(delhi_district_shp)
# download elevation data for State Delhi
delhi_raster <- elevatr::get_elev_raster(delhi_district_shp, z = 10, clip = "location")
# convert to matrix
delhi_mat <- raster_to_matrix(delhi_raster)
# 3D plot using Rayshader
delhi_mat %>%
height_shade(texture = grDevices::colorRampPalette(c("#9a133d","orange","red","purple"
))(256)) %>%
plot_3d(heightmap = delhi_mat,
windowsize = c(800,800), # c(800*wr,800*hr)
solid = FALSE,
zscale = 1,
phi = 90,
zoom = .6,
theta = 0,
shadowcolor = "grey50",
linewidth = 6,
background = "white",
solidlinecolor = "#013b39")
Issue: Now when I try to Modify this to add polygon lines it doesn't work.
polygon_layer = generate_polygon_overlay(delhi_district_shp, extent = extent(delhi_raster),
heightmap = delhi_mat) # , palette="grey30"
polygon_layer
delhi_mat %>%
height_shade(texture = grDevices::colorRampPalette(c("#9a133d","orange","red","purple"
))(256)) %>%
add_overlay(polygon_layer) %>%
plot_3d(heightmap = delhi_mat,
windowsize = c(800,800), # c(800*wr,800*hr)
solid = FALSE,
zscale = 1,
phi = 90,
zoom = .6,
theta = 0,
shadowcolor = "grey50",
linewidth = 6,
background = "white",
solidlinecolor = "#013b39")
It should have been polygon lines on top of the Orange 3D map but it didn't work as I expected.
I also tried with Rayshder's tyler website example https://www.tylermw.com/adding-open-street-map-data-to-rayshader-maps-in-r/
library(osmdata)
osm_bbox = c(extent(delhi_raster)[3],extent(delhi_raster)[1],extent(delhi_raster)[4],extent(delhi_raster)[2])
osm_bbox
raster_polygon_boundary <- osmdata::opq(osm_bbox) %>%
add_osm_feature("highway") %>% # "admin_level"
osmdata_sf()
raster_polygon_boundary
Output:
Object of class 'osmdata' with:
$bbox : 76.8425681832661,28.4030759258059,77.347719586084,28.8793200072187
$overpass_call : The call submitted to the overpass API
$meta : metadata including timestamp and version numbers
$osm_points : 'sf' Simple Features Collection with 0 points
$osm_lines : NULL
$osm_polygons : 'sf' Simple Features Collection with 0 polygons
$osm_multilines : NULL
$osm_multipolygons : NULL
I am getting 0 polygons & lines above so I wont't be able to add any polygon on top of 3D plot.
How can I fix this. Appreciate any help.
Adding alphalayer to add_overlay(polygon_layer,alphalayer = .6) helped even though it worked but still transparency is not working perfectly. It is causing some whiteness in the plot. If anyone else has better answer or way to improve it then please feel free to share.
delhi_mat %>%
height_shade(texture = grDevices::colorRampPalette(c("#9a133d","orange","red","purple"
))(256)) %>%
add_overlay(polygon_layer,alphalayer = .6) %>%
add_overlay(generate_label_overlay(delhi_district_shp, extent = extent(delhi_raster),
text_size = 5, point_size = 1,
halo_color = "white",halo_expand = 5,
seed=1,
heightmap = delhi_mat, data_label_column = "DISTRICT")) %>%
plot_3d(heightmap = delhi_mat,
windowsize = c(800,800), # c(800*wr,800*hr)
solid = FALSE,
zscale = .7,
phi = 90,
zoom = .6,
theta = 0,
shadowcolor = "grey50",
linewidth = 6,
background = "white",
solidlinecolor = "#013b39")

Seeking help to generate a similar heatmap as attached

I am trying to generate a heatmap as the following figure. I have already tried pheatmap and the code is as follows:
breaks_2 <- seq(min(0), max(2), by = 0.1)
pheatmap::pheatmap(
mat = data,
cluster_cols = F,
cluster_rows = F,
scale = "column",
border_color = "white",
color = inferno(20),
show_colnames = TRUE,
show_rownames = FALSE,
breaks = breaks_2
)
But this does not seem to work. So far I am understanding I am mistaking with defining break or have to use another package than pheatmap. Any suggestion will be really helpful.
The color scale in pheatmap adjusts to the range of the input data. If you want anything above a certain value to be coloured daffodil, then simply send pheatmap a copy of your data with the highest values rounded to 2.
Suppose you have a data frame like this, with values anywhere between 0 and 3:
set.seed(1)
data <- as.data.frame(matrix(runif(64, 0, 3), nrow = 8))
names(data) <- LETTERS[1:8]
data
#> A B C D E F G H
#> 1 0.7965260 1.8873421 2.1528555 0.801662 1.4806239 2.46283888 2.1969412 0.9488151
#> 2 1.1163717 0.1853588 2.9757183 1.158342 0.5586528 1.94118058 2.0781947 1.5559028
#> 3 1.7185601 0.6179237 1.1401055 0.040171 2.4821200 2.34879829 1.4328589 1.9860152
#> 4 2.7246234 0.5296703 2.3323357 1.147164 2.0054002 1.65910893 2.5836284 1.2204906
#> 5 0.6050458 2.0610685 2.8041157 2.609073 2.3827196 1.58915874 1.3142913 2.7386278
#> 6 2.6951691 1.1523112 0.6364276 1.021047 0.3238309 2.36806870 0.7343918 0.8808101
#> 7 2.8340258 2.3095243 1.9550213 1.446240 2.1711328 0.06999361 0.2120371 1.3771972
#> 8 1.9823934 1.4930977 0.3766653 1.798697 1.2338233 1.43169020 0.2983985 0.9971840
Some of the values are greater than two. We want all of these to appear the same colour on our heatmap, so we create a copy of our data for plotting, and round down all of the values that were greater than 2 to be exactly 2:
data_2 <- data
data_2[] <- lapply(data_2, function(x) { x[x > 2] <- 2; x })
So now if we run pheatmap on data_2, we see that all the values that were greater than 2 in our original data frame are coloured daffodil.
library(viridis)
library(pheatmap)
breaks_2 <- seq(0, 2, by = 0.1)
pheatmap(
mat = data_2,
cluster_cols = F,
cluster_rows = F,
border_color = "white",
scale = 'none',
color = inferno(22),
show_colnames = TRUE,
show_rownames = FALSE,
legend_breaks = breaks_2
)

Combine several chorddiag/htmlwidget plots to a single plot in R

I'm generating several chorddiag plots in R and would like to combine them together to a single plot. Here's an example list of 3 chorddiag plots:
library(chorddiag)
m <- matrix(c(11975, 5871, 8916, 2868,
1951, 10048, 2060, 6171,
8010, 16145, 8090, 8045,
1013, 990, 940, 6907),
byrow = TRUE,
nrow = 4, ncol = 4)
haircolors <- c("black", "blonde", "brown", "red")
dimnames(m) <- list(haircolors,haircolors)
groupColors <- c("#000000", "#FFDD89", "#957244", "#F26223")
ll <- lapply(1:3,function(i) chorddiag(m, groupColors = groupColors, groupnamePadding = 20))
If these were plotly object I'd use plotly's subplot function. Is there anything equivalent for case of:
> class(ll[[1]])
[1] "chorddiag" "htmlwidget"
I haven't tried the chorddiag package (I don't think it's on CRAN, maybe some other repos?), but the manipulateWidget package may be what you want. example(combineWidgets) has this code:
data(iris)
library(manipulateWidget); library(plotly)
#> Loading required package: ggplot2
#>
#> Attaching package: 'plotly'
#> The following object is masked from 'package:ggplot2':
#>
#> last_plot
#> The following object is masked from 'package:stats':
#>
#> filter
#> The following object is masked from 'package:graphics':
#>
#> layout
combineWidgets(title = "The Iris dataset",
plot_ly(iris, x = ~Sepal.Length, type = "histogram", nbinsx = 20),
plot_ly(iris, x = ~Sepal.Width, type = "histogram", nbinsx = 20),
plot_ly(iris, x = ~Petal.Length, type = "histogram", nbinsx = 20),
plot_ly(iris, x = ~Petal.Width, type = "histogram", nbinsx = 20)
)
Created on 2022-03-24 by the reprex package (v2.0.1)
EDITED to add:
Okay, I found chorddiag on Github: https://github.com/mattflor/chorddiag/ . After running your code, this combines the three diagrams:
manipulateWidgets::combineWidgets(shiny::tagList(ll))
They don't resize nicely; I suspect that's because chorddiag wants to be fullscreen, but maybe it's a problem in manipulateWidgets. You'll probably have to patch one or the other.

Get DOT file from a graph when using DiagrammeR

It looks like DiagrammeR has changed their create_nodes and create_edges functions than it looks on the doc.
Also the $dot_code attribute is not there anymore. I can't find the replacement for this.
Here is the example code that they had on the doc, but it is not working.
The following example is found in their official DiagrammeR web.
###
# Create a graph with both nodes and edges
# defined, and, add some default attributes
# for nodes and edges
###
library(DiagrammeR)
# Create a node data frame
nodes <-
create_nodes(nodes = c("a", "b", "c", "d"),
label = FALSE,
type = "lower",
style = "filled",
color = "aqua",
shape = c("circle", "circle",
"rectangle", "rectangle"),
data = c(3.5, 2.6, 9.4, 2.7))
edges <-
create_edges(from = c("a", "b", "c"),
to = c("d", "c", "a"),
rel = "leading_to")
graph <-
create_graph(nodes_df = nodes,
edges_df = edges,
node_attrs = "fontname = Helvetica",
edge_attrs = c("color = blue",
"arrowsize = 2"))
graph
#> $nodes_df
#> nodes label type style color shape data
#> 1 a lower filled aqua circle 3.5
#> 2 b lower filled aqua circle 2.6
#> 3 c lower filled aqua rectangle 9.4
#> 4 d lower filled aqua rectangle 2.7
#>
#> $edges_df
#> from to rel
#> 1 a d leading_to
#> 2 b c leading_to
#> 3 c a leading_to
#>
#> $graph_attrs
#> [1] NULL
#>
#> $node_attrs
#> [1] "fontname = Helvetica"
#>
#> $edge_attrs
#> [1] "color = blue" "arrowsize = 2"
#>
#> $directed
#> [1] TRUE
#>
#> $dot_code
#> [1] "digraph {\n\ngraph [rankdir = LR]\n\nnode [fontnam...
#>
#> attr(,"class")
#> [1] "dgr_graph"
# View the graph in the RStudio Viewer
render_graph(graph)
look into the help of the DiagrammeR package, the website is indeed not up-to-date.
Look at the function create_graph() in the help that shows how the syntax changed.
something like this should do the same:
###
library(DiagrammeR)
# Create a node data frame (ndf) where the labels
# are equivalent to the node ID values (this is not
# recommended); the `label` and `type` node
# attributes will always be a `character` class
# whereas `id` will always be an `integer`
nodes <-
create_node_df(
n = 4,
type = "lower",
label = c("a", "b", "c", "d"),
style = "filled",
fillcolor = "blue",
shape = c("circle", "circle",
"rectangle", "rectangle"),
data = c(3.5, 2.6, 9.4, 2.7))
# Create an edf with additional edge
# attributes (where their classes will
# be inferred from the input vectors)
edges <-
create_edge_df(
from = c(1, 2, 3),
to = c(4, 3, 1),
rel = "leading_to")
# With `create_graph()` we can
# simply create an empty graph (and
# add in nodes and edges later
# with other functions)
graph <-
create_graph(
nodes_df = nodes,
edges_df = edges) %>%
set_edge_attrs(
edge_attr = color,
values = "green") %>%
set_edge_attrs(
edge_attr = arrowsize,
values = 2) %>%
set_node_attrs(
node_attr = fontname,
values = "Helvetica")
graph
render_graph(graph)
The Bad News
For anyone viewing this zombie thread, as of this posting, the information posted on Rich Iannone's documentation page for DiagrammeR is still out of date: http://rich-iannone.github.io/DiagrammeR/graph_creation.html.
The Good News
However, the vignettes for the Diagrammer package contain updated information. As shown in the package vignette named Creating Simple Graphs from NDFs/EDFs, you can view and export GraphViz dot code with a function named generate_dot().

Changes in plotting an XTS object

I had produced the following chart, which is created using an xts object.
The code I used was simply
plot(graphTS1$CCLL, type = "l", las = 2, ylab = "(c)\nCC for Investors", xlab = "", main = "Clustering Coefficient at the Investor Level")
I updated my R Studio Package and R version and then by running the same code I got the following chart.
Obviously the two are not the same. Can people help me remove the second Y axis - I do not need that, and remove the automatic heading of 2007-03-01 / 2010-12-01. Numerous attempts of this have failed. I did use zoo.plot but the gridlines and ability and the quarterly marks were removed.
My R version is 3.4.0 (2017-04-21) with the following platform "x86_64-apple-darwin15.6.0". Thanks in advance.
You want to remove the right hand axis. There is an argument in plot.xts(..., yaxis.right = TRUE, ...). So
library('xts')
#> Loading required package: zoo
#>
#> Attaching package: 'zoo'
#> The following objects are masked from 'package:base':
#>
#> as.Date, as.Date.numeric
data(sample_matrix)
sample.xts <- as.xts(sample_matrix, descr='my new xts object')
plot(sample.xts, yaxis.right = FALSE)
does what you want.
I took a stab at solving the second question, removing the label at the top right hand side. Examining the source code for plot.xts() reveals that label is hardcoded into the main title. Even setting main = '' isn't going to remove it. You can work around it by editing plot.xts() and copying it to a new function.
plotxts <- fix("plot.xts")
# In the editor that opens, replace the lines below:
### text.exp <- c(expression(text(xlim[1], 0.5, main, font = 2,
### col = theme$labels, offset = 0, cex = 1.1, pos = 4)),
### expression(text(xlim[2], 0.5, paste(start(xdata[xsubset]),
### end(xdata[xsubset]), sep = " / "), col = theme$labels,
### adj = c(0, 0), pos = 2)))
### cs$add(text.exp, env = cs$Env, expr = TRUE)
# with these lines:
### text.exp <- expression(text(xlim[1], 0.5, main, font = 2,
### col = theme$labels, offset = 0, cex = 1.1, pos = 4))
# Finally, you need to ensure your copy's environment is the xts namespace:
environment(plotxts) <- asNamespace("xts")
plotxts(sample.xts, yaxis.right = FALSE, main = "Main Title")
The second, and perhaps
simpler option is to use a different plot function and modify it to produce the gridlines etc that you want. I will start
with plot.zoo() because it is already handling time series nicely.
zoo::plot.zoo(sample.xts, screens = 1, xlab="", las=2, main="Main Title")
grid() # add the grid
That at least gets the grid on there. I can't test if it will handle the x axis labels the same way without data at the right frequency.
You can now (finally) omit the date range from the plot in xts 0.12.2 on CRAN. Set main.timespan = FALSE.
plot(sample.xts[,1], yaxis.right = FALSE, main = "Main Title", main.timespan = FALSE)

Resources