How to use list elements as plot title in r? - r

I have this kind of data:
d<- list(d1 = list(`1979` = 3.8234619080332, `1980` = 3.94835997755299,
`1981` = 4.40780893307071), d2 = list(`1979` = 3.78682062013644,
`1980` = 3.89720895853959, `1981` = 4.35137469930167))
I am trying to plot my data and I want to use the list names d1 and d2 as plot titles.
I have tried this function with lapply;
fun1<-function(x) {
y<-x
x<-unlist(x)
plot(ecdf(x), main=deparse(substitute(y)))
}
lapply(d, fun1)
What I got are:
But I want to see d1 for the first plot and d2 for the second plot as the main title name instead of "list(d1 = list(1979 = 3.823461...."

You could use mapply to loop over both d and names(d) to pass the name of the list element to your function:
d<- list(d1 = list(`1979` = 3.8234619080332, `1980` = 3.94835997755299,
`1981` = 4.40780893307071), d2 = list(`1979` = 3.78682062013644,
`1980` = 3.89720895853959, `1981` = 4.35137469930167))
fun1<-function(x, y) {
plot(ecdf(unlist(x)), main=y)
}
mapply(fun1, d, names(d))

You could include the lapply() in your function and use the names().
fun1 <- function(d) {
nm <- names(d)
lapply(nm, function(i) plot(ecdf(unlist(d[[i]])), main=i))
}
op <- par(mfrow=c(1, 2))
fun1(d)
par(op)

Using purrr::imap -
fun1<-function(x, y) {
plot(ecdf(unlist(x)), main=y)
}
purrr::imap(d, fun1)

Related

How to use plot inside a function?

I have a list and I want to plot all data frames in it by function MyPlot, but there are several problems:
It just plot the last data frame (L2)
The names of each data frames can not be extracted by name = deparse(substitute(df))
If I use jpeg instead of pdf there is an error:
"Error in switch(units, in = res, cm = res/2.54, mm = res/25.4, px = 1) * :
non-numeric argument to binary operator"
Any help would be appreciated.
L1 = data.frame(A = c(1:4) , B = c(1:4) , C = c(1:4))
L2 = data.frame(A = c(5:8) , B = c(8:11), G = c(1:4) )
L=list(L1,L2)
names(L) = c('L1' , 'L2')
MyPlot <- function(df){
name = deparse(substitute(df))
jpeg(paste(name) , ".jpg")
#pdf(paste0(name,".pdf"), onefile = TRUE, paper = "A4")
P = ggplot(df, aes(A , B)) + geom_point()
#print(P)
dev.off()
}
Plot_jpeg = L %>% lapply(MyPlot)
This might not be what you want, but:
L1 = data.frame(A = c(1:4) , B = c(1:4) , C = c(1:4))
L2 = data.frame(A = c(5:8) , B = c(8:11), G = c(1:4) )
L=list(L1,L2)
names(L) = c('L1' , 'L2')
MyPlot <- function(df, name){
P = ggplot(df, aes(A , B)) + geom_point()
ggsave(P, glue::glue("{name}.jpeg")
return(P)
}
Plots_list = purrr::map2(L, names(L),
function(.x, .y) MyPlot(.x, .y))
As MrFlick suggests,
a more idiomatic purrr option could be purrr::imap(L, ~MyPlot(.x, .y)) since imap(x, ...) is short hand for map2(x, names(x), ...). I am using map2 because I would rather be explicit, less things to remember.

Loop a function in r to create a new table

I have a dataframe in r and want to perform the levene's/ variance test on multiple variables with two groups and save all results in a table. I have tried to do this using a for() loop and sapply() but I get neither working:
df <- data.frame(
x = rnorm(100, 0, 1),
y = rnorm(100, 50, 1),
z = rnorm(100, 70, 2),
group = rep(c(0,1), each = 50)
)
varlist <- c("x","y","z")
res.var <- character(length(varlist))
res.f <- numeric(length(varlist))
res.p <- numeric(length(varlist))
Option 1)
for(i in seq_along(varlist)) {
form <- substitute(i ~ group, list(i = as.name(varlist)))
result <- var.test(
formula = form,
data = df)
res.var[i] <- varlist[i]
res.f[i] <- result$estimate
res.p[i] <- result$p.value
}
Option 2:
sapply(varlist, function(x) {
form <- substitute(i ~ group, list(i = as.name(varlist)))
result <- var.test(
formula = form,
data = df)
res.var[i] <- varlist[i]
res.f[i] <- result$estimate
res.p[i] <- result$p.value
})
Maybe there's an easier way to that this. I'd be glad for any help ;o) Thank you in advance.

ggarrange generates an empty pdf file

I am dealing with a function that takes a big data frame (36 rows and 194 columns) which performs a Principal Component Analysis and then generates a list of plots where I have the combination of 26 Principal Components which are 325 in total, using 'expand.grid'.
My problem is that when I am using ggarrange(), from ggpubr, to merge all the plots in only one pdf file, this file is empty.
My code:
a = 26
row.pairs = 325
PC.Graph <- function(df, col1, col2, tag, id){
df1 <- df[,-c(col1:col2)]
pca <- prcomp(df1, scale. = T)
pc.summ <- summary(pca)
a <- sum(pc.summ$importance[3,] < 0.975)
b <- c(1:a)
pc.grid <- expand.grid(b, b)
pc.pairs <- pc.grid[pc.grid$Var1 < pc.grid$Var2,]
row.pairs <- nrow(pc.pairs)
components <- c(1:row.pairs)
S.apply.FUN <- function(x){
c <- sapply(pc.pairs, "[", x, simplify = F)
pcx <- c$Var1
pcy <- c$Var2
df2 <- df
row.names(df2) <- df[, tag]
name = paste("PCA_", pcx, "_vs_", pcy)
autoplot(pca, data = df2, colour = id, label = T, label.repel = T, main = name,
x = pcx, y = pcy)
}
all.plots <- Map(S.apply.FUN, components)
pdf(file = "All_PC.pdf", width = 50, height = 70)
print(ggarrange(all.plots))
dev.off()
}
PC.Graph(Final_DF, col1 = 1, col2 = 5, tag = "Sample", id = "Maturation")
You would have to pass a plotlist to ggarrange, but I am not sure you would get any useful plot out of that plot area in the PDF file, so I would advise you to split the plotlist into chunks (e.g. of 20) and plot these to multiple pages.
Specifically, I would export all.plots from your PC.Graph function (and remove the code to write to PDF there).
I would also change the expand.grid(b, b) to t(combn(b, 2)), since you don't need to plot the PC combinations twice.
Then I would do something like this:
# export the full list of plots
plots <- PC.Graph(Final_DF, col1 = 1, col2 = 5, tag = "Sample", id = "Maturation")
# split the plotlist
splitPlots <- split(plots, ceiling(seq_along(plots)/20))
plotPlots <- function(x){
out <- cowplot::plot_grid(plotlist = x, ncol = 5, nrow = 4)
plot(out)
}
pdf(file = "All_PC.pdf", width = 50, height = 45)
lapply(splitPlots, plotPlots)
dev.off()

Nested loop or equivalent

I am trying to make a nested loop, I start with a simple loop and I would like make the same with differents data frames;
This work fine:
set.seed(123)
df1= data.frame(date= 1:10,
vartre=rnorm(10, 30, 4),
varpre=rnorm(10, 10, 5))
var=names(df1)
for(x in var ) {
plot(df1$date,df1[,x], type="l", main=x)
}
Now, I would like make the same with differents df´s, I tried to do with a nested loop but this dont work, example:
df2= data.frame(date= 1:10,
varkyt=rnorm(10, 100, 40),
varkdr=rnorm(10, 50, 5))
df3= data.frame(date= 1:10,
varwer=rnorm(10, 300, 400),
varpou=rnorm(10, 1000, 500))
dfs=c("df1", "df2", "df3")
for(i in dfs) {
var=names(i)
for(x in var ) {
plot(i$date,i[,x], type="l", main=paste(i,x)))
}
}
Thanks in advance
We can use lapply to loop over the list (mget -returns the list of data.frame from the string identifiers) and plot
out <- lapply(mget(dfs), function(dat) {
var <- names(dat)[-1]
lapply(var, function(x) plot(dat$date, dat[,x], type = "l",
main = x))
})
If we need to save it in a folder
path <- "path/to/folder/"
lapply(mget(dfs), function(dat) {
var <- names(dat)[-1]
lapply(var, function(x) {
png(filename=paste(path, "grafico", x,".png"))
plot(dat$date, dat[,x], type = "l",
main = x)
dev.off()
}
)
})

R redefine a string to argument

following on from some help earlier I think all I need for this to work is a way to define the variable dimxST below as not a string as I need that to point to the data frame....
cpkstudy <- function(x,y){
dxST <- paste(x,"$",y, sep = "")
dLSL <- paste(y, "LSL", sep = "")
dUSL <- paste(y, "USL", sep = "")
dTar <- paste(y, "Target", sep = "")
dimxST <-
dimLSL <- PivSpecs[[dLSL]]
dimUSL <- PivSpecs[[dUSL]]
dimTar <- PivSpecs[[dTar]]
ss.study.ca(dimxST, LSL = dimLSL, USL = dimUSL, Target = dimTar,
alpha = 0.05, f.na.rm = TRUE, f.main = "Six Sigma Study")
}
cpkstudy("cam1","D1")
link to the previous post
This is a different direction, and you may find the learning curve a bit steeper, but it's a lot more powerful. Instead of passing everything in as strings, we pass them without quotes, and use the rlang package to figure out where to evaluate D1.
# the same dummy data frame from Katia's answer
cam1 <- data.frame(D1 = rnorm(10),
D2 = rnorm(10))
PivSpecs <- list(D1LSL = 740, D1USL = 760, D1Target = 750)
library(rlang)
cpkstudy <- function(df, y){
quo_y <- enquo(y)
dLSL <- paste0(quo_name(quo_y), "LSL")
dUSL <- paste0(quo_name(quo_y), "USL")
dTar <- paste0(quo_name(quo_y), "Target")
dimxST <- eval_tidy(quo_y, data = df)
dimLSL <- PivSpecs[[dLSL]]
dimUSL <- PivSpecs[[dUSL]]
dimTar <- PivSpecs[[dTar]]
print(dimxST)
print (paste("dimLSL=", dimLSL) )
print (paste("dimUSL=", dimUSL) )
print (paste("dimTar=", dimTar) )
# ss.study.ca(dimxST, LSL = dimLSL, USL = dimUSL, Target = dimTar,
# alpha = 0.05, f.na.rm = TRUE, f.main = "Six Sigma Study")
}
# notice that I am not quoting cam1 and D1
cpkstudy(cam1, D1)
If you want to learn more about this, I would suggest looking at https://dplyr.tidyverse.org/articles/programming.html as an overview (the dplyr package imports some of the functions used in rlang), and http://rlang.r-lib.org/index.html for a more complete list of all the functions and examples.
You can use function get() to get object value from its string representation. In this solution I did not evaluate ss.study.ca() function itself, since I do not have your real-case input data, instead I just print the values that would go there:
cpkstudy <- function(x,y){
#dxST <- paste0(x,"$",y)
dLSL <- paste0(y, "LSL")
dUSL <- paste0(y, "USL")
dTar <- paste0(y, "Target")
dimxST <- get(x)[,y]
print(dimxST)
dimLSL <- PivSpecs[[dLSL]]
dimUSL <- PivSpecs[[dUSL]]
dimTar <- PivSpecs[[dTar]]
print (paste("dimLSL=", dimLSL) )
print (paste("dimUSL=", dimUSL) )
print (paste("dimTar=", dimTar) )
#ss.study.ca(dimxST, LSL = dimLSL, USL = dimUSL, Target = dimTar,
# alpha = 0.05, f.na.rm = TRUE, f.main = "Six Sigma Study")
}
# create some dummy dataframe to test with this example
cam1 <- data.frame(D1 = rnorm(10),
D2 = rnorm(10))
# define a list that will be used within a function
PivSpecs <- list(D1LSL = 740, D1USL = 760, D1Target = 750)
#test function
cpkstudy("cam1","D1")
#[1] 1.82120625 -0.08857998 -0.08452232 -0.43263828 0.17974556 -0.91141414 #-2.30595203 -1.24014396 -1.83814577 -0.24812598
#[1] "dimLSL= 740"
#[1] "dimUSL= 760"
#[1] "dimTar= 750"
I also changed your paste() commands on paste0() which has sep="" as a default.

Resources