How would I label the points in this scatter plot using numbers instead of colors?
Below is the code I am using, instead of the legend saying what color is related to what change I would like it to use numbers. It's hard to tell what color it is since I am using colored panels.
Code:
d=data.frame(x1=c(.5,2,.5,2),
x2 = c(2,3.5,2,3.5),
y1 = c(.5,.5,2,2),
y2 = c(2,2,3.2,3.2),
t=c('low,low','high,low','low,high','high,high'),
r=c('low,low','high,low','low,high','high,high'))
ggplot() +
geom_point(data = df, aes(x=df$Impact, y=df$Likelihood, colour = df$Change)) +
scale_x_continuous(name = "Impact", limits = c(.5,3.5),
breaks=seq(.5,3.5, 1), labels = seq(.5,3.5, 1)) +
scale_y_continuous(name = "Likelihood", limits = c(.5,3.2),
breaks=seq(.5, 3.2, 1), labels = seq(.5, 3.2, 1)) +
geom_rect(data=d,
mapping = aes(xmin = x1, xmax = x2, ymin = y1, ymax = y2, fill = t),
alpha = .5, color = "black")+
geom_text(data=d,
aes(x=x1+(x2-x1)/2, y=y1+(y2-y1)/2, label=r),
size=4)
I would like each item i.e 'Add Server' to correspond to a unique integer and then for that integer to be plotted. Thanks
Edit:
Dataframe structure:
Columns: Change (string), Impact (float), Likelihood (float)
dput(df)
structure(list(Change = c("Windows Patches\n-CRPDB1", "Change DNS settings",
"SSIS Schedule change\n-Warehouse", "OnBase Upgrade", "Add Server",
"Change IL Parameter", "Code Change - Validation missing", "Mass Update Data in Infolease",
"User add, remove or update user permission", "ServiceNow Deployment",
"Creating of a sever or desktop image for mass deployment", "Database table update. Column add/modify",
"Update add PRTG/Sensor"), Impact = c(3, 1.8, 2.6, 2.3, 1, 2.25,
1.8, 1.95, 1.3, 1.5, 1.8, 1, 1), Likelihood = c(3, 1.75, 1.7,
1.6, 1.3, 1.15, 1.15, 1.15, 1.15, 1.1, 1, 1, 1)), class = "data.frame", row.names = c(NA,
-13L))
You can keep the aesthetic mapping between change & colour in order to create a legend, while setting that layer invisible so that it doesn't detract from the overall picture:
df$ID <- seq(1, nrow(df))
df$Legend <- paste0(df$ID, ". ", df$Change)
df$Legend <- factor(df$Legend,
levels = df$Legend[order(df$ID)])
p <- ggplot() +
# text layer to position the numbers
geom_text(data = df,
aes(x = Impact, y = Likelihood, label = ID)) +
# invisible layer to create legend for the numbers
geom_point(data = df,
aes(x = Impact, y = Likelihood, colour = Legend),
alpha = 0, size = 0) +
# rest of the code is unchanged
scale_x_continuous(name = "Impact", limits = c(.5,3.5),
breaks=seq(.5,3.5, 1), labels = seq(.5,3.5, 1)) +
scale_y_continuous(name = "Likelihood", limits = c(.5,3.2),
breaks=seq(.5, 3.2, 1), labels = seq(.5, 3.2, 1)) +
geom_rect(data=d,
aes(xmin = x1, xmax = x2, ymin = y1, ymax = y2, fill = t),
alpha = .5, color = "black") +
geom_text(data=d,
aes(x=x1+(x2-x1)/2, y=y1+(y2-y1)/2, label=r),
size=4)
p
In addition, if you want to remove the empty grey legend keys, set its key width to 0:
p + scale_color_discrete(guide = guide_legend(keywidth = unit(0, "pt")))
I cannot think of a way to do this using only ggplot2 functions, but maybe there is an elegant way to do so. Instead, you can use gridExtra and a tableGrob to display the correct legend.
I replace your call to geom_point() with a call to geom_text(), convert to a grob, then create a table grob with the text you want displayed in the legend, and finally arrange the two grobs.
# load your data as d and df
library(grid)
library(gridExtra)
# add in a Label column with numbers
df$Label <- 1:nrow(df)
g2 <- ggplot() +
geom_text(data = df, aes(x = Impact, y = Likelihood, label = Label)) +
scale_x_continuous(
name = "Impact",
limits = c(.5,3.5),
breaks=seq(.5,3.5, 1),
labels = seq(.5,3.5, 1)
) +
scale_y_continuous(
name = "Likelihood",
limits = c(.5,3.2),
breaks=seq(.5, 3.2, 1),
labels = seq(.5, 3.2, 1)
) +
geom_rect(
data = d,
mapping = aes(xmin = x1, xmax = x2, ymin = y1, ymax = y2, fill = t),
alpha = .5,
color = "black"
) +
geom_text(data = d, aes(x=x1+(x2-x1)/2, y=y1+(y2-y1)/2, label=r), size=4)
g2_grob <- ggplotGrob(g2)
# pasted the two columns together for it to appear a little nicer
tab_leg <- tableGrob(
paste(df$Label,"-", df$Change),
theme = ttheme_minimal(
core = list(fg_params = list(hjust=0, x=0.1,fontsize=8))
)
)
# arrange the plot and table
grid.arrange(arrangeGrob(
g2_grob, nullGrob(), tab_leg, nullGrob(),
layout_matrix = matrix(1:4, ncol = 4),
widths = c(6,.5,2,1)
))
If you want to move the region legend around, you can check out this answer: Show the table of values under the bar plot.
Related
I am trying to track the peak velocity day to day, so eventually there will be more data points, but I want the 2 names to be different colors and not connected to eachother. The top data point is for "Ben" and the bottom data point is for "Pete". How do I change this. Here is my code and a picture of the plot and table.
Jump_vel_tracking <- ggplot(Jump_tibble, aes(x = date(), y = daily_max_vel, color = 'red3')) +
geom_point() +
geom_line() +
scale_y_continuous(breaks = seq(from = 3.5, to = 3.8, by = 0.1), limits = c(3.5, 3.8)) +
labs(x = 'Date', y = 'Peak Velocity (m/s)', title = "CMJ Peak Velocity")
Instead of letting color 'red3', set as athlete
Jump_vel_tracking <- ggplot(Jump_tibble, aes(x = date(), y = daily_max_vel, color = athlete)) +
geom_point() +
geom_line() +
scale_y_continuous(breaks = seq(from = 3.5, to = 3.8, by = 0.1), limits = c(3.5, 3.8)) +
labs(x = 'Date', y = 'Peak Velocity (m/s)', title = "CMJ Peak Velocity")
I tried lately to annotate a graph with boxes above a ggplot.
Here is what I want:
I found a way using grid, but I find it too complicated, and I am quite sure there is a better way to do it, more ggplot2 friendly. Here is the example and my solution:
the data:
y2 <- 350
mesure_pol <- data.frame(x1 = c(1,4,7),
x2 = c(4,7,10),
politiquecat = c(1:3),
politique = c("Phase 1\n","Phase 2\n","Phase 3\n"),
y = c(y2,y2,y2)
)
mesure_pol$x_median <- (mesure_pol$x1 + mesure_pol$x2)/2
colorpal <- viridis::inferno(n=3,direction = -1)
plot
the main plot
p <- ggplot(data = mesure_pol) +
geom_rect(aes(xmin = x1,
xmax = x2,
ymin = 0,
ymax = 300,
fill = as.factor(politiquecat)),
fill = colorpal,
color = "black",
size = 0.3,
alpha = 0.2)+
theme(plot.margin=unit(c(60, 5.5, 5.5, 5.5), "points"))+
coord_cartesian(clip = 'off')
the annotation part
Here is the part I am not happy with:
for (i in 1:dim(mesure_pol)[1]) {
text <- textGrob(label = mesure_pol[i,"politique"], gp = gpar(fontsize=7,fontface="bold"),hjust = 0.5)
rg <- rectGrob(x = text$x, y = text$y, width = stringWidth(text$label) - unit(3,"mm") ,
height = stringHeight(text$label) ,gp = gpar(fill=colorpal[i],alpha = 0.3))
p <- p + annotation_custom(
grob = rg,
ymin = mesure_pol[i,"y"], # Vertical position of the textGrob
ymax = mesure_pol[i,"y"],
xmin = mesure_pol[i,"x_median"], # Note: The grobs are positioned outside the plot area
xmax = mesure_pol[i,"x_median"]) +
annotation_custom(
grob = text,
ymin = mesure_pol[i,"y"], # Vertical position of the textGrob
ymax = mesure_pol[i,"y"],
xmin = mesure_pol[i,"x_median"], # Note: The grobs are positioned outside the plot area
xmax = mesure_pol[i,"x_median"])
}
Is there a simplier/nicer way to obtain similar result ? I tried with annotate, label but without any luck.
An alternative approach to achieve the desired result would be to make the annotations via a second ggplot which could be glued to the main plot via e.g. patchwork.
For the annotation plot I basically used your code for the main plot, added a geom_text layer, get rid of the axix, etc. via theme_void and set the limits in line with main plot. Main difference is that I restrict the y-axis to a 0 to 1 scale. Besides that I shifted the xmin, xmax, ymin and ymax values to add some space around the rectangels (therefore it is important to set the limits).
library(ggplot2)
library(patchwork)
y2 <- 350
mesure_pol <- data.frame(x1 = c(1,4,7),
x2 = c(4,7,10),
politiquecat = c(1:3),
politique = c("Phase 1\n","Phase 2\n","Phase 3\n"),
y = c(y2,y2,y2)
)
mesure_pol$x_median <- (mesure_pol$x1 + mesure_pol$x2)/2
colorpal <- viridis::inferno(n=3,direction = -1)
p <- ggplot(data = mesure_pol) +
geom_rect(aes(xmin = x1,
xmax = x2,
ymin = 0,
ymax = 300,
fill = as.factor(politiquecat)),
fill = colorpal,
color = "black",
size = 0.3,
alpha = 0.2)
ann <- ggplot(data = mesure_pol) +
geom_rect(aes(xmin = x1 + 1,
xmax = x2 - 1,
ymin = 0.2,
ymax = 0.8,
fill = as.factor(politiquecat)),
fill = colorpal,
color = "black",
size = 0.3,
alpha = 0.2) +
geom_text(aes(x = x_median, y = .5, label = politique), vjust = .8, fontface = "bold", color = "black") +
coord_cartesian(xlim = c(1, 10), ylim = c(0, 1)) +
theme_void()
ann / p +
plot_layout(heights = c(1, 4))
By setting a second x-axis and filling the background of the new axis labels with element_markdown from the ggtext package. You may achieve this:
Here is the code:
library(ggtext)
y2 <- 350
mesure_pol <- data.frame(x1 = c(1,4,7),
x2 = c(4,7,10),
politiquecat = c(1:3),
politique = c("Phase 1\n","Phase 2\n","Phase 3\n"),
y = c(y2,y2,y2)
)
mesure_pol$x_median <- (mesure_pol$x1 + mesure_pol$x2)/2
p <- ggplot(data = mesure_pol) +
geom_rect(aes(xmin = x1,
xmax = x2,
ymin = 0,
ymax = 300,
fill = as.factor(politiquecat)),
fill = c("yellow", "red", "black"),
color = "black",
size = 0.3,
alpha = 0.2) +
scale_x_continuous(sec.axis = dup_axis(name = "",
breaks = c(2.5, 5.5, 8.5),
labels = c("Phase 1", "Phase 2", "Phase 3"))) +
theme(plot.margin=unit(c(60, 5.5, 5.5, 5.5), "points"),
axis.ticks.x.top = element_blank(),
axis.text.x.top = element_markdown(face = "bold",
size = 12,
fill = adjustcolor(c("yellow", "red", "black"),
alpha.f = .2)))+
coord_cartesian(clip = 'off')
I would like to add labels to the end of lines in ggplot, avoid them overlapping, and avoid them moving around during animation.
So far I can put the labels in the right place and hold them static using geom_text, but the labels overlap, or I can prevent them overlapping using geom_text_repel but the labels do not appear where I want them to and then dance about once the plot is animated (this latter version is in the code below).
I thought a solution might involve effectively creating a static layer in ggplot (p1 below) then adding an animated layer (p2 below), but it seems not.
How do I hold some elements of a plot constant (i.e. static) in an animated ggplot? (In this case, the labels at the end of lines.)
Additionally, with geom_text the labels appear as I want them - at the end of each line, outside of the plot - but with geom_text_repel, the labels all move inside the plotting area. Why is this?
Here is some example data:
library(dplyr)
library(ggplot2)
library(gganimate)
library(ggrepel)
set.seed(99)
# data
static_data <- data.frame(
hline_label = c("fixed_label_1", "fixed_label_2", "fixed_label_3", "fixed_label_4",
"fixed_label_5", "fixed_label_6", "fixed_label_7", "fixed_label_8",
"fixed_label_9", "fixed_label_10"),
fixed_score = c(2.63, 2.45, 2.13, 2.29, 2.26, 2.34, 2.34, 2.11, 2.26, 2.37))
animated_data <- data.frame(condition = c("a", "b")) %>%
slice(rep(1:n(), each = 10)) %>%
group_by(condition) %>%
mutate(time_point = row_number()) %>%
ungroup() %>%
mutate(score = runif(20, 2, 3))
and this is the code I am using for my animated plot:
# colours for use in plot
condition_colours <- c("red", "blue")
# plot static background layer
p1 <- ggplot(static_data, aes(x = time_point)) +
scale_x_continuous(breaks = seq(0, 10, by = 2), expand = c(0, 0)) +
scale_y_continuous(breaks = seq(2, 3, by = 0.10), limits = c(2, 3), expand = c(0, 0)) +
# add horizontal line to show existing scores
geom_hline(aes(yintercept = fixed_score), alpha = 0.75) +
# add fixed labels to the end of lines (off plot)
geom_text_repel(aes(x = 11, y = fixed_score, label = hline_label),
hjust = 0, size = 4, direction = "y", box.padding = 1.0) +
coord_cartesian(clip = 'off') +
guides(col = F) +
labs(title = "[Title Here]", x = "Time", y = "Mean score") +
theme_minimal() +
theme(panel.grid.minor = element_blank(),
plot.margin = margin(5.5, 120, 5.5, 5.5))
# animated layer
p2 <- p1 +
geom_point(data = animated_data,
aes(x = time_point, y = score, colour = condition, group = condition)) +
geom_line(data = animated_data,
aes(x = time_point, y = score, colour = condition, group = condition),
show.legend = FALSE) +
scale_color_manual(values = condition_colours) +
geom_segment(data = animated_data,
aes(xend = time_point, yend = score, y = score, colour = condition),
linetype = 2) +
geom_text(data = animated_data,
aes(x = max(time_point) + 1, y = score, label = condition, colour = condition),
hjust = 0, size = 4) +
transition_reveal(time_point) +
ease_aes('linear')
# render animation
animate(p2, nframes = 50, end_pause = 5, height = 1000, width = 1250, res = 120)
Suggestions for consideration:
The specific repelling direction / amount / etc. in geom_text_repel is determined by a random seed. You can set seed to a constant value in order to get the same repelled positions in each frame of animation.
I don't think it's possible for repelled text to go beyond the plot area, even if you turn off clipping & specify some repel range outside plot limits. The whole point of that package is to keep text labels away from one another while remaining within the plot area. However, you can extend the plot area & use geom_segment instead of geom_hline to plot the horizontal lines, such that these lines stop before they reach the repelled text labels.
Since there are more geom layers using animated_data as their data source, it would be cleaner to put animated_data & associated common aesthetic mappings in the top level ggplot() call, rather than static_data.
Here's a possible implementation. Explanation in annotations:
p3 <- ggplot(animated_data,
aes(x = time_point, y = score, colour = condition, group = condition)) +
# static layers (assuming 11 is the desired ending point)
geom_segment(data = static_data,
aes(x = 0, xend = 11, y = fixed_score, yend = fixed_score),
inherit.aes = FALSE, colour = "grey25") +
geom_text_repel(data = static_data,
aes(x = 11, y = fixed_score, label = hline_label),
hjust = 0, size = 4, direction = "y", box.padding = 1.0, inherit.aes = FALSE,
seed = 123, # set a constant random seed
xlim = c(11, NA)) + # specify repel range to be from 11 onwards
# animated layers (only specify additional aesthetic mappings not mentioned above)
geom_point() +
geom_line() +
geom_segment(aes(xend = time_point, yend = score), linetype = 2) +
geom_text(aes(x = max(time_point) + 1, label = condition),
hjust = 0, size = 4) +
# static aesthetic settings (limits / expand arguments are specified in coordinates
# rather than scales, margin is no longer specified in theme since it's no longer
# necessary)
scale_x_continuous(breaks = seq(0, 10, by = 2)) +
scale_y_continuous(breaks = seq(2, 3, by = 0.10)) +
scale_color_manual(values = condition_colours) +
coord_cartesian(xlim = c(0, 13), ylim = c(2, 3), expand = FALSE) +
guides(col = F) +
labs(title = "[Title Here]", x = "Time", y = "Mean score") +
theme_minimal() +
theme(panel.grid.minor = element_blank()) +
# animation settings (unchanged)
transition_reveal(time_point) +
ease_aes('linear')
animate(p3, nframes = 50, end_pause = 5, height = 1000, width = 1250, res = 120)
I have 2 data frames such as these:
df1 <- data.frame(
party = c("Blue Party", "Red Party"),
dim1 = c(0.03, -0.04),
dim2 = c(-0.05, 0.02),
sz = c(34, 42)
)
df2 <- data.frame(
var = c("Economic", "Gov trust", "Inst trust", "Nationalism", "Religiosity"),
dim1 = c(0.1, -0.5, 0, 0.6, 0.4),
dim2 = c(0.1, 0.6, 0, 0, 0.3)
)
I want to plot the parties from df1 as points defined by size and include arrows based on df2 on the same graph. I've used ggplot to do this:
ggplot(df1, aes(x = dim1, y = dim2, color = party)) +
geom_point(size = df1$sz) +
scale_size_area() +
scale_x_continuous(limits = c(-1.5, 1.5)) +
scale_y_continuous(limits = c(-1.5, 1.5)) +
geom_label_repel(aes(label = party),
box.padding = 1,
point.padding = 1.5,
force = 1) +
geom_segment(aes(xend=0, yend=0, x=dim1, y=dim2), data=df2,
arrow=arrow(length=unit(0.20,"cm"), ends="first", type = "closed"), color="black") +
geom_text_repel(aes(x=dim1, y=dim2, label=var),
data = df2, color = "black", size = 3, force = 1)
Resulting in this:
The functions geom_label_repel and geom_text_repel prevent the party labels and the texts from overlapping, but how can I repel the labels and texts from each other?
My second problem is that I want to order the points, with the smallest in the front and the largest at the back. How could this be done?
Appreciate the help!
What I have here are two graphs "PlotA" and "PlotB", however I want a combined graph with geom_pointranges showing points, geom_line showing the line and geom_ribbon showing the standard deviation.
water <- c(35,40,42,46,48,50)
depth <- c(1,2,3,4,5,6)
sd <- c(10,10,10,10,10,10)
dataA <- data.frame(depth, water, sd)
from <- c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5)
to <- c(1.5, 2.5, 3.5, 4.5, 5.5, 6.5)
depth1 <- c(1,2,3,4,5,6)
water1 <- c(40,32,50,55,62,30)
dataB <- data.frame(from,to,depth1, water1)
# Load necessary packages
require(ggplot2)
# Plotting Started
#PlotA
ggplot(data=dataA, aes(x = water, y = depth), na.rm=T) +
geom_path(size=0.4, color="black")+
geom_pointrange(data=dataB, aes(water1, depth1, ymin=from, ymax=to), size=0.1, color='black') +
scale_y_reverse(lim = c(10,0), breaks = seq(0,10,1)) +
theme_bw(12) +
scale_x_continuous(lim =c(0,100), breaks = seq(0,100,20))
#PlotB
ggplot() + geom_ribbon(data=dataA, aes(x=depth, y=water, ymin = water - sd, ymax = water + sd), alpha=0.3, fill='grey12') + coord_flip() +
scale_x_reverse(lim = c(10,0), breaks = seq(0,10,1)) + theme_bw(12) +
scale_y_continuous(lim =c(0,100), breaks = seq(0,100,20))
coord_flip is difficult to use well in the middle of a plot. I strongly recommend debugging plots without it and then adding it as the last step.
I think this is what you're looking for. If not, please describe your desired result in more detail.
ggplot(data = dataA, aes(x = depth, y = water)) +
geom_ribbon(
data = dataA,
aes(
x = depth,
ymin = water - sd,
ymax = water + sd
),
alpha = 0.3,
fill = 'grey12'
) +
geom_path(size = 0.4, color = "black") +
geom_point(
data = dataB,
aes(x = depth1, y = water1),
size = 0.1,
color = 'black'
) +
geom_errorbarh(
data = dataB,
aes(
x = depth1,
xmin = from,
xmax = to,
y = water1
),
size = 0.1,
height = 0
) +
theme_bw(12) +
scale_x_reverse(lim = c(10, 0), breaks = seq(0, 10, 1)) +
scale_y_continuous(lim = c(0, 100), breaks = seq(0, 100, 20)) +
coord_flip()