Suppose I have
y <- 10:15
x <- 1:6
ggplot()+geom_line(aes(x = x,y = y))+scale_y_continuous(limits = c(min(y),max(y)),sec.axis = sec_axis(trans = ~. )
I want a transformation on the secondary axis that gives me values from 0 to 1. That is, getting the y value, subtract min (y) and then divide the resulting number by (max (y) - min (y).
The problem is, I have to get the number, subtract min (y), and then I have to transform again. I can't do this. If I try trans = ~.-min(y)/(max(y)-min(y)), I don't get what I want. How can I make it understand (yvalue - min y) is my new value, and then divide it?
You can wrap your calculation steps in a temporary function:
y <- 10:15
x <- 1:6
my_fun <- function(y) {
(y - min(y)) / (max(y)-min(y))
}
ggplot() +
geom_line(aes(x = x,y = y)) +
scale_y_continuous(limits = c(min(y),
max(y)),
sec.axis = sec_axis(trans = ~ my_fun(.) ))
Related
I have a lot of measurements where I get data that looks something like this:
# Generate example data
x <- 1:100
y <- 100*(1-exp(-0.3*x))
x2 <- 101:200
y2 <- rev(y)
df <- data.frame("x" = c(x, x2),
"y" = c(y, y2))
df$x <- df$x + 50
rm(x, x2, y, y2)
x <- 1:50
y <- 25.91818
x2 <- 251:300
y2 <- 25.91818
df2 <- data.frame("x" = c(x, x2),
"y" = c(y, y2))
rm(x, x2, y, y2)
df <- rbind(df, df2)
rm(df2)
If I plot this I can see that there are left-most and right-most local minima.
library(ggplot2)
p <- ggplot(df, aes(x,y))+
geom_line()+
geom_point(data = data.frame("x" = c(50, 250), "y" = c(25.91818, 25.91818)),
mapping = aes(x, y), colour = "red")+
scale_y_continuous(limits = c(0, 101))
p + annotate("text", label = "minimum 1", x = 50, y = 20) +
annotate("text", label = "minimum 2", x = 250, y = 20)
What I would like to do is trim those data that are to the left of minimum 1 and right of minimum 2. It's not super straightforward as there may also be local minima between those two points, because the real data doesn't look this ideal. I would also need to apply this process to many many samples, but I think this may be trivial because I could use e.g. dplyr and group_by().
I had some luck plotting the local minima using the ggpmisc package, but I'm not sure how I can use that to actually subset my data. Just for clarity I included the code to do so below, and with the real data it looks a little better:
library(ggpmisc)
p2 <- ggplot(df, aes(x, y))+
geom_line()+
ggpmisc::stat_peaks(col="red", span=3)
p2
I hope this is clear and I'm happy to clarify any questions. Thank you in advance.
You could do this using the following steps:
Sort your data according to its x co-ordinates
On your sorted data, find the diff of the y co-ordinates, which will be 0 (or close to 0) for the flat sections at either end (as well as any flat sections in between)
Starting from the left, find the first point where the diff is not zero (or at least is above a minimal threshold). Store this index as a variable called left
Starting from the right, find the first point where the diff is not zero (or at least is above a minimal threshold). Store this index as a variable called right
Subset your data frame so it only contains the data between rows left:right
So, in your example we would have:
# Define a minimal threshold above which we are not at the minimum line
minimal_change <- 1e-6
df <- df[order(df$x),] # Step 1
left <- which(diff(df$y) > minimal_change)[1] # Step 2
right <- nrow(df) - which(diff(rev(df$y)) > minimal_change)[1] + 1 # Step 3
df <- df[left:right, ] # Step 4
Now we can plot the result:
ggplot(df, aes(x, y)) +
geom_line()+
geom_point(data = data.frame("x" = c(50, 250), "y" = c(25.91818, 25.91818)),
mapping = aes(x, y), colour = "red") +
scale_y_continuous(limits = c(0, 101)) +
scale_x_continuous(limits = c(0, 300))
I am building a plot with ggplot. I have data where y is mostly independent of X, but I randomly have a few extreme values of Y at low values of X. Like this:
set.seed(1)
X <- rnorm(500, mean=5)
y <- rnorm(500)
y[X < 3] <- sample(c(0, 1000), size=length(y[X < 3]),prob=c(0.9, 0.1),
replace=TRUE)
I want to make the point that the MEDIAN y-value is still constant over X values. I can see that this is basically true here:
mean(y[X < 3])
median(y[X < 3])
If I make a geom_smooth() plot, it does mean, and is very affected by outliers:
ggplot(data=NULL, aes(x=X, y=y)) + geom_smooth()
I have a few potential fixes. For example, I could first use group_by/summarize to make a dataset of binned medians and then plot that. I would rather NOT do this because in my real data I have a lot of facetting and grouping variables, and it would be a lot to keep track of (non-ideal). A lot plot definitely looks better, but log does not have nice interpretation in my application (median does have nice interpretation)
ggplot(data=NULL, aes(x=X, y=y)) + geom_smooth() +
scale_y_log10()
Finally, I know about geom_quantile but I think I'm using it wrong. Is there a way to add an error bar? Also- this geom_quantile plot looks way too smooth, and I don't understand why it is sloping down. Am I using it wrong?
ggplot(data=NULL, aes(x=X, y=y)) +
geom_quantile(quantiles=c(0.5))
I realize that this problem probably has a LOT of workarounds, but if possible I would love to use geom_smooth and just provide an argument that tells it to use a median. I want geom_smooth for a side-by-side comparison with consistency. I want to put the mean and median geom_smooths side-by-side to show "hey look, super strong pattern between Y and X is driven by a few large outliers, if we look only at median the pattern disappears".
Thanks!!
You can create your own method to use in geom_smooth. As long as you have a function that produces an object on which the predict generic works to take a data frame with a column called x and translate into appropriate values of y.
As an example, let's create a simple model that interpolates along a running median. We wrap it in its own class and give it its own predict method:
rolling_median <- function(formula, data, n_roll = 11, ...) {
x <- data$x[order(data$x)]
y <- data$y[order(data$x)]
y <- zoo::rollmedian(y, n_roll, na.pad = TRUE)
structure(list(x = x, y = y, f = approxfun(x, y)), class = "rollmed")
}
predict.rollmed <- function(mod, newdata, ...) {
setNames(mod$f(newdata$x), newdata$x)
}
Now we can use our method in geom_smooth:
ggplot(data = NULL, aes(x = X, y = y)) +
geom_smooth(formula = y ~ x, method = "rolling_median", se = FALSE)
Now of course, this doesn't look very "flat", but it is way flatter than the line calculated by the loess method of the standard geom_smooth() :
ggplot(data = NULL, aes(x = X, y = y)) +
geom_smooth(formula = y ~ x, color = "red", se = FALSE) +
geom_smooth(formula = y ~ x, method = "rolling_median", se = FALSE)
Now, I understand that this is not the same thing as "regressing on the median", so you may wish to explore different methods, but if you want to get geom_smooth to plot them, this is how you can go about it. Note that if you want standard errors, you will need to have your predict function return a list with members called fit and se.fit
Here's a modification of #Allan's answer that uses a fixed x window rather than a fixed number of points. This is useful for irregular time series and series with multiple observations at the same time (x value). It uses a loop so it's not very efficient and will be slow for larger data sets.
# running median with time window
library(dplyr)
library(ggplot2)
library(zoo)
# some irregular and skewed data
set.seed(1)
x <- seq(2000, 2020, length.out = 400) # normal time series, gives same result for both methods
x <- sort(rep(runif(40, min = 2000, max = 2020), 10)) # irregular and repeated time series
y <- exp(runif(length(x), min = -1, max = 3))
data <- data.frame(x = x, y = y)
# ggplot(data) + geom_point(aes(x = x, y = y))
# 2 year window
xwindow <- 2
nwindow <- xwindow * length(x) / 20 - 1
# rolling median
rolling_median <- function(formula, data, n_roll = 11, ...) {
x <- data$x[order(data$x)]
y <- data$y[order(data$x)]
y <- zoo::rollmedian(y, n_roll, na.pad = TRUE)
structure(list(x = x, y = y, f = approxfun(x, y)), class = "rollmed")
}
predict.rollmed <- function(mod, newdata, ...) {
setNames(mod$f(newdata$x), newdata$x)
}
# rolling time window median
rolling_median2 <- function(formula, data, xwindow = 2, ...) {
x <- data$x[order(data$x)]
y <- data$y[order(data$x)]
ys <- rep(NA, length(x)) # for the smoothed y values
xs <- setdiff(unique(x), NA) # the unique x values
i <- 1 # for testing
for (i in seq_along(xs)){
j <- xs[i] - xwindow/2 < x & x < xs[i] + xwindow/2 # x points in this window
ys[x == xs[i]] <- median(y[j], na.rm = TRUE) # y median over this window
}
y <- ys
structure(list(x = x, y = y, f = approxfun(x, y)), class = "rollmed2")
}
predict.rollmed2 <- function(mod, newdata, ...) {
setNames(mod$f(newdata$x), newdata$x)
}
# plot smooth
ggplot(data) +
geom_point(aes(x = x, y = y)) +
geom_smooth(aes(x = x, y = y, colour = "nwindow"), formula = y ~ x, method = "rolling_median", se = FALSE, method.args = list(n_roll = nwindow)) +
geom_smooth(aes(x = x, y = y, colour = "xwindow"), formula = y ~ x, method = "rolling_median2", se = FALSE, method.args = list(xwindow = xwindow))
Created on 2022-01-05 by the reprex package (v2.0.1)
I am trying to make a plot to show the intuition behind logistic (or probit) regression. How would I make a plot that looks something like this in ggplot?
(Wolf & Best, The Sage Handbook of Regression Analysis and Causal Inference, 2015, p. 155)
Actually, what I would rather even do is have one single normal distribution displayed along the y axis with mean = 0, and a specific variance, so that I can draw horizontal lines going from the linear predictor to the y axis and sideways normal distribution. Something like this:
What this is supposed to show (assuming I haven't misunderstood something) is . I haven't had much success so far...
library(ggplot2)
x <- seq(1, 11, 1)
y <- x*0.5
x <- x - mean(x)
y <- y - mean(y)
df <- data.frame(x, y)
# Probability density function of a normal logistic distribution
pdfDeltaFun <- function(x) {
prob = (exp(x)/(1 + exp(x))^2)
return(prob)
}
# Tried switching the x and y to be able to turn the
# distribution overlay 90 degrees with coord_flip()
ggplot(df, aes(x = y, y = x)) +
geom_point() +
geom_line() +
stat_function(fun = pdfDeltaFun)+
coord_flip()
I think this comes pretty close to the first illustration you give. If this is a thing you don't need to repeat many times, it is probably best to compute the density curves prior to plotting and use a seperate dataframe to plot these.
library(ggplot2)
x <- seq(1, 11, 1)
y <- x*0.5
x <- x - mean(x)
y <- y - mean(y)
df <- data.frame(x, y)
# For every row in `df`, compute a rotated normal density centered at `y` and shifted by `x`
curves <- lapply(seq_len(NROW(df)), function(i) {
mu <- df$y[i]
range <- mu + c(-3, 3)
seq <- seq(range[1], range[2], length.out = 100)
data.frame(
x = -1 * dnorm(seq, mean = mu) + df$x[i],
y = seq,
grp = i
)
})
# Combine above densities in one data.frame
curves <- do.call(rbind, curves)
ggplot(df, aes(x, y)) +
geom_point() +
geom_line() +
# The path draws the curve
geom_path(data = curves, aes(group = grp)) +
# The polygon does the shading. We can use `oob_squish()` to set a range.
geom_polygon(data = curves, aes(y = scales::oob_squish(y, c(0, Inf)),group = grp))
The second illustration is pretty close to your code. I simplified your density function by the standard normal density function and added some extra paramters to stat function:
library(ggplot2)
x <- seq(1, 11, 1)
y <- x*0.5
x <- x - mean(x)
y <- y - mean(y)
df <- data.frame(x, y)
ggplot(df, aes(x, y)) +
geom_point() +
geom_line() +
stat_function(fun = dnorm,
aes(x = after_stat(-y * 4 - 5), y = after_stat(x)),
xlim = range(df$y)) +
# We fill with a polygon, squishing the y-range
stat_function(fun = dnorm, geom = "polygon",
aes(x = after_stat(-y * 4 - 5),
y = after_stat(scales::oob_squish(x, c(-Inf, -1)))),
xlim = range(df$y))
I would like manually adjust the scales of two contour plots such that each have the same scale even though they contain different ranges of values in the z-direction.
For instance, lets say that I want to make contour plots of z1 and z2:
x = 1:15
y = 1:15
z1 = x %*% t(y)
z2 = 50+1.5*(x %*% t(y))
data <- data.frame(
x = as.vector(col(z1)),
y = as.vector(row(z1)),
z1 = as.vector(z1),
z2 = as.vector(z2)
)
ggplot(data, aes(x, y, z = z1)) +
geom_contour_filled(bins = 8)
ggplot(data, aes(x, y, z = z2)) +
geom_contour_filled(bins = 8)
Is there a way I can manually adjust the scale of each plot such that each contain the same number of levels (in this case bins = 8), the minimum is the same for both (in this case min(z1)), and the max is the same for both (max(z2))?
One can manually define a vector of desired breaks points and then pass the vector to the "breaks" option in the geom_contour_filled() function.
In the below script, finds 8 break intervals between the grand minimum and the grand maximum of the dataset.
Also there are 2 functions defined to create the palette and label names for the legend.
#establish the min and max of scale
grandmin <- min(z1, z2)-1
grandmax <- max(z2, z2)
#define the number of breaks. In this case 8 +1
mybreaks <- seq(grandmin, ceiling(round(grandmax, 0)), length.out = 9)
#Function to return the dersired number of colors
mycolors<- function(x) {
colors<-colorRampPalette(c("darkblue", "yellow"))( 8 )
colors[1:x]
}
#Function to create labels for legend
breaklabel <- function(x){
labels<- paste0(mybreaks[1:8], "-", mybreaks[2:9])
labels[1:x]
}
ggplot(data, aes(x, y, z = z1)) +
geom_contour_filled(breaks= mybreaks, show.legend = TRUE) +
scale_fill_manual(palette=mycolors, values=breaklabel(8), name="Value", drop=FALSE) +
theme(legend.position = "right")
ggplot(data, aes(x, y, z = z2)) +
geom_contour_filled(breaks= mybreaks, show.legend = TRUE) +
scale_fill_manual(palette=mycolors, values=breaklabel(8), name="Value", drop=FALSE)
I have several sets of data stored in a data frame. For the sake of this question, I provide below a way to generate this data frame, but IRL, I only have the merged data frame, not the intermediate ones.
x <- seq.POSIXt(from = strptime("1970-01-01 00:00:00", format = "%Y-%m-%d %H:%M:%S"),
to = strptime("1970-01-01 00:05:00", format = "%Y-%m-%d %H:%M:%S"),
by = "10 sec")
x <- rep(x, each = 3)
y <- c()
set.seed(1)
for (i in 1:length(x)) {
y <- c(y, runif(1, min = 0, max = i))
}
my.data.frame1 <- data.frame(x, y, data = as.factor("data1"))
y <- c()
for (i in 1:length(x)) {
y <- c(y, runif(1, min = length(x) - i, max = length(x)))
}
my.data.frame2 <- data.frame(x, y, data = as.factor("data2"))
merged <- rbind(my.data.frame1, my.data.frame2)
ggplot(merged, aes(x, y, color = data)) + geom_point() + geom_line()
So for each type of data (data1 and data2), and for each date value on the x axis, I have 3 y values.
The plot looks (bad) like this:
What I want to do is to plot a geom_ribbon of the data but I don't know how to do it.
I first tried to extract the min and max values with an aggregate function as explained here for each time and build a new data frame without duplicate x values but couldn't make it work.
Can anyone help?
Edit:
The code I tried with aggregate is this one:
aggregate(y ~ x, data = merged, max)
(Same for the min). But this does not make the difference between the data1 set and the data2 set. I know I could subset, but I guess it can be done using the "by" argument. Just couldn't make it work.
You were on the right track, and need to aggregate by both data and x instead of just x.
You can either calculate the min and max by group separately in two aggregate calls and then merge or do both at the same time. For the second approach you'll need an additional step to get the output of the two functions into separate columns.
my.new.df = aggregate(y ~ data + x, data = merged, FUN = function(x) c(min = min(x), max = max(x)))
# Get the min and max as separate columns
my.new.df = as.data.frame(as.list(my.new.df))
ggplot(my.new.df, aes(x, fill = data)) +
geom_ribbon(aes(ymin = y.min, ymax = y.max), alpha = 0.6)
You can also make the plot directly using stat = "summary" in geom_ribbon instead of making an aggregate dataset for plotting.
ggplot(merged, aes(x, y, fill = data)) +
geom_ribbon(alpha = 0.6, stat = "summary", fun.ymax = max, fun.ymin = min)