For-loop to dynamically change plot title - r

I have 5 variables which want to plot and export in one pdf. However, I have some trouble wiht the for-loop I am running,
parC <-list(unit = 100,labelx = "Time",labely = "Time",cols = "black",
pcex = .01, pch = 1,las = 1,
labax = seq(0,nrow(RP),100),
labay = seq(0,nrow(RP),100))
pdf("filename.pdf", onefile=TRUE)
for (i in RP_values){ # the values that are plotted
for (j in name) { # name is a list of names, so that the title changes dynamically
plotting(i, parC, j)
}
}
dev.off()
RP_values = list of values that is plotted
name = list of names to dynamically change the plotting title
plotting = an adjusted version from the plotRP() function of the crqa package. Here I added a main title to the plot.
The code for the plotting() function:
plotting <- function(RP, par, x){
if (exists("par") == FALSE){ # we use some defaults
## default values
unit = 2; labelx = "Time"; labely = "Time"
cols = "black"; pcex = .3; pch = 1; las = 0;
labax = seq(0, nrow(RP), unit); labay = seq(0, nrow(RP), unit);
} else { # we load the values that we desire
for (v in 1:length(par)) assign(names(par)[v], par[[v]])
}
xdim = nrow(RP)
ydim = ncol(RP)
RP = matrix(as.numeric(RP), nrow = xdim, ncol = ydim) # transform it for plotting
ind = which(RP == 1, arr.ind = T)
tstamp = seq(0, xdim, unit)
par(mar = c(5,5, 1, 3), font.axis = 2, cex.axis = 1,
font.lab = 2, cex.lab = 1.2)
plot(tstamp, tstamp, type = "n", xlab = "", ylab = "", xaxt = "n", yaxt = "n", main = x)
matpoints(ind[,1], ind[,2], cex = pcex, col = cols, pch = pch)
mtext(labelx, at = mean(tstamp), side = 1, line = 2.2, cex = 1.2, font = 2)
mtext(labely, at = mean(tstamp), side = 2, line = 2.2, cex = 1.2, font = 2)
# if (is.numeric(labax)){ ## it means there is some default
# mtext(labax, at = seq(1, nrow(RP), nrow(RP)/10), side = 1, line = .5, cex = 1, font = 2)
# mtext(labay, at = seq(1, nrow(RP), nrow(RP)/10), side = 2, line = .5, cex = 1, font = 2)
# } else{
mtext(labax, at = tstamp, side = 1, line = .5, cex = .8, font = 2, las = las)
mtext(labay, at = tstamp, side = 2, line = .5, cex = .8, font = 2, las = las)
# }
}
My problem is instead of 5 plots I get 25, where each plot appears 5 times, but with a different title. If I do not include the "j" part everything works fine, but of course do not have any main title for each plot.
I appreciate any help.
Best,
Johnson

From your description and comments, it appears you need an elementwise loop and not a nested loop. Consider retrieving all pairwise combinations of names and RP_values with expand.grid and iterate through them with mapply. Also, since parC depends on nrows of corresponding RP, have parC defined inside function for only two parameters (with more informative names like title instead of x):
plotting <- function(RP, title) {
parC <- list(unit=100, labelx="Time", labely="Time",
cols="black", pcex=.01, pch=1, las=1,
labax=seq(0, nrow(RP), 100),
labay=seq(0, nrow(RP), 100))
...
plot(tstamp, tstamp, type="n", xlab="", ylab="",
xaxt="n", yaxt="n", main=title)
...
}
params <- expand.grid(RP_values=RP_values, name=name)
out <- mapply(plotting, RP=params$RP_values, title=params$name)

Related

empty output for wgcna scatterplot in R

I am trying to run this code for wgcna to relate modules * traits:
weight <- as.data.frame(datTraits[, "weight", drop = FALSE])
names(weight) = "weight"
modNames = substring(names(MEs), 3)
geneModuleMembership = as.data.frame(cor(datExpr, MEs, use = "p"));
MMPvalue = as.data.frame(corPvalueStudent(as.matrix(geneModuleMembership), nSamples));
names(geneModuleMembership) = paste("MM", modNames, sep="");
names(MMPvalue) = paste("p.MM", modNames, sep="");
geneTraitSignificance = as.data.frame(cor(datExpr, weight, use = "p"));
GSPvalue = as.data.frame(corPvalueStudent(as.matrix(geneTraitSignificance), nSamples));
names(geneTraitSignificance) = paste("GS.", names(weight), sep="");
names(GSPvalue) = paste("p.GS.", names(weight), sep="");
##Plotting the graph
module = "plum1"
column = match(module, modNames);
moduleGenes = moduleColors==module;
pdf("plum1.pdf", width = 7, height = 7);
par(mfrow = c(1,1));
verboseScatterplot(abs(geneModuleMembership[moduleGenes, column]),
abs(geneTraitSignificance[moduleGenes, 1]),
xlab = paste("Module Membership in", module, "module"),
ylab = "Gene significance",
main = paste("Module membership vs. gene significance\n"),
cex.main = 1.2, cex.lab = 1.2, cex.axis = 1.2, col = module)
It runs without any error but does not give the scatter plot output. Thank you!

biwavelet package: "cex.axis" not working in plot.biwavelet(); A bug?

I am using biwavelet package to conduct wavelet analysis. However, when I want to adjust the label size for axis using cex.axis, the label size does not changed. On the other hand, cex.lab and cex.main are working well. Is this a bug? The following gives a reproducible example.
library(biwavelet)
t1 <- cbind(1:100, rnorm(100))
t2 <- cbind(1:100, rnorm(100))
# Continuous wavelet transform
wt.t1 <- wt(t1)
par(oma = c(0, 0.5, 0, 0), mar = c(4, 2, 2, 4))
plot(wt.t1,plot.cb = T,plot.phase = T,type = 'power.norm',
xlab = 'Time(year)',ylab = 'Period(year)',mgp=c(2,1,0),
main='Winter station 1',cex.main=0.8,cex.lab=0.8,cex.axis=0.8)
Edit
There was a previous question on this site a month ago: Wavelets plot: changing x-, y- axis, and color plot, but not solved. Any help this time? Thank you!
Yeah, it is a bug. Here is patched version: my.plot.biwavelet()
This version accepts argument cex.axis (defaults to 1), and you can change it when needed. I will briefly explain to you what the problem is, in the "explanation" section in the end.
my.plot.biwavelet <- function (x, ncol = 64, fill.cols = NULL, xlab = "Time", ylab = "Period",
tol = 1, plot.cb = FALSE, plot.phase = FALSE, type = "power.corr.norm",
plot.coi = TRUE, lwd.coi = 1, col.coi = "white", lty.coi = 1,
alpha.coi = 0.5, plot.sig = TRUE, lwd.sig = 4, col.sig = "black",
lty.sig = 1, bw = FALSE, legend.loc = NULL, legend.horiz = FALSE,
arrow.len = min(par()$pin[2]/30, par()$pin[1]/40), arrow.lwd = arrow.len *
0.3, arrow.cutoff = 0.9, arrow.col = "black", xlim = NULL,
ylim = NULL, zlim = NULL, xaxt = "s", yaxt = "s", form = "%Y", cex.axis = 1,
...) {
if (is.null(fill.cols)) {
if (bw) {
fill.cols <- c("black", "white")
}
else {
fill.cols <- c("#00007F", "blue", "#007FFF",
"cyan", "#7FFF7F", "yellow", "#FF7F00", "red",
"#7F0000")
}
}
col.pal <- colorRampPalette(fill.cols)
fill.colors <- col.pal(ncol)
types <- c("power.corr.norm", "power.corr", "power.norm",
"power", "wavelet", "phase")
type <- match.arg(tolower(type), types)
if (type == "power.corr" | type == "power.corr.norm") {
if (x$type == "wtc" | x$type == "xwt") {
x$power <- x$power.corr
x$wave <- x$wave.corr
}
else {
x$power <- x$power.corr
}
}
if (type == "power.norm" | type == "power.corr.norm") {
if (x$type == "xwt") {
zvals <- log2(x$power)/(x$d1.sigma * x$d2.sigma)
if (is.null(zlim)) {
zlim <- range(c(-1, 1) * max(zvals))
}
zvals[zvals < zlim[1]] <- zlim[1]
locs <- pretty(range(zlim), n = 5)
leg.lab <- 2^locs
}
else if (x$type == "wtc" | x$type == "pwtc") {
zvals <- x$rsq
zvals[!is.finite(zvals)] <- NA
if (is.null(zlim)) {
zlim <- range(zvals, na.rm = TRUE)
}
zvals[zvals < zlim[1]] <- zlim[1]
locs <- pretty(range(zlim), n = 5)
leg.lab <- locs
}
else {
zvals <- log2(abs(x$power/x$sigma2))
if (is.null(zlim)) {
zlim <- range(c(-1, 1) * max(zvals))
}
zvals[zvals < zlim[1]] <- zlim[1]
locs <- pretty(range(zlim), n = 5)
leg.lab <- 2^locs
}
}
else if (type == "power" | type == "power.corr") {
zvals <- log2(x$power)
if (is.null(zlim)) {
zlim <- range(c(-1, 1) * max(zvals))
}
zvals[zvals < zlim[1]] <- zlim[1]
locs <- pretty(range(zlim), n = 5)
leg.lab <- 2^locs
}
else if (type == "wavelet") {
zvals <- (Re(x$wave))
if (is.null(zlim)) {
zlim <- range(zvals)
}
locs <- pretty(range(zlim), n = 5)
leg.lab <- locs
}
else if (type == "phase") {
zvals <- x$phase
if (is.null(zlim)) {
zlim <- c(-pi, pi)
}
locs <- pretty(range(zlim), n = 5)
leg.lab <- locs
}
if (is.null(xlim)) {
xlim <- range(x$t)
}
yvals <- log2(x$period)
if (is.null(ylim)) {
ylim <- range(yvals)
}
else {
ylim <- log2(ylim)
}
image(x$t, yvals, t(zvals), zlim = zlim, xlim = xlim,
ylim = rev(ylim), xlab = xlab, ylab = ylab, yaxt = "n",
xaxt = "n", col = fill.colors, ...)
box()
if (class(x$xaxis)[1] == "Date" | class(x$xaxis)[1] ==
"POSIXct") {
if (xaxt != "n") {
xlocs <- pretty(x$t) + 1
axis(side = 1, at = xlocs, labels = format(x$xaxis[xlocs],
form))
}
}
else {
if (xaxt != "n") {
xlocs <- axTicks(1)
axis(side = 1, at = xlocs, cex.axis = cex.axis)
}
}
if (yaxt != "n") {
axis.locs <- axTicks(2)
yticklab <- format(2^axis.locs, dig = 1)
axis(2, at = axis.locs, labels = yticklab, cex.axis = cex.axis)
}
if (plot.coi) {
polygon(x = c(x$t, rev(x$t)), lty = lty.coi, lwd = lwd.coi,
y = c(log2(x$coi), rep(max(log2(x$coi), na.rm = TRUE),
length(x$coi))), col = adjustcolor(col.coi,
alpha.f = alpha.coi), border = col.coi)
}
if (plot.sig & length(x$signif) > 1) {
if (x$type %in% c("wt", "xwt")) {
contour(x$t, yvals, t(x$signif), level = tol,
col = col.sig, lwd = lwd.sig, add = TRUE, drawlabels = FALSE)
}
else {
tmp <- x$rsq/x$signif
contour(x$t, yvals, t(tmp), level = tol, col = col.sig,
lwd = lwd.sig, add = TRUE, drawlabels = FALSE)
}
}
if (plot.phase) {
a <- x$phase
locs.phases <- which(zvals < quantile(zvals, arrow.cutoff))
a[locs.phases] <- NA
phase.plot(x$t, log2(x$period), a, arrow.len = arrow.len,
arrow.lwd = arrow.lwd, arrow.col = arrow.col)
}
box()
if (plot.cb) {
fields::image.plot(x$t, yvals, t(zvals), zlim = zlim, ylim = rev(range(yvals)),
xlab = xlab, ylab = ylab, col = fill.colors,
smallplot = legend.loc, horizontal = legend.horiz,
legend.only = TRUE, axis.args = list(at = locs,
labels = format(leg.lab, dig = 2)), xpd = NA)
}
}
Test
library(biwavelet)
t1 <- cbind(1:100, rnorm(100))
t2 <- cbind(1:100, rnorm(100))
# Continuous wavelet transform
wt.t1 <- wt(t1)
par(oma = c(0, 0.5, 0, 0), mar = c(4, 2, 2, 4))
my.plot.biwavelet(wt.t1,plot.cb = T,plot.phase = T,type = 'power.norm',
xlab = 'Time(year)',ylab = 'Period(year)',mgp=c(2,1,0),
main='Winter station 1',cex.main=0.8,cex.lab=0.8,cex.axis=0.8)
As expected, it is working.
Explanation
In plot.biwavelet(), why passing cex.axis via ... does not work?
plot.biwavelet() generates the your final plot mainly in 3 stages:
image(..., xaxt = "n", yaxt = "n") for generating basic plot;
axis(1, at = atTicks(1)); axis(2, at = atTicks(2)) for adding axis;
fields::image.plot() for displaying colour legend strip.
Now, although this function takes ..., they are only fed to the first image() call, while the following axis(), (including polygon(), contour(), phase.plot()) and image.plot() take none from .... When later calling axis(), no flexible specification with respect to axis control are supported.
I guess during package development time, problem described as in: Giving arguments from “…” argument to right function in R had been encountered. Maybe the author did not realize this potential issue, leaving a bug here. My answer to that post, as well as Roland's comments, points toward a robust fix.
I am not the package author so can not decide how he will fix this. My fix is brutal, but works for you temporary need: just add the cex.axis argument to axis() call. I have reached Tarik (package author) with an email, and I believe he will give you a much better explanation and solution.
I fixed this issue by passing the ... argument to axis in plot.biwavelet. Your code should now work as desired. Note that changes to cex.axis and other axis arguments will affect all three axes (x, y, z).
You can download the new version (0.20.8) of biwavelet from GitHub by issuing the following command at the R console (this assumes that you have the package devtools already installed): devtools::install_github("tgouhier/biwavelet")
Thanks for pointing out the bug!

R: How to add highlighted angle lines in polar plots?

Please consider the following sample polar plot:
library(plotrix)
testlen <- c(rnorm(36)*2 + 5)
testpos <- seq(0, 350, by = 10)
polar.plot(testlen, testpos, main = "Test Polar Plot",
lwd = 3, line.col = 4, rp.type = "s")
I would like to add lines at angles 30 and 330 as well as 150 and 210 (from the center to the outside). I experimented with the line function but could not get it to work.
The calculations for exact placement are a bit goofy but using your test data
set.seed(15)
testlen<-c(rnorm(36)*2+5)
testpos<-seq(0,350,by=10)
polar.plot(testlen,testpos,main="Test Polar Plot",
lwd=3,line.col=4,rp.type="s")
You can add lines at 20,150,210,300 with
add.line <- c(30,330, 150,210)/360*2*pi
maxlength <- max(pretty(range(testlen)))-min(testlen)
segments(0, 0, cos(add.line) * maxlength, sin(add.line) * maxlength,
col = "red")
And that makes the following plot
You can just use the rp.type = "r" argument and add = TRUE. So, something like
library(plotrix)
set.seed(1)
testlen <- c(rnorm(36)*2 + 5)
testpos <- seq(0,350, by = 10)
polar.plot(testlen, testpos, main = "Test Polar Plot",
lwd = 3, line.col = 4, rp.type = "s")
followed by
pos <- c(30, 330, 150, 210)
len <- c(10, 10, 10, 10)
polar.plot(lengths = len, polar.pos = pos,
radial.lim = c(0, 15),
lwd = 2, line.col = 2, rp.type = "r", add = TRUE)
yields your desired output.

labeling points on an archetype archmap

How might one add labels to an archmap from the archetypes package? Or alternatively, would it be possible to recreate the archmap output in ggplot?
Using code from the SportsAnalytics demo (I hope this isn't bad form)
library("SportsAnalytics")
library("archetypes")
data("NBAPlayerStatistics0910")
dat <- subset(NBAPlayerStatistics0910,
select = c(Team, Name, Position,
TotalMinutesPlayed, FieldGoalsMade))
mat <- as.matrix(subset(dat, select = c(TotalMinutesPlayed, FieldGoalsMade)))
a3 <- archetypes(mat, 3)
archmap(a3)
I'd like the player names ( NBAPlayerStatistics0910$Name ) over the points on the chart. Something like below but more readable.
If you don't mind tweaking things a bit, you can start with the archmap() function base, toss in an extra parameter and add a text() call:
amap2 <- function (object, a.names, projection = simplex_projection, projection_args = list(),
rotate = 0, cex = 1.5, col = 1, pch = 1, xlab = "", ylab = "",
axes = FALSE, asp = TRUE, ...)
{
stopifnot("archetypes" %in% class(object))
stopifnot(is.function(projection))
k <- object$k
if (k < 3) {
stop("Need at least 3 archetypes.\n")
}
cmds <- do.call(projection, c(list(parameters(object)), projection_args))
if (rotate != 0) {
a <- pi * rotate/180
A <- matrix(c(cos(a), -sin(a), sin(a), cos(a)), ncol = 2)
cmds <- cmds %*% A
}
hmds <- chull(cmds)
active <- 1:k %in% hmds
plot(cmds, type = "n", xlab = xlab, ylab = ylab, axes = axes,
asp = asp, ...)
points(coef(object) %*% cmds, col = col, pch = pch)
######################
# PLAY WITH THIS BIT #
######################
text(coef(object) %*% cmds, a.names, pos=4)
######################
rad <- ceiling(log10(k)) + 1.5
polygon(cmds[hmds, ])
points(cmds[active, ], pch = 21, cex = rad * cex, bg = "grey")
text(cmds[active, ], labels = (1:k)[active], cex = cex)
if (any(!active)) {
points(cmds[!active, , drop = FALSE], pch = 21, cex = rad *
cex, bg = "white", fg = "grey")
text(cmds[!active, , drop = FALSE], labels = (1:k)[!active],
cex = cex, col = "grey20")
}
invisible(cmds)
}
amap2(a3, dat$Name)
Obviously, my completely quick stab is not the end result you're looking for, but it should help you get on your way (if I read what you want to do correctly).

Adding title to the plot function as a list in R

I am using this code for plotting list of variables in a single page:
plot30 <- list(HMn25_30,HMn28_30,HMn29_30,HMn31_30,HMn32_30)
par(mfrow=c(2,3))
for (i in plot30) {
plot(i, type = "o", pch = 16, lty = 2, col = "Black", xlab = "Hour 2007/09/30" , ylab = "Ambient Tempreture")
}
Result of this code:
I wanted to add titles such as {Node 25,Node 28,Node 29,Node 31,Node 32} to the plots.
Any suggestion?
try to add the following in your for loop
plot30 <- list(HMn25_30,HMn28_30,HMn29_30,HMn31_30,HMn32_30)
Main <- c('Node 25','Node 28','Node 29','Node 31','Node 32')
par(mfrow=c(2,3))
for (i in seq_along(plot30)) {
plot(plot30[[i]], type = "o", pch = 16, lty = 2, col = "Black", xlab = "Hour 2007/09/30" , ylab = "Ambient Tempreture", main=Main[i])
}
This is the construct you should expand from:
plot30 <- list(myplot)
names(plot30)<- c('myplot1')
for (i in seq_along(plot30) ) {pname <- names(plot30)[i]
plot(plot30[i], main=pname)
}

Resources