2019-04-climate-change | R code underlying the maps and chart in the Apr | Data Visualization library
kandi X-RAY | 2019-04-climate-change Summary
Support
Quality
Security
License
Reuse
Currently covering the most popular Java, JavaScript and Python libraries. See a Sample Here
2019-04-climate-change Key Features
2019-04-climate-change Examples and Code Snippets
Trending Discussions on Data Visualization
Trending Discussions on Data Visualization
QUESTION
I have the following network graph:
library(tidyverse)
library(igraph)
set.seed(123)
n=5
data = tibble(d = paste(1:n))
relations = data.frame(tibble(
from = sample(data$d),
to = lead(from, default=from[1]),
))
graph = graph_from_data_frame(relations, directed=T, vertices = data)
V(graph)$color <- ifelse(data$d == relations$from[1], "red", "orange")
plot(graph, layout=layout.circle, edge.arrow.size = 0.2)
I want to connect each Node to every Node on this graph - I can do this manually by redefining the "relations" data frame:
relations_1 = data.frame("from" = c(1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5), "to" = c(2,3,4,5,1,3,4,5,1,2,4,5,1,2,3,5,1,2,3,4))
Then, I can re-run the network graph:
graph = graph_from_data_frame(relations_1, directed=T, vertices = data)
V(graph)$color <- ifelse(data$d == relations_1$from[1], "red", "orange")
plot(graph, layout=layout.circle, edge.arrow.size = 0.2)
- But would there have been a way to "automatically" connect all the points in the graph directly using the "relations" data frame without manually creating a new data frame "relations_1"? Could a single line (or a few lines) of code have been added that would have automatically taken the "relations" data frame and connected everything together?
Thank you!
ANSWER
Answered 2022-Mar-30 at 04:35You could just update relations
using complete
, and than filter out the rows where from
is equal to to
, which gives arrows from a node to itself.
relations <- relations %>%
complete(from, to) %>%
dplyr::filter(from != to)
QUESTION
I am working with the R programming language.
I generated the following random data set in R and made a plot of these points:
library(ggplot2)
set.seed(123)
x_cor = rnorm(5,100,100)
y_cor = rnorm(5,100,100)
my_data = data.frame(x_cor,y_cor)
x_cor y_cor
1 43.95244 271.50650
2 76.98225 146.09162
3 255.87083 -26.50612
4 107.05084 31.31471
5 112.92877 55.43380
ggplot(my_data, aes(x=x_cor, y=y_cor)) + geom_point() + ggtitle("Travelling Salesman Example")
Suppose I want to connect these dots together in the following order: 1 with 3, 3 with 4, 4 with 5, 5 with 2, 2 with 1
I can make a new variable that contains this ordering:
my_data$order = c(3, 1, 4, 5, 2)
Is it possible to make this kind of graph using ggplot2?
I tried the following code - but this connects the points based on the order they appear in, and not the custom ordering:
ggplot(my_data, aes(x = x_cor, y = y_cor)) +
geom_path() +
geom_point(size = 2)
ANSWER
Answered 2022-Mar-15 at 17:00You can order your data like so:
my_data$order = c(1, 5, 2, 3, 4)
ggplot(my_data[order(my_data$order),], aes(x = x_cor, y = y_cor)) +
geom_path() +
geom_point(size = 2)
ggplot(my_data[order(my_data$order),], aes(x = x_cor, y = y_cor)) +
geom_polygon(fill = NA, color = "black") +
geom_point(size = 2)
QUESTION
I made the following 25 network graphs (all of these graphs are copies for simplicity - in reality, they will all be different):
library(tidyverse)
library(igraph)
set.seed(123)
n=15
data = data.frame(tibble(d = paste(1:n)))
relations = data.frame(tibble(
from = sample(data$d),
to = lead(from, default=from[1]),
))
data$name = c("new york", "chicago", "los angeles", "orlando", "houston", "seattle", "washington", "baltimore", "atlanta", "las vegas", "oakland", "phoenix", "kansas", "miami", "newark" )
graph = graph_from_data_frame(relations, directed=T, vertices = data)
V(graph)$color <- ifelse(data$d == relations$from[1], "red", "orange")
plot(graph, layout=layout.circle, edge.arrow.size = 0.2, main = "my_graph")
library(visNetwork)
a = visIgraph(graph)
m_1 = 1
m_2 = 23.6
a = toVisNetworkData(graph) %>%
c(., list(main = paste0("Trip ", m_1, " : "), submain = paste0 (m_2, "KM") )) %>%
do.call(visNetwork, .) %>%
visIgraphLayout(layout = "layout_in_circle") %>%
visEdges(arrows = 'to')
y = x = w = v = u = t = s = r = q = p = o = n = m = l = k = j = i = h = g = f = e = d = c = b = a
I would like to "tile" them as 5 x 5 : Since these are interactive html plots - I used the following command:
library(manipulateWidget)
library(htmltools)
ff = combineWidgets(y , x , w , v , u , t , s , r , q , p , o , n , m , l , k , j , i , h , g , f , e , d , c , b , a)
htmltools::save_html(html = ff, file = "widgets.html")
I found out how to add a zoom option for each individual graph:
a = toVisNetworkData(graph) %>%
c(., list(main = paste0("Trip ", m_1, " : "), submain = paste0 (m_2, "KM") )) %>%
do.call(visNetwork, .) %>%
visIgraphLayout(layout = "layout_in_circle") %>%
visInteraction(navigationButtons = TRUE) %>%
visEdges(arrows = 'to')
y = x = w = v = u = t = s = r = q = p = o = n = m = l = k = j = i = h = g = f = e = d = c = b = a
ff = combineWidgets(y , x , w , v , u , t , s , r , q , p , o , n , m , l , k , j , i , h , g , f , e , d , c , b , a)
htmltools::save_html(html = ff, file = "widgets.html")
But now the "zoom" options and "titles" have "cluttered" all the graphs!
I was thinking it might be better to "stack" all these graphs on top of each other and save each graph as a "group type" - and then hide/unhide as we please:
visNetwork(data, relations) %>%
visOptions(selectedBy = "group")
Can we put all 25 graphs on one page and then "zoom" into each individual graph to view it better (e.g. have only one set of zoom/navigation buttons in the corner of the screen that works for all graphs)?
Is there a way to stop the titles from overlapping with the graphs?
Can we put all 25 graphs on one page and then "hide" individual graphs by "checking" an option menu button? (like the last example on this page: https://datastorm-open.github.io/visNetwork/options.html)
Here are the possible solutions I have thought of for this problem:
- Option 1: (a single zoom/navigation option for all graphs and no cluttered labels)
- Option 2: (In the future, each "trip" will be different - "trips" will contain the same nodes, but have different edge connections and different titles/subtitles.)
I know that this style of selection ("Option 2") can be made using the following code:
nodes <- data.frame(id = 1:15, label = paste("Label", 1:15),
group = sample(LETTERS[1:3], 15, replace = TRUE))
edges <- data.frame(from = trunc(runif(15)*(15-1))+1,
to = trunc(runif(15)*(15-1))+1)
visNetwork(nodes, edges) %>%
visOptions(selectedBy = "group")
But I am not sure how to adapt the above code for a pre-existing set of "visNetwork" graphs. For example, suppose I already have "visNetwork" graphs "a, b, c, d, e" - how can I "stack them on top of each other" and "shuffle through them" with a "select menu" like in the above code?
Can someone please show me a way of addressing this clutter problem using Option 1 and Option 2?
Thank you!
ANSWER
Answered 2022-Mar-03 at 21:12While my solution isn't exactly what you describe under Option 2
, it is close. We use combineWidgets()
to create a grid with a single column and a row height where one graph covers most of the screen height. We squeeze in a link between each widget instance that scrolls the browser window down to show the following graph when clicked.
Let me know if this is working for you. It should be possible to automatically adjust the row size according to the browser window size. Currently, this depends on the browser window height being around 1000px.
I modified your code for the graph creation slightly and wrapped it in a function. This allows us to create 25 different-looking graphs easily. This way testing the resulting HTML file is more fun! What follows the function definition is the code to create a list
of HTML objects that we then feed into combineWidgets()
.
library(visNetwork)
library(tidyverse)
library(igraph)
library(manipulateWidget)
library(htmltools)
create_trip_graph <-
function(x, distance = NULL) {
n <- 15
data <- tibble(d = 1:n,
name =
c(
"new york",
"chicago",
"los angeles",
"orlando",
"houston",
"seattle",
"washington",
"baltimore",
"atlanta",
"las vegas",
"oakland",
"phoenix",
"kansas",
"miami",
"newark"
))
relations <- tibble(from = sample(data$d),
to = lead(from, default = from[1]))
graph <-
graph_from_data_frame(relations, directed = TRUE, vertices = data)
V(graph)$color <-
ifelse(data$d == relations$from[1], "red", "orange")
if (is.null(distance))
# This generates a random distance value if none is
# specified in the function call. Values are just for
# demonstration, no actual distances are calculated.
distance <- sample(seq(19, 25, .1), 1)
toVisNetworkData(graph) %>%
c(., list(
main = paste0("Trip ", x, " : "),
submain = paste0(distance, "KM")
)) %>%
do.call(visNetwork, .) %>%
visIgraphLayout(layout = "layout_in_circle") %>%
visInteraction(navigationButtons = TRUE) %>%
visEdges(arrows = 'to')
}
comb_vgraphs <- lapply(1:25, function (x) list(
create_trip_graph(x),
htmltools::a("NEXT TRIP",
onclick = 'window.scrollBy(0,950)',
style = 'color:blue; text-decoration:underline;'))) %>%
unlist(recursive = FALSE)
ff <-
combineWidgets(
list = comb_vgraphs,
ncol = 1,
height = 25 * 950,
rowsize = c(24, 1)
)
htmltools::save_html(html = ff, file = "widgets.html")
If you want to have 5 network maps per row the code gets a bit more complex and it also might lead to a situation where the user might have to do horizontal scrolling in order to see everything, which is something you usually want to avoid when creating HTML pages. Here is the code for a 5 maps per row solution:
comb_vgraphs2 <- lapply(1:25, function(x) {
a <- list(create_trip_graph(x))
# We detect whenever we are creating the 5th, 10th, 15th etc. network map
# and add the link after that one.
if (x %% 5 == 0 & x < 25) a[[2]] <- htmltools::a("NEXT 5 TRIPS",
onclick = 'window.scrollBy(0,500)',
style = 'color:blue; text-decoration:underline;')
a
}) %>%
unlist(recursive = FALSE)
ff2 <-
combineWidgets(
list = comb_vgraphs2,
ncol = 6, # We need six columns, 5 for the network maps
# and 1 for the link to scroll the page.
height = 6 * 500,
width = 1700
#rowsize = c(24, 1)
)
# We need to add some white space in for the scrolling by clicking the link to
# still work for the last row.
ff2$widgets[[length(ff2$widgets) + 1]] <- htmltools::div(style = "height: 1000px;")
htmltools::save_html(html = ff2, file = "widgets2.html")
In general I'd recommend you play around with the height
and width
, ncol
and nrow
arguments of combineWidgets()
to achieve a satisfying solution. My strategy when building this was to first create a grid without the scroll link and add that in, after getting the grid right.
QUESTION
I am working with the R programming language. I made the following 3 Dimensional Plot using the "plotly" library:
library(dplyr)
library(plotly)
my_function <- function(x,y) {
final_value = (1 - x)^2 + 100*((y - x^2)^2)
}
input_1 <- seq(-1.5, 1.5,0.1)
input_2 <- seq(-1.5, 1.5,0.1)
z <- outer(input_1, input_2, my_function)
plot_ly(x = input_1, y = input_2, z = z) %>% add_surface()
I am now trying to add "contour lines" to the above plot as shown below: https://plotly.com/r/3d-surface-plots/
I am trying to adapt the code from the "plotly website" to make these contours, but I am not sure how to do this:
Graph 1:
# This might have worked?
fig <- plot_ly(z = ~z) %>% add_surface(
contours = list(
z = list(
show=TRUE,
usecolormap=TRUE,
highlightcolor="#ff0000",
project=list(z=TRUE)
)
)
)
fig <- fig %>% layout(
scene = list(
camera=list(
eye = list(x=1.87, y=0.88, z=-0.64)
)
)
)
# I don't think this worked?
fig <- plot_ly(
type = 'surface',
contours = list(
x = list(show = TRUE, start = 1.5, end = 2, size = 0.04, color = 'white'),
z = list(show = TRUE, start = 0.5, end = 0.8, size = 0.05)),
x = ~x,
y = ~y,
z = ~z)
fig <- fig %>% layout(
scene = list(
xaxis = list(nticks = 20),
zaxis = list(nticks = 4),
camera = list(eye = list(x = 0, y = -1, z = 0.5)),
aspectratio = list(x = .9, y = .8, z = 0.2)))
fig
ANSWER
Answered 2022-Mar-04 at 17:52You were almost there.
The contours on z
should be defined according to min
-max
values of z
:
plot_ly(x = input_1, y = input_2, z = z,
contours = list(
z = list(show = TRUE, start = round(min(z),-2),
end = round(max(z),-2),
size = 100))) %>%
add_surface()
plot_ly(x = input_1, y = input_2, z = z,
colors = 'Oranges',
contours = list(
z = list(show = TRUE))) %>%
add_surface()
QUESTION
I'm trying to build a doughnut chart with rounded edges only on one side. My problem is that I have both sided rounded and not just on the one side. Also can't figure out how to do more foreground arcs not just one.
const tau = 2 * Math.PI; // http://tauday.com/tau-manifesto
const arc = d3.arc()
.innerRadius(80)
.outerRadius(100)
.startAngle(0)
.cornerRadius(15);
const svg = d3.select("svg"),
width = +svg.attr("width"),
height = +svg.attr("height"),
g = svg.append("g").attr("transform", "translate(" + width / 2 + "," + height / 2 + ")");
Background arc, but I'm not sure if this is even needed?
const background = g.append("path")
.datum({endAngle: tau})
.style("fill", "#ddd")
.attr("d", arc);
const data = [ .51];
const c = d3.scaleThreshold()
.domain([.200,.205,.300,.310, .501, 1])
.range(["green","#ddd", "orange","#ddd", "red"]);
Const pie = d3.pie()
.sort(null)
.value(function(d) {
return d;
});
Only have one foreground, but need to be able to have multiple:
const foreground = g.selectAll('.arc')
.data(pie(data))
.enter()
.append("path")
.attr("class", "arc")
.datum({endAngle: 3.8})
.style("fill", function(d) {
return c(d.value);
})
.attr("d", arc)
What am I doing wrong?
var tau = 2 * Math.PI; // http://tauday.com/tau-manifesto
// An arc function with all values bound except the endAngle. So, to compute an
// SVG path string for a given angle, we pass an object with an endAngle
// property to the `arc` function, and it will return the corresponding string.
var arc = d3.arc()
.innerRadius(80)
.outerRadius(100)
.startAngle(0)
.cornerRadius(15);
// Get the SVG container, and apply a transform such that the origin is the
// center of the canvas. This way, we don’t need to position arcs individually.
var svg = d3.select("svg"),
width = +svg.attr("width"),
height = +svg.attr("height"),
g = svg.append("g").attr("transform", "translate(" + width / 2 + "," + height / 2 + ")");
// Add the background arc, from 0 to 100% (tau).
var background = g.append("path")
.datum({endAngle: tau})
.style("fill", "#ddd")
.attr("d", arc);
var data = [ .51];
var c = d3.scaleThreshold()
.domain([.200,.205,.300,.310, .501, 1])
.range(["green","#ddd", "orange","#ddd", "red"]);
var pie = d3.pie()
.sort(null)
.value(function(d) {
return d;
});
// Add the foreground arc in orange, currently showing 12.7%.
var foreground = g.selectAll('.arc')
.data(pie(data))
.enter()
.append("path")
.attr("class", "arc")
.datum({endAngle: 3.8})
.style("fill", function(d) {
return c(d.value);
})
.attr("d", arc)
ANSWER
Answered 2022-Feb-28 at 08:52The documentation states, that the corner radius is applied to both ends of the arc. Additionally, you want the arcs to overlap, which is also not the case.
You can add the one-sided rounded corners the following way:
- Use arcs
arc
with no corner radius for the data. - Add additional
path
objectscorner
just for the rounded corner. These need to be shifted to the end of eacharc
. - Since
corner
has rounded corners on both sides, add aclipPath
that clips half of this arc. TheclipPath
contains apath
for everycorner
. This is essential for arcs smaller than two times the length of the rounded corners. raise
all elements ofcorner
to the front and thensort
them descending by index, so that they overlap the right way.
const arc = d3.arc()
.innerRadius(50)
.outerRadius(70);
const arc_corner = d3.arc()
.innerRadius(50)
.outerRadius(70)
.cornerRadius(10);
const svg = d3.select("svg"),
width = +svg.attr("width"),
height = +svg.attr("height"),
g = svg.append("g").attr("transform", "translate(" + width / 2 + "," + height / 2 + ")");
const clipPath = g.append("clipPath")
.attr("id", "clip_corners");
const c = d3.scaleQuantile()
.range(["#f7fcf0","#e0f3db","#ccebc5","#a8ddb5","#7bccc4","#4eb3d3","#2b8cbe","#08589e"]);
const pie = d3.pie().value(d => d);
function render(values) {
c.domain(values);
const arcs = pie(values);
const corners = pie(values).map(d => {
d.startAngle = d.endAngle - 0.2;
d.endAngle = d.endAngle + 0.2;
return d;
});
const clip = pie(values).map(d => {
d.startAngle = d.endAngle - 0.01;
d.endAngle = d.endAngle + 0.2;
return d;
});
g.selectAll(".arc")
.data(arcs)
.join("path")
.attr("class", "arc")
.style("fill", d => c(d.value))
.attr("d", arc);
clipPath.selectAll("path")
.data(clip)
.join("path")
.attr("d", arc);
g.selectAll(".corner")
.data(corners)
.join("path")
.raise()
.attr("class", "corner")
.attr("clip-path", "url(#clip_corner)")
.style("fill", d => c(d.value))
.attr("d", arc_corner)
.sort((a, b) => b.index - a.index);
}
function randomData() {
const num = Math.ceil(8 * Math.random()) + 2;
const values = Array(num).fill(0).map(d => Math.random());
render(values);
}
d3.select("#random_data")
.on("click", randomData);
randomData();
Random data
I changed the dependency to the current version of d3.
QUESTION
Over here (Directly Adding Titles and Labels to Visnetwork), I learned how to directly add titles to graphs made using the "visIgraph()" function:
library(tidyverse)
library(igraph)
library(visNetwork)
set.seed(123)
n=15
data = data.frame(tibble(d = paste(1:n)))
relations = data.frame(tibble(
from = sample(data$d),
to = lead(from, default=from[1]),
))
data$name = c("new york", "chicago", "los angeles", "orlando", "houston", "seattle", "washington", "baltimore", "atlanta", "las vegas", "oakland", "phoenix", "kansas", "miami", "newark" )
graph = graph_from_data_frame(relations, directed=T, vertices = data)
V(graph)$color <- ifelse(data$d == relations$from[1], "red", "orange")
toVisNetworkData(graph) %>%
c(., list(main = "my title", submain = "subtitle")) %>%
do.call(visNetwork, .)
visIgraph(graph) %>%
visIgraphLayout(layout = "layout_in_circle") %>%
visOptions(highlightNearest = list(enabled = T, hover = T),
nodesIdSelection = T)
Now, I want to combine these two codes so I can keep the titles (via the visIgraph() function) and the random layout. This is the end goal that I am trying to achieve:
I tried to do this by combining these codes in different ways - but nothing seems to be working:
- Option 1:
g = visIgraph(graph) %>%
visIgraphLayout(layout = "layout_in_circle") %>%
visOptions(highlightNearest = list(enabled = T, hover = T),
nodesIdSelection = T)
toVisNetworkData(g) %>%
c(., list(main = "my title")) %>%
do.call(visNetwork, .)
Error in toVisNetworkData(g) : igraph must be a igraph object
- Option 2:
toVisNetworkData(graph) %>%
c(., list(main = "my title")) %>% visIgraphLayout(layout = "layout_in_circle")
Error in visIgraphLayout(., layout = "layout_in_circle") : graph must be a visNetwork object
do.call(visNetwork, .)
Error in do.call(visNetwork, .) : object '.' not found
Does anyone know what I am doing wrong? I think I am not correctly understanding how the "do.call" and "list" commands are supposed to be used?
Thank you!
ANSWER
Answered 2022-Feb-25 at 10:55Please find below one possible solution.
Reprex
- Your data
library(dplyr)
library(visNetwork)
set.seed(123)
n=15
data = data.frame(tibble(d = paste(1:n)))
relations = data.frame(tibble(
from = sample(data$d),
to = lead(from, default=from[1]),
))
data$name = c("new york", "chicago", "los angeles", "orlando", "houston", "seattle", "washington", "baltimore", "atlanta", "las vegas", "oakland", "phoenix", "kansas", "miami", "newark" )
graph = graph_from_data_frame(relations, directed=T, vertices = data)
V(graph)$color <- ifelse(data$d == relations$from[1], "red", "orange")
- Suggested code
toVisNetworkData(graph) %>%
c(., list(main = "my title", submain = "subtitle")) %>%
do.call(visNetwork, .) %>%
visIgraphLayout(layout = "layout_in_circle") %>%
visEdges(arrows = 'to')
Created on 2022-02-25 by the reprex package (v2.0.1)
QUESTION
In d3
, we may change the order of elements in a selection, for example by using raise
.
Yet, when we rebind the data and use join
, this order is discarded.
This does not happen when we use "the old way" of binding data, using enter
and merge
.
See following fiddle where you can click a circle (for example the blue one) to bring it to front. When you click "redraw", the circles go back to their original z-ordering when using join
, but not when using enter
and merge
.
Can I achive that the circles keep their z-ordering and still use join
?
const data = [{
id: 1,
v: 10,
c: 'red'
}, {
id: 2,
v: 30,
c: 'blue'
}, {
id: 3,
v: 60,
c: 'green'
}]
let nDrawCall = 0
function redraw() {
nDrawCall++
//svg1 with old enter-merge pattern that works
const circles = d3.select('#svg1')
.selectAll('circle')
.data(data, d => d.id)
circles
.enter()
.append('circle')
.on('click', function() {
d3.select(this).raise()
})
.merge(circles)
.attr('cx', d => d.v * nDrawCall)
.attr('cy', d => d.v)
.attr('r', d => d.v)
.attr('fill', d => d.c)
//svg2 with new join pattern that sadly reorders
d3.select('#svg2')
.selectAll('circle')
.data(data, d => d.id)
.join(enter => enter
.append('circle')
.on('click', function() {
d3.select(this).raise()
})
)
.attr('cx', d => d.v * nDrawCall)
.attr('cy', d => d.v)
.attr('r', d => d.v)
.attr('fill', d => d.c)
}
function reset() {
nDrawCall = 0
redraw()
}
redraw()
/*
while (true) {
iter++
console.log(iter)
sleepFor(500)
}
*/
svg {
height: 100px;
width: 100%;
}
Redraw
Reset
ANSWER
Answered 2022-Feb-18 at 23:13join
does an implicit order
after merging the enter- and update-selection, see https://github.com/d3/d3-selection/blob/91245ee124ec4dd491e498ecbdc9679d75332b49/src/selection/join.js#L14.
The selection order after the data binding in your example is still red, blue, green even if the document order is changed. So the circles are reordered to the original order using join
.
You can get around that by changing the data binding reflecting the change in the document order. I did that here, by moving the datum of the clicked circle to the end of the data array.
let data = [{
id: 1,
v: 10,
c: 'red'
}, {
id: 2,
v: 30,
c: 'blue'
}, {
id: 3,
v: 60,
c: 'green'
}]
let nDrawCall = 0
function redraw() {
nDrawCall++
d3.select('#svg2')
.selectAll('circle')
.data(data, d => d.id)
.join(enter => enter
.append('circle')
.on('click', function() {
const circle = d3.select(this).raise();
data.push(data.splice(data.indexOf(circle.datum()), 1)[0]);
})
)
.attr('cx', d => d.v * nDrawCall)
.attr('cy', d => d.v)
.attr('r', d => d.v)
.attr('fill', d => d.c)
}
function reset() {
nDrawCall = 0
redraw()
}
redraw()
svg {
height: 100px;
width: 100%;
}
Redraw
Reset
QUESTION
Is there a way to put text along a density line, or for that matter, any path, in ggplot2? By that, I mean either once as a label, in this style of xkcd: 1835, 1950 (middle panel), 1392, or 2234 (middle panel). Alternatively, is there a way to have the line be repeating text, such as this xkcd #930 ? My apologies for all the xkcd, I'm not sure what these styles are called, and it's the only place I can think of that I've seen this before to differentiate areas in this way.
Note: I'm not talking about the hand-drawn xkcd style, nor putting flat labels at the top
I know I can place a straight/flat piece of text, such as via annotate
or geom_text
, but I'm curious about bending such text so it appears to be along the curve of the data.
I'm also curious if there is a name for this style of text-along-line?
Example ggplot2 graph using annotate(...)
:
Above example graph modified with curved text in Inkscape:
Edit: Here's the data for the first two trial runs in March and April, as requested:
df <- data.frame(
monthly_run = c('March', 'March', 'March', 'March', 'March', 'March', 'March',
'March', 'March', 'March', 'March', 'March', 'March', 'March',
'April', 'April', 'April', 'April', 'April', 'April', 'April',
'April', 'April', 'April', 'April', 'April', 'April', 'April'),
duration = c(36, 44, 45, 48, 50, 50, 51, 54, 55, 57, 60, 60, 60, 60, 30,
40, 44, 47, 47, 47, 53, 53, 54, 55, 56, 57, 69, 77)
)
ggplot(df, aes(x = duration, group = monthly_run, color = monthly_run)) +
geom_density() +
theme_minimal()`
ANSWER
Answered 2021-Nov-08 at 11:31Great question. I have often thought about this. I don't know of any packages that allow it natively, but it's not terribly difficult to do it yourself, since geom_text
accepts angle
as an aesthetic mapping.
Say we have the following plot:
library(ggplot2)
df <- data.frame(y = sin(seq(0, pi, length.out = 100)),
x = seq(0, pi, length.out = 100))
p <- ggplot(df, aes(x, y)) +
geom_line() +
coord_equal() +
theme_bw()
p
And the following label that we want to run along it:
label <- "PIRATES VS NINJAS"
We can split the label into characters:
label <- strsplit(label, "")[[1]]
Now comes the tricky part. We need to space the letters evenly along the path, which requires working out the x co-ordinates that achieve this. We need a couple of helper functions here:
next_x_along_sine <- function(x, d)
{
y <- sin(x)
uniroot(f = \(b) b^2 + (sin(x + b) - y)^2 - d^2, c(0, 2*pi))$root + x
}
x_along_sine <- function(x1, d, n)
{
while(length(x1) < n) x1 <- c(x1, next_x_along_sine(x1[length(x1)], d))
x1
}
These allow us to create a little data frame of letters, co-ordinates and angles to plot our letters:
df2 <- as.data.frame(approx(df$x, df$y, x_along_sine(1, 1/13, length(label))))
df2$label <- label
df2$angle <- atan(cos(df2$x)) * 180/pi
And now we can plot with plain old geom_text
:
p + geom_text(aes(y = y + 0.1, label = label, angle = angle), data = df2,
vjust = 1, size = 4, fontface = "bold")
df$col <- cut(df$x, c(-1, 0.95, 2.24, 5), c("black", "white", "#000000"))
ggplot(df, aes(x, y)) +
geom_line(aes(color = col, group = col)) +
geom_text(aes(label = label, angle = angle), data = df2,
size = 4, fontface = "bold") +
scale_color_identity() +
coord_equal() +
theme_bw()
or, with some theme tweaks:
Addendum
Realistically, I probably won't get round to writing a geom_textpath
package, but I thought it would be useful to show the sort of approach that might work for labelling density curves as per the OP's example. It requires the following suite of functions:
#-----------------------------------------------------------------------
# Converts a (delta y) / (delta x) gradient to the equivalent
# angle a letter sitting on that line needs to be rotated by to
# sit perpendicular to it. Includes a multiplier term so that we
# can take account of the different scale of x and y variables
# when plotting, as well as the device's aspect ratio.
gradient_to_text_angle <- function(grad, mult = 1)
{
angle <- atan(mult * grad) * 180 / pi
}
#-----------------------------------------------------------------------
# From a given set of x and y co-ordinates, determine the gradient along
# the path, and also the Euclidean distance along the path. It will also
# calculate the multiplier needed to correct for differences in the x and
# y scales as well as the current plotting device's aspect ratio
get_path_data <- function(x, y)
{
grad <- diff(y)/diff(x)
multiplier <- diff(range(x))/diff(range(y)) * dev.size()[2] / dev.size()[1]
new_x <- (head(x, -1) + tail(x, -1)) / 2
new_y <- (head(y, -1) + tail(y, -1)) / 2
path_length <- cumsum(sqrt(diff(x)^2 + diff(multiplier * y / 1.5)^2))
data.frame(x = new_x, y = new_y, gradient = grad,
angle = gradient_to_text_angle(grad, multiplier),
length = path_length)
}
#-----------------------------------------------------------------------
# From a given path data frame as provided by get_path_data, as well
# as the beginning and ending x co-ordinate, produces the appropriate
# x, y values and angles for letters placed along the path.
get_path_points <- function(path, x_start, x_end, letters)
{
start_dist <- approx(x = path$x, y = path$length, xout = x_start)$y
end_dist <- approx(x = path$x, y = path$length, xout = x_end)$y
diff_dist <- end_dist - start_dist
letterwidths <- cumsum(strwidth(letters))
letterwidths <- letterwidths/sum(strwidth(letters))
dist_points <- c(start_dist, letterwidths * diff_dist + start_dist)
dist_points <- (head(dist_points, -1) + tail(dist_points, -1))/2
x <- approx(x = path$length, y = path$x, xout = dist_points)$y
y <- approx(x = path$length, y = path$y, xout = dist_points)$y
grad <- approx(x = path$length, y = path$gradient, xout = dist_points)$y
angle <- approx(x = path$length, y = path$angle, xout = dist_points)$y
data.frame(x = x, y = y, gradient = grad,
angle = angle, length = dist_points)
}
#-----------------------------------------------------------------------
# This function combines the other functions to get the appropriate
# x, y positions and angles for a given string on a given path.
label_to_path <- function(label, path, x_start = head(path$x, 1),
x_end = tail(path$x, 1))
{
letters <- unlist(strsplit(label, "")[1])
df <- get_path_points(path, x_start, x_end, letters)
df$letter <- letters
df
}
#-----------------------------------------------------------------------
# This simple helper function gets the necessary density paths from
# a given variable. It can be passed a grouping variable to get multiple
# density paths
get_densities <- function(var, groups)
{
if(missing(groups)) values <- list(var)
else values <- split(var, groups)
lapply(values, function(x) {
d <- density(x)
data.frame(x = d$x, y = d$y)})
}
#-----------------------------------------------------------------------
# This is the end-user function to get a data frame of letters spaced
# out neatly and angled correctly along the density curve of the given
# variable (with optional grouping)
density_labels <- function(var, groups, proportion = 0.25)
{
d <- get_densities(var, groups)
d <- lapply(d, function(x) get_path_data(x$x, x$y))
labels <- unique(groups)
x_starts <- lapply(d, function(x) x$x[round((length(x$x) * (1 - proportion))/2)])
x_ends <- lapply(d, function(x) x$x[round((length(x$x) * (1 + proportion))/2)])
do.call(rbind, lapply(seq_along(d), function(i) {
df <- label_to_path(labels[i], d[[i]], x_starts[[i]], x_ends[[i]])
df$group <- labels[i]
df}))
}
With these functions defined, we can now do:
set.seed(100)
df <- data.frame(value = rpois(100, 3),
group = rep(paste("This is a very long label",
"that will nicely demonstrate the ability",
"of text to follow a density curve"), 100))
ggplot(df, aes(value)) +
geom_density(fill = "forestgreen", color = NA, alpha = 0.2) +
geom_text(aes(x = x, y = y, label = letter, angle = angle),
data = density_labels(df$value, df$group, 0.8)) +
theme_bw()
QUESTION
I do realize this has already been addressed here (e.g., matplotlib loop make subplot for each category, Add a subplot within a figure using a for loop and python/matplotlib). Nevertheless, I hope this question was different.
I have customized plot function pretty-print-confusion-matrix
stackoverflow & github. Which generates below plot
I want to add the above-customized plot in for loop to one single plot as subplots.
for i in [somelist]:
pretty_plot_confusion_matrix(i, annot=True, cmap="Oranges", fmt='.2f', fz=11,
lw=0.5, cbar=False, figsize=[5,5], show_null_values=0, pred_val_axis='y')
# Add/append plot to subplots
ANSWER
Answered 2022-Jan-04 at 09:09Okay so I went through the library's github repository and the issue is that the figure and axes objects are created internally which means that you can't create multiple plots on the same figure. I created a somewhat hacky solution by forking the library. This is the forked library I created to do what you want. And here is a an example piece of code:
matrices = [np.array( [[13, 0, 1, 0, 2, 0],[ 0, 50, 2, 0, 10, 0],[ 0, 13, 16, 0, 0, 3],[ 0, 0, 0, 13, 1, 0],[ 0, 40, 0, 1, 15, 0],[ 0, 0, 0, 0, 0, 20]]),
np.array( [[13, 0, 1, 0, 2, 0],[ 0, 50, 2, 0, 10, 0],[ 0, 13, 16, 0, 0, 3],[ 0, 0, 0, 13, 1, 0],[ 0, 40, 0, 1, 15, 0],[ 0, 0, 0, 0, 0, 20]]),
np.array( [[13, 0, 1, 0, 2, 0],[ 0, 50, 2, 0, 10, 0],[ 0, 13, 16, 0, 0, 3],[ 0, 0, 0, 13, 1, 0],[ 0, 40, 0, 1, 15, 0],[ 0, 0, 0, 0, 0, 20]]),
np.array( [[13, 0, 1, 0, 2, 0],[ 0, 50, 2, 0, 10, 0],[ 0, 13, 16, 0, 0, 3],[ 0, 0, 0, 13, 1, 0],[ 0, 40, 0, 1, 15, 0],[ 0, 0, 0, 0, 0, 20]]),
np.array( [[13, 0, 1, 0, 2, 0],[ 0, 50, 2, 0, 10, 0],[ 0, 13, 16, 0, 0, 3],[ 0, 0, 0, 13, 1, 0],[ 0, 40, 0, 1, 15, 0],[ 0, 0, 0, 0, 0, 20]]),
np.array( [[13, 0, 1, 0, 2, 0],[ 0, 50, 2, 0, 10, 0],[ 0, 13, 16, 0, 0, 3],[ 0, 0, 0, 13, 1, 0],[ 0, 40, 0, 1, 15, 0],[ 0, 0, 0, 0, 0, 20]]),
np.array( [[13, 0, 1, 0, 2, 0],[ 0, 50, 2, 0, 10, 0],[ 0, 13, 16, 0, 0, 3],[ 0, 0, 0, 13, 1, 0],[ 0, 40, 0, 1, 15, 0],[ 0, 0, 0, 0, 0, 20]]),
np.array( [[13, 0, 1, 0, 2, 0],[ 0, 50, 2, 0, 10, 0],[ 0, 13, 16, 0, 0, 3],[ 0, 0, 0, 13, 1, 0],[ 0, 40, 0, 1, 15, 0],[ 0, 0, 0, 0, 0, 20]]),
np.array( [[13, 0, 1, 0, 2, 0],[ 0, 50, 2, 0, 10, 0],[ 0, 13, 16, 0, 0, 3],[ 0, 0, 0, 13, 1, 0],[ 0, 40, 0, 1, 15, 0],[ 0, 0, 0, 0, 0, 20]])]
fig = plt.figure(tight_layout=True)
ax = fig.add_gridspec(3,3)
ax_list = [] #list containing axes objects
for i in range(9):
ax_list.append(fig.add_subplot(ax[i%3,i//3]))
df_cm = DataFrame(matrices[i], index=range(1,7), columns=range(1,7))
pretty_plot_confusion_matrix(df_cm, ax_list[i], annot=True, cmap="Oranges", fmt='.2f', fz=7,
lw=0.5, cbar=False, show_null_values=0, pred_val_axis='y')
plt.show()
Let me know if there are any issues (Oh and be careful with fontsizes).
QUESTION
I would like to generate a hexagonal lattice heat-map in which each cell represents a group. Likewise, each cell would be a hexagon with a unique color (fill
, set by a column color
in the data-frame) value, and a saturation (alpha
) value corresponding to continuous decimal values from a chemical concentration dateset.
I would like to use a standardized data format which would allow me to quickly construct figures based on standardized datasets containing 25 groups.
For example, a datasheet would look like this:
structure(list(group = 1:25, color = c("red", "brown1", "hotpink1",
"orange", "indianred1", "magenta", "darkgoldenrod1", "goldenrod1",
"gold", "deeppink", "yellow", "darkseagreen1", "aquamarine",
"plum", "mediumorchid4", "olivedrab1", "limegreen", "thistle1",
"violetred", "green4", "mediumseagreen", "darkviolet", "lightseagreen",
"dodgerblue2", "deepskyblue4"), alpha = c(NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA), x = c(1, 1.5, 1.5, 2, 2, 2, 2.5, 2.5, 2.5, 2.5,
3, 3, 3, 3, 3, 3.5, 3.5, 3.5, 3.5, 4, 4, 4, 4.5, 4.5, 5), y = c(3,
3.5, 2.5, 4, 3, 2, 4.5, 3.5, 2.5, 1.5, 5, 4, 3, 2, 1, 4.5, 3.5,
2.5, 1.5, 4, 3, 2, 3.5, 2.5, 3)), class = "data.frame", row.names = c(NA,
-25L))
A plot of this kind in which alpha = 1
for all groups might look like this:
Whereas plots of dataset1
and dataset2
(included below) would look like these, respectively:
I would like to use something simple, like hexbin()
, but I haven't figured out how to get that to work for this application.
Dataset1:
structure(list(group = 1:25, color = c("red", "brown1", "hotpink1",
"orange", "indianred1", "magenta", "darkgoldenrod1", "goldenrod1",
"gold", "deeppink", "yellow", "darkseagreen1", "aquamarine",
"plum", "mediumorchid4", "olivedrab1", "limegreen", "thistle1",
"violetred", "green4", "mediumseagreen", "darkviolet", "lightseagreen",
"dodgerblue2", "deepskyblue4"), alpha = c(1, 1, 0.5, 0.5, 0.2,
0.2, 0, 0, 0.3, 0.1, 1, 0, 0, 0, 0.7, 0, 0, 0, 0, 0, 0, 0, 0,
0.5, 0.9), x = c(1, 1.5, 1.5, 2, 2, 2, 2.5, 2.5, 2.5, 2.5, 3,
3, 3, 3, 3, 3.5, 3.5, 3.5, 3.5, 4, 4, 4, 4.5, 4.5, 5), y = c(3,
3.5, 2.5, 4, 3, 2, 4.5, 3.5, 2.5, 1.5, 5, 4, 3, 2, 1, 4.5, 3.5,
2.5, 1.5, 4, 3, 2, 3.5, 2.5, 3)), class = "data.frame", row.names = c(NA,
-25L))
Dataset2:
structure(list(group = 1:25, color = c("red", "brown1", "hotpink1",
"orange", "indianred1", "magenta", "darkgoldenrod1", "goldenrod1",
"gold", "deeppink", "yellow", "darkseagreen1", "aquamarine",
"plum", "mediumorchid4", "olivedrab1", "limegreen", "thistle1",
"violetred", "green4", "mediumseagreen", "darkviolet", "lightseagreen",
"dodgerblue2", "deepskyblue4"), alpha = c(0.3, 0.5, 0.6, 0, 0.7,
0, 0, 0, 0, 0, 0, 0.5, 0.3, 0, 0, 0, 0, 0.6, 0.8, 0.5, 0.7, 0.5,
0.5, 0.7, 0.5), x = c(1, 1.5, 1.5, 2, 2, 2, 2.5, 2.5, 2.5, 2.5,
3, 3, 3, 3, 3, 3.5, 3.5, 3.5, 3.5, 4, 4, 4, 4.5, 4.5, 5), y = c(3,
3.5, 2.5, 4, 3, 2, 4.5, 3.5, 2.5, 1.5, 5, 4, 3, 2, 1, 4.5, 3.5,
2.5, 1.5, 4, 3, 2, 3.5, 2.5, 3)), class = "data.frame", row.names = c(NA,
-25L))
ANSWER
Answered 2021-Dec-22 at 01:52If you're open to creating the plot in Python, the following approach would work:
import matplotlib.pyplot as plt
from matplotlib.patches import RegularPolygon
import numpy as np
data = {'group': np.arange(1, 26),
'color': ["red", "brown", "hotpink", "orange", "indianred", "magenta", "darkgoldenrod", "goldenrod", "gold", "deeppink", "yellow", "darkseagreen", "aquamarine", "plum", "mediumorchid", "olivedrab", "limegreen", "thistle", "violet", "green", "mediumseagreen", "darkviolet", "lightseagreen", "dodgerblue", "deepskyblue"],
'alpha': np.ones(25)}
fig, ax = plt.subplots()
ax.set_aspect('equal')
ax.axis('off')
ind = 0
N = 5
for x in np.arange(1, 2*N):
num_y = N - abs(x - N)
for y in range(N + num_y, N - num_y, -2):
hexagon = RegularPolygon((x, y/np.sqrt(3)), numVertices=6, radius=2 / 3, orientation=np.pi/2,
alpha=data['alpha'][ind],
facecolor=data['color'][ind], edgecolor='k')
ax.add_patch(hexagon)
ax.text(x, y/np.sqrt(3), f"Group{data['group'][ind]}", color='black', ha='center', va='center')
ind += 1
plt.autoscale(enable=True)
plt.show()
Community Discussions, Code Snippets contain sources that include Stack Exchange Network
Vulnerabilities
No vulnerabilities reported
Install 2019-04-climate-change
Support
Find, review, and download reusable Libraries, Code Snippets, Cloud APIs from over 650 million Knowledge Items
Find more librariesExplore Kits - Develop, implement, customize Projects, Custom Functions and Applications with kandi kits
Save this library and start creating your kit
Share this Page