Related
While making a nomogram of Remotion related to Depth and Time of sedimentation, I need to fit curves (as paraboles) to remotion labels if they are lower than its upper ten (7 ceils to 10, and 18 to 20). This is very close to what I need.
data.frame(
depth=rep(seq(0.5, 3.5, 0.5), each=8),
time=rep(seq(0, 280, 40), times=7),
ss = c(
820,369,238,164,107,66,41,33,
820,224,369,279,213,164,115,90,
820,631,476,361,287,230,180,148,
820,672,558,426,353,287,238,187,
820,713,590,492,402,344,262,230,
820,722,615,533,460,394,320,262,
820,738,656,574,492,418,360,303)
) %>%
transmute(
depth = depth,
time = time,
R = 100*(1- ss/820)
) %>%
mutate(G=factor(round(R, digits=-1))) %>%
ggplot(aes(x=time, y=depth, colour=time))+
geom_label(aes(label=round(R)))+
scale_y_continuous(trans = "reverse")+
geom_path(aes(group=G))
But it is not getting parabolical curves. How can I smooth them under the tens condition?
I'm not sure if this is what you're looking for. I separated the data and the plot and applied stat_smooth for each group. Unfortunately, the smoothed lines do not follow the color scheme. You will also see several warnings do to the method in which this creates the splines.
plt <- ggplot(df1, aes(x=time, y=depth, colour = time)) +
geom_label(aes(label=round(R))) +
scale_y_continuous(trans = "reverse") +
geom_path(aes(group=G), size = .6, alpha = .5)
lapply(1:length(unique(df1$G)),
function(i){
df2 <- df1 %>% filter(G == unique(G)[i])
plt <<- plt +
stat_smooth(data = df2, size = .5,
aes(x = time, y = depth),
se = F, method = lm, color = "darkred",
formula = y ~ splines::bs(x, knots = nrow(df2)))
})
You can extend this further with additional parameters. I'm just not sure exactly what you're expecting.
plt <- ggplot(df1, aes(x=time, y=depth, colour = time)) +
geom_label(aes(label=round(R))) +
scale_y_continuous(trans = "reverse") +
geom_path(aes(group=G), size = .6, alpha = .5)
lapply(1:length(unique(df1$G)),
function(i){
df2 <- df1 %>% filter(G == unique(G)[i])
# u <- df1 %>% {nrow(unique(.[,c(1:2)]))}
plt <<- plt +
stat_smooth(
data = df2, size = .5,
aes(x = time, y = depth),
se = F, method = lm, color = "darkred",
formula = y ~ splines::bs(x, knots = nrow(df2),
degree = ifelse(nrow(df2) <= 4,
3, nrow(df2) - 2)))
})
I have data and a plot like this,
x = c(1,2,3,4,5,6,7,8,9,10,11,12)
y1 = x^2-5
y2 = -x^2+1
data <- data.frame(x,y1,y2)
data1 = data.frame(pivot_longer(data,2:3))
ggplot(data1, aes(x, y = value, color = name))+
geom_point()+
geom_smooth(method = 'lm',se = FALSE)
Is there a way to have the trendline only applying to values for x greater than a certain number, like 3?
You can do this:
ggplot(data1, aes(x, y = value, color = name))+
geom_point()+
geom_smooth(data=dplyr::filter(data1,x>3), method = 'lm',se = FALSE)
You can apply the current aes to geom_point only, and create a new column (i.e. x2 in my code) for mapping to geom_smooth.
library(tidyverse)
x = c(1,2,3,4,5,6,7,8,9,10,11,12)
y1 = x^2-5
y2 = -x^2+1
data <- data.frame(x,y1,y2)
data1 = data.frame(pivot_longer(data,2:3))
data1 %>% mutate(x2 = ifelse(x > 3, x, NA)) %>%
ggplot()+
geom_point(aes(x, y = value, color = name)) +
geom_smooth(aes(x2, y = value, color = name), method = 'lm',se = FALSE)
Created on 2022-05-07 by the reprex package (v2.0.1)
Similar to both above just using subset:
ggplot(data1, aes(x, y = value, color = name))+
geom_point()+
geom_smooth(data=subset(data1, x > 3), method = 'lm',se = FALSE)
I am trying to get a combined bar + point chart with a legend for both bars different Indicators) and points (a change in the Indicator). I tried to follow along with ggplot2 legend for plot combining geom_bar and geom_point and introduced a shape into my geom_point (without doing that I could not get a legend for points).
library(ggplot2)
library(dplyr)
library(ggthemes)
library(plotly)
set.seed(369)
obs <- 6
values1 <- c(round(100 + rnorm(obs) * 10, 2))
values2 <- c(round(100 + rnorm(obs) * 10, 2))
df <- data.frame(Year = rep(2014:2019, 2*2),
value = c(rep(values1, 2), rep(values2, 2)),
Indicator = rep(c("Indicator1", "Indicator2"), each = obs * 2),
Type = rep(c("Bar", "Point"), each = obs))
p <- ggplot(df, aes(value))
bars <- df %>%
filter(Type == "Bar")
points <- df %>%
filter(Type == "Point")
pl <- p +
geom_bar(data = bars,
aes(fill = Indicator, group = Indicator, x = Year, y = value), stat = "identity", position = "dodge") +
geom_point(data = points, aes(x = Year, y = value, group = Indicator, fill = Indicator, shape = "Change"), position = position_dodge(width = 0.9)) +
theme_tufte()
p
ggplotly(pl, tooltip = c("value"))
ggplotly has the output I want, however the legend has a strange grouping. Is there a way to fix the legend in the chart below?
there's probably a better way, but how's this:
library(tidyverse)
obs <- 6
values1 <- c(round(100 + rnorm(obs) * 10, 2))
values2 <- c(round(100 + rnorm(obs) * 10, 2))
df <- data.frame(Year = rep(2014:2019, 2*2),
value = c(rep(values1, 2), rep(values2, 2)),
Indicator = rep(c("Indicator1", "Indicator2"), each = obs * 2),
Type = rep(c("Bar", "Point"), each = obs))
bars <- df %>% filter(Type == "Bar")
points <- df %>% filter(Type == "Point") %>% mutate(Year =
ifelse(Indicator == "Indicator1", Year - 0.25, Year + 0.25))
p <- ggplot(bars, aes(fill = Indicator, group = Indicator, x = Year, y = value)) +
geom_bar(stat = "identity", position = "dodge", width = 1)
p <- p + geom_point(data = points, mapping = aes(fill = Indicator, x =
Year, y = value), shape = 21) + labs(x = "value") + labs(y = "value")
p
I don't know ggplotly() , but building separate geom_bar() and geom_point() plots, and then using get_legend() to remove each legend, and then building them back with plot_grid with the full plot seems a decent option.
library(tidyverse)
obs <- 6
values1 <- c(round(100 + rnorm(obs) * 10, 2))
values2 <- c(round(100 + rnorm(obs) * 10, 2))
df <- data.frame(Year = rep(2014:2019, 2*2),
value = c(rep(values1, 2), rep(values2, 2)),
Indicator = rep(c("Indicator1", "Indicator2"), each = obs * 2),
Type = rep(c("Bar", "Point"), each = obs))
bars <- df %>% filter(Type == "Bar")
points <- df %>% filter(Type == "Point") %>% mutate(Year =
ifelse(Indicator == "Indicator1", Year - 0.25, Year + 0.25),
IndicatorChange = Indicator)
p1 <- ggplot(points, mapping = aes(fill = IndicatorChange, x = Year, y = value )) + labs(x = "value") + labs(y = "value") +
geom_point(shape = 21)
p1_leg <- get_legend(p1)
p2 <- ggplot(bars, aes(fill = Indicator, group = Indicator, x = Year, y = value)) +
geom_bar(stat = "identity", position = "dodge")
p2_leg <- get_legend(p2)
p_leg <- plot_grid(p1_leg, p2_leg, ncol = 1, nrow = 5) #toggle nrow to get right spacing between legends
p3 <-ggplot(bars, aes(fill = Indicator, group = Indicator, x = Year, y = value)) + geom_bar(stat = "identity", position = "dodge", width = 1)
p3 <- p3 + geom_point(data = points, mapping = aes(fill = Indicator, x = Year, y = value), shape = 21) +
labs(x = "value") + labs(y = "value")
p3 <- p3 + theme(legend.position="none")
p3
p <- plot_grid(p3, p_leg, ncol =2, nrow =2) #more toggling possible
p
I don't know whether this is what you want(although the font size of the legend should be modified):
library(ggplot2)
library(dplyr)
library(ggthemes)
library(plotly)
set.seed(369)
obs <- 6
values1 <- c(round(100 + rnorm(obs) * 10, 2))
values2 <- c(round(100 + rnorm(obs) * 10, 2))
df <- data.frame(Year = rep(2014:2019, 2*2),
value = c(rep(values1, 2), rep(values2, 2)),
Indicator = rep(c("Indicator1", "Indicator2"), each = obs * 2),
Type = rep(c("Bar", "Point"), each = obs))
p <- ggplot(df, aes(value))
bars <- df %>%
filter(Type == "Bar")
points <- df %>%
filter(Type == "Point")
points$Type1=paste(points$Indicator,"change",sep=",")
pl <- p +
geom_bar(data = bars,
aes(fill = Indicator, group = Indicator, x = Year, y = value), stat = "identity", position = "dodge") +
geom_point(data = points,
aes(x = Year, y = value, group = Indicator, fill = Indicator, shape = "Change"),
position = position_dodge(width = 0.9)) +
theme_tufte()+
theme(legend.position="bottom")
pl <- p +
geom_bar(data = bars,
aes(fill = Indicator, group = Indicator,x = Year, y = value), stat = "identity", position = "dodge") +
geom_point(data = points,
aes(x = Year, y = value,shape = Type1),
position = position_dodge(width = 0.9)) +
theme_tufte()+
theme(legend.position="bottom",
legend.title=element_blank())
p
I'm trying to create a boxplot using ggplot2 with :
X as a continuous variable
Colors for different groups
Here is an example :
x <- sample(c(1,2,5),300,replace = TRUE)
y <- sapply(x,function(mu) rnorm(1,mean = mu))
color <- sample(c("color 1","color 2"),300,replace = TRUE)
data <- data.frame(x, y, color)
I can either have colors and x as a factor :
ggplot(data = data) + geom_boxplot(aes(x = factor(x),y = y,col = color))
or x as a continuous variable and no colors :
ggplot(data = data) + geom_boxplot(aes(x = x,y = y,group = x))
But not both.
Does somebody know how to do this ?
Thanks
I think you need one more column for group, which is the combination of color and x. For example, how about simply paste()ing them?
set.seed(1)
x <- sample(c(1,2,5),300,replace = TRUE)
y <- sapply(x,function(mu) rnorm(1,mean = mu))
color <- sample(c("color 1","color 2"),300,replace = TRUE)
data <- data.frame(x, y, color)
library(ggplot2)
ggplot(data = data) +
geom_boxplot(aes(x = x, y = y, col = color, group = paste(color, x)))
You can use scales to change the x-axis scale.
library(ggplot2)
library(scales)
x <- sample(c(1,2,5),300,replace = TRUE)
y <- sapply(x,function(mu) rnorm(1,mean = mu))
color <- sample(c("color 1","color 2"),300,replace = TRUE)
data <- data.frame(x, y, color)
ggplot(data = data) + geom_boxplot(aes(x = factor(x),y = y,col = color)) + scale_x_discrete(limit = c('1','2','3','4','5'))
Hack for dynamic limits:
min = min(data$x)
max = max(data$x)
limits <- as.character(seq(min:max))
ggplot(data = data) + geom_boxplot(aes(x = factor(x),y = y,col = color)) + scale_x_discrete(limit = limits)
You could misuse the fill aesthetic:
ggplot(data = data) +
geom_boxplot(aes(x = x, y = y, col = color, fill = factor(x))) +
scale_fill_manual(values = rep(NA, 3), guide = "none")
I have the following dataframe:
data <- data.frame(x = c(5,1,3,2,5,7,12), y = c(5,7,6,1,3,5,6))
I can plot these coordinates with the ggplot function and draw a line between these coordinates:
ggplot(data, aes(x, y)) + geom_point(size = 3) + geom_line()
So far, no problems. But instead of a single line though the coordinates, I want that a line is drawn between all the coordinates. Creating a sort of spider web between all the coordinates. Is this possible in the ggplot2 package?
If you want to do this in ggplot2, then you could use geom_segment for this. But before you can make such a plot, you have to create a dataframe which connencts each observation to the other observations. You could approach it as follows:
library(ggplot2)
library(dplyr)
library(tidyr)
dat %>%
complete(nesting(x,y), id) %>% # create the combinations
select(id, xend=x, yend=y) %>% # rename the new variables as end-points
left_join(dat, ., by = 'id') %>% # join with the original dataframe
filter(!(x==xend & y==yend)) %>% # remove the endpoints that are the same as the start points
ggplot(., aes(x, y)) +
geom_segment(aes(x = x, y = y, xend = xend, yend = yend)) +
geom_label(aes(x = x, y = y, label = id, color = factor(id)), show.legend = FALSE) +
theme_minimal(base_size = 14) +
theme(axis.title = element_blank())
which gives:
Used data:
dat <- data.frame(x = c(5,1,3,2,5,7,12), y = c(5,7,6,1,3,5,6))
dat$id <- 1:nrow(dat)
Alternatively, you can also add the row-id on the fly without doing it beforehand:
dat %>%
mutate(id = row_number()) %>% # add a row id
complete(nesting(x,y), id) %>% # create the combinations
select(id, xend=x, yend=y) %>% # rename the new variables as end-points
left_join(dat %>% mutate(id = row_number()), .,
by = 'id') %>% # join with the original dataframe (also with an added row id)
filter(!(x==xend & y==yend)) %>% # remove the endpoints that are the same as the start points
ggplot(., aes(x, y)) +
geom_segment(aes(x = x, y = y, xend = xend, yend = yend)) +
geom_label(aes(x = x, y = y, label = id, color = factor(id)), show.legend = FALSE) +
theme_minimal(base_size = 14) +
theme(axis.title = element_blank())
Using base plotting:
plot(data)
sapply(combn(nrow(data), 2L, simplify = FALSE),
function(x) do.call("segments", as.list(c(t(data[x, ])))))
Add bells and whistles to taste.
You may also use the FUN argument in combn:
plot(data)
combn(nrow(data), 2L, simplify = FALSE, FUN = function(cm){
segments(x0 = data[cm[1L], 1L],
y0 = data[cm[1L], 2L],
x1 = data[cm[2L], 1L],
y1 = data[cm[2L], 2L])
})