I have large data sets where I am doing exploratory screenings for correlations. I want to do a correlation test to identify significantly related variables, and then plot these variables against each other.
data <- data.frame(a = 1:10, b = c(1.5*(1:9), 10), c = 2*(1:10), d = sample(1:5, 10, replace = T))
cor_data <- corr.test(data)
sig_cor <- ifelse(cor_data$p <0.05, cor_data$r, NA)
sig_cor_long <- sig_cor %>%
data.frame() %>%
mutate(var1 = rownames(sig_cor)) %>%
gather(var2, value = r, -var1) %>%
drop_na(r) %>%
filter(r != 1)
This identifies pairs a-b and b-c as significantly correlated, so I want to plot those. How can I automate this process of selecting the paired variables from sig_cor_long to plot via ggplot from data? An example plot that I want to create for each correlated pair would be:
ggplot(data, aes(a, b)) +
geom_smooth(method = 'lm')+
geom_point(shape = 21, color = 'darkblue', fill = 'white')
I want to have a function to input into ggplot to tell it to plot all the var1 and var2 pairs identified in sig_cor_long for which the raw data are in data.
Ok so, this is one way of plotting e.g. all the plots where there is significant correlation (in a list, so you could do anything with them)
do.call(gridExtra::grid.arrange,
ifelse(cor_data$p <0.05, cor_data$r, NA) %>%
as.data.frame() %>%
rownames_to_column() %>%
gather(pair, val, -rowname) %>%
drop_na() %>%
filter(val != 1) %$%
map2(rowname, pair, ~ggplot() + geom_smooth(method = "lm", aes(data[, .x], data[, .y])) + geom_point(aes(data[, .x], data[, .y])))
)
Related
I have a dataset with very limited data points.
x<- c(4, 8, 13, 24)
y<- c(40, 37, 28, 20)
df<- data.frame(x,y)
Now I want to extrapolate this data, creating a dataset where the value of y will be given for every value (no decimals) of x between 1-100. x and y have a linear relationship.
Secondly, could this be done for multiple dataframes by using something like a loop?
Thank you!
This is a short snippet that does this:
linear_xy <- lm(y ~ x, data = df)
# df <- broom:::augment.lm(linear_xy, newdata = complete(df, x = 1:100)) # one way
df <- df %>% # another way
complete(x = 1:100) %>%
mutate(.fitted = predict(linear_xy, newdata = .))
ggplot(df, aes(x, y)) +
geom_line(aes(y = .fitted)) +
geom_point() +
ggpubr::theme_pubr()
This requires that you have the packages {tidyverse}, {broom}, and {ggpubr} installed.
Second part
Assumming we want to do this with multiple data-frames, we have to
restructure things a bit.
x <- c(4, 8, 13, 24)
y <- c(40, 37, 28, 20)
df <- tibble(x, y)
I don't have multiple data-frames (or tibbles), so I'll make this the
primary one, and make up a function (a factory) that yields data-frames, that are a bit different from the above df.
df_factory <- . %>%
mutate(x_new = x + sample.int(100, size = n()),
x = if_else(x_new >= 100, x, x_new),
y_new = y + rnorm(n(), mean = median(y), sd = sd(y)),
y = y_new,
y_new = NULL,
x_new = NULL)
Thus df_factory is a function of one-variable, and that must be a
data-frame that has an x and y;
df1 <- df_factory(df)
df2 <- df_factory(df)
df3 <- df_factory(df)
all_dfs <- list(df1, df2, df3)
all_dfs <- bind_rows(all_dfs, .id = "df_id")
Here we ensure that the relation to the original data-frame is preserved in the all_dfs data-frame via the new variable df_id.
Next we want to:
Collapse the variables into their individual data-frame, and we put
that in a list-column named data.
For each (see rowwise) we have to perform:
An "interpolating" linear model (not a piece-wise one so...)
Predict on each of these linear_xy (which are also stored in a list-column`).
Unnest it all back, so it can be fed into ggplot as one contiguous data-frame.
all_dfs %>%
nest(data = c(x,y)) %>%
rowwise() %>%
mutate(linear_xy = list(lm(y ~ x, data = data)),
augment = list(broom:::augment.lm(linear_xy,
newdata = complete(data, x = 1:100)))) %>%
ungroup() %>%
select(-data, -linear_xy) %>%
unnest(augment) ->
all_dfs_predictions
Note: -> at the end shows what the pipe result is now assigned to.
The group informs ggplot to treat the rows as separate via their
df_id. And for fun we add the color and fill to also depend on df_id. In fact I could have choosen something else to be the coloraesthetics dependent, like "original df" vs. "others" or if a certain threshold should distinguish them, etc.. But then the group aesthetic would still tell ggplot to separate the rows amongst this relation.
ggplot(all_dfs_predictions, aes(x, y, group = df_id, color = df_id, fill = df_id)) +
geom_line(aes(y = .fitted)) +
geom_point() +
lims(x = c(1,100)) +
ggpubr::theme_pubr()
I have several sets of data that I calculate binned normalized differences for. The results I want to plot within a single line plot using ggplot. The lines representing different combinations of the paired differences are supposed to be distinguished by colors and line types.
I am stuck on taking the computed values from the bins (would be y-axis values now), and plotting these onto an x-axis.
Below is the code I use for importing the data and calculating the normalized differences.
# Read data from column 3 as data table for different number of rows
# you could use replicate here for test
# dat1 <- data.frame(replicate(1,sample(25:50,10000,rep=TRUE)))
# dat2 <- data.frame(replicate(1,sample(25:50,9500,rep=TRUE)))
dat1 <- fread("/dir01/a/dat01.txt", header = FALSE, data.table=FALSE, select=c(3))
dat2 <- fread("/dir02/c/dat02.txt", header = FALSE, data.table=FALSE, select=c(3))
# Change column names
colnames(dat1) <- c("Dat1")
colnames(dat2) <- c("Dat2")
# Perhaps there is a better way to compute the following as all-in-one? I have broken these down step by step.
# 1) Sum for each bin
bin1 = cut(dat1$Dat1, breaks = seq(25, 50, by = 2))
sum1 = tapply(dat1$Dat1, bin1, sum)
bin2 = cut(dat2$Dat2, breaks = seq(25, 50, by = 2))
sum2 = tapply(dat2$Dat2, bin2, sum)
# 2) Total sum of all bins
sumt1 = sum(sum1)
sumt2 = sum(sum2)
# 3) Divide each bin by total sum of all bins
sumn1 = lapply(sum1, `/`, sumt1)
sumn2 = lapply(sum2, `/`, sumt2)
# 4) Convert to data frame as I'm not sure how to difference otherwise
df_sumn1 = data.frame(sumn1)
df_sumn2 = data.frame(sumn2)
# 5) Difference between the two as percentage
dbin = (df_sumn1 - df_sumn2)*100
How can I plot those results using ggplot() and geom_line()?
I want
dbin values on the x-axis ranging from 25-50
different colors and line types for the lines
Here is what I tried:
p1 <- ggplot(dbin, aes(x = ?, color=Data, linetype=Data)) +
geom_line() +
scale_linetype_manual(values=c("solid")) +
scale_x_continuous(limits = c(25, 50)) +
scale_color_manual(values = c("#000000"))
dput(dbin) outputs:
structure(list(X.25.27. = -0.0729132928804117, X.27.29. = -0.119044772581772,
X.29.31. = 0.316016473225017, X.31.33. = -0.292812782147632,
X.33.35. = 0.0776336591308158, X.35.37. = 0.0205584754637611,
X.37.39. = -0.300768421159599, X.39.41. = -0.403235174844081,
X.41.43. = 0.392510458816457, X.43.45. = 0.686758883448307,
X.45.47. = -0.25387105113263, X.47.49. = -0.0508324553382303), class = "data.frame", row.names = c(NA,
-1L))
Edit
The final piece of code that works, using only the dbin and plots multiple dbins:
dat1 <- data.frame(a = replicate(1,sample(25:50,10000,rep=TRUE, prob = 25:0/100)))
dat2 <- data.frame(a = replicate(1,sample(25:50,9500,rep=TRUE, prob = 0:25/100)))
dat3 <- data.frame(a = replicate(1,sample(25:50,9500,rep=TRUE, prob = 12:37/100)))
dat4 <- data.frame(a = replicate(1,sample(25:50,9500,rep=TRUE, prob = 37:12/100)))
calc_bin_props <- function(data) {
as_tibble(data) %>%
mutate(bin = cut(a, breaks = seq(25, 50, by = 2))) %>%
group_by(bin) %>%
summarise(sum = sum(a), .groups = "drop") %>%
filter(!is.na(bin)) %>%
ungroup() %>%
mutate(sum = sum / sum(sum))
}
diff_data <-
full_join(
calc_bin_props(data = dat1),
calc_bin_props(dat2),
by = "bin") %>%
separate(bin, c("trsh", "bin", "trshb", "trshc")) %>%
mutate(dbinA = (sum.x - sum.y * 100)) %>%
select(-starts_with("trsh"))
diff_data2 <-
full_join(
calc_bin_props(data = dat3),
calc_bin_props(dat4),
by = "bin") %>%
separate(bin, c("trsh", "bin", "trshb", "trshc")) %>%
mutate(dbinB = (sum.x - sum.y * 100)) %>%
select(-starts_with("trsh"))
# Combine two differences, and remove sum.x and sum.y
full_data <- cbind(diff_data, diff_data2[,4])
full_data <- full_data[,-c(2:3)]
# Melt the data to plot more than 1 variable on a plot
m <- melt(full_data, id.vars="bin")
theme_update(plot.title = element_text(hjust = 0.5))
ggplot(m, aes(as.numeric(bin), value, col=variable, linetype = variable)) +
geom_line() +
scale_linetype_manual(values=c("solid", "longdash")) +
scale_color_manual(values = c("black", "black"))
dev.off()
library(tidyverse)
Creating example data as shown in question, but adding different probabilities to the two sample() calls, to create so visible difference
between the two sets of randomized data.
dat1 <- data.frame(a = replicate(1,sample(25:50,10000,rep=TRUE, prob = 25:0/100))) %>% as_tibble()
dat2 <- data.frame(a = replicate(1,sample(25:50,9500,rep=TRUE, prob = 0:25/100))) %>% as_tibble()
Using dplyr we can handle this within data.frames (tibbles) without
the need to switch to other datatypes.
Let’s define a function that can be applied to both datasets to get
the preprocessing done.
We use base::cut() to create
a new column that pairs each value with its bin. We then group the data
by bin, calculate the sum for each bin and finally divide the bin sums
by the total sum.
calc_bin_props <- function(data) {
as_tibble(data) %>%
mutate(bin = cut(a, breaks = seq(25, 50, by = 2), labels = seq(25, 48, by = 2))) %>%
group_by(bin) %>%
summarise(sum = sum(a), .groups = "drop") %>%
filter(!is.na(bin)) %>%
ungroup() %>%
mutate(sum = sum / sum(sum))
}
Now we call calc_bin_props() on both datasets and join them by bin.
This gives us a dataframe with the columns bin, sum.x and sum.y.
The latter two are correspond to the bin sums derived from dat1 and
dat2. With the mutate() line we calculate the differences between the
two columns.
diff_data <-
full_join(
calc_bin_props(data = dat1),
calc_bin_props(dat2),
by = "bin") %>%
mutate(dbin = (sum.x - sum.y),
bin = as.numeric(as.character(bin))) %>%
select(-starts_with("trsh"))
Before we feed the data into ggplot() we convert it to the long
format using pivot_longer() this allows us to instruct ggplot() to
plot the results for sum.x, sum.y and dbin as separate lines.
diff_data %>%
pivot_longer(-bin) %>%
ggplot(aes(as.numeric(bin), value, color = name, linetype = name)) +
geom_line() +
scale_linetype_manual(values=c("longdash", "solid", "solid")) +
scale_color_manual(values = c("black", "purple", "green"))
I need to plot ECDF's of all columns of the dataframe in one single plot and get an x_limit on the axis too.
The function that I wrote:
library(lattice)
library(latticeExtra)
ecdf_plot <- function(data){
# Drop columns with only NA's
data <- data[, colSums(is.na(data)) != nrow(data)]
data$P_key <- NULL
ecdfplot(~ S12, data=data, auto.key=list(space='right'))
}
Problem:
The ECDF in the above function only plots for the column S12 but I need this for all columns in the dataframe. I know i can do S12 + S13 + ... but the source data changes and we don't exactly know how many and which columns will the dataframe get. Is there a better way out of this? Also, is it possible to get the x_limit for the combined plot to be just one range like xlim(0,100)?
I think this task would be easier using ggplot. It would be very easy to set the limits as required, customise the appearance, etc.
The function would look like this:
library(dplyr)
library(tidyr)
library(ggplot2)
ecdf_plot <- function(data) {
data[, colSums(is.na(data)) != nrow(data)] %>%
pivot_longer(everything()) %>%
group_by(name) %>%
arrange(value, by_group = TRUE) %>%
mutate(ecdf = seq(1/n(), 1 - 1/n(), length.out = n())) %>%
ggplot(aes(x = value, y = ecdf, colour = name)) +
xlim(0, 100) +
geom_step() +
theme_bw()
}
Now let's test it on a random data frame:
set.seed(69)
df <- data.frame(unif = runif(100, 0, 100), norm = rnorm(100, 50, 25))
ecdf_plot(df)
I have the following type of data and would like to create a stacked barplot, which would show the sum of Number on y axis for different bins of Distance on x axis which would indicate distance. In fact, that would be a sort of histogram, but not with frequencies on y but the sums of Number per set bin. This would be cumulative for all categories in Dest which would be marked with different colours.
Thanks so much.
library(ggplot2)
df <- data.frame(c(rep("A",20),rep("B",25),rep("C",35)),sample(1:30, 80,replace = TRUE),
rnorm(80,45,8))
colnames(df) <- c("Dest","Number","Distance")
ggplot(data = df, aes(x = Distance, y = Number, fill = Dest)) +
geom_histogram(colour = c("red","blue","green"))
Here are 2 solutions in case you want to be the one that specifies the (Distance) bins and not the histogram:
Option 1 (using ntile)
Here's a solution that allows you to specify the number of bins using ntile, which means that those bins will have more or less the same number of observations:
library(tidyverse)
df <- data.frame(c(rep("A",20),rep("B",25),rep("C",35)),sample(1:30, 80,replace = TRUE),
rnorm(80,45,8))
colnames(df) <- c("Dest","Number","Distance")
df %>%
group_by(bin = ntile(Distance, 3)) %>% # specify number of bins you want
mutate(DistRange = paste0(round(min(Distance)), " - ", round(max(Distance)))) %>%
ungroup() %>%
group_by(Dest, bin, DistRange = fct_reorder(DistRange, bin)) %>%
summarise(sum_number = sum(Number)) %>%
ungroup() %>%
ggplot(aes(DistRange, sum_number, fill=Dest))+
geom_col()
Option 2 (using cut)
An alternative option using cut to specify ranges:
df %>%
mutate(bin = cut(Distance, breaks = c(min(Distance)-1, 40, 50, 55, max(Distance)))) %>% # specify ranges
group_by(Dest, bin) %>%
summarise(sum_number = sum(Number)) %>%
ungroup() %>%
ggplot(aes(bin, sum_number, fill=Dest))+
geom_col()
Here is my code. The data set is artificially generated to simulate data similar to my actual problem.
Code:
library(ggplot2)
DataSet1 <- data.frame("Cat" = rep("A",10000), "Bin" = rep(c(-49:50),100),
"Value" = c(seq(0,4.9, by=0.1),
seq(4.9,0, by=-0.1)) * rep(rnorm(100,50,1),100))
DataSet2 <- data.frame("Cat" = rep("B",10000), "Bin" = rep(c(-49:50),100),
"Value" = c(seq(0,4.9, by=0.1),
seq(4.9,0, by=-0.1)) * rep(rnorm(100,75,1),100))
DataSet3 <- data.frame("Cat" = rep("C",10000), "Bin" = rep(c(-49:50),100),
"Value" = c(seq(0,4.9, by=0.1),
seq(4.9,0, by=-0.1)) * rep(rnorm(100,100,1),100))
DataSet <- rbind(DataSet1, DataSet2, DataSet3)
d <- ggplot(data = DataSet, aes(Bin, Value, color = Cat))
d + stat_summary(fun.y = sum, geom = 'step', size = 1)
My result:
What I want to do:
Normalize each of these plots, i.e., divide the sum at each bin width by the total Value for that curve.
As far as I am aware, stat_summary is not meant to operate over all values of x and y simultaneously, so this type of per-group summary isn't possible strictly within ggplot. In cases such as this, it's usually best to compute your summary ahead of time and then plot that. Using dplyr to make summarization easy:
library(dplyr)
DataSet <- DataSet %>%
group_by(Cat, Bin) %>%
summarize(Value = sum(Value)) %>%
group_by(Cat) %>%
mutate(Value = Value / sum(Value))
d <- ggplot(data = DataSet, aes(Bin, Value, color = Cat))
d + stat_summary(fun.y = mean, geom = 'step', size = 1)