Related
I'm trying to make a multipanel figure with networks in the igraph package. I'd like 2 rows, each with 3 networks. I need to be able to save the figure as a PNG and I'd like to label them each A:F in one of the corners. I've tried to do this in a loop but only one network appears in the figures. I need the V(nw)$x<- y and E(nw)$x<- y code in the loop to make my networks come out properly. My networks are in a list().
I've made a small sample of the code I've tried, I would like to avoid doing it without a loop if I can. Thanks in advance.
srs_1nw <- graph("Zachary")
srs_2nw <- graph("Heawood")
srs_3nw <- graph("Folkman")
srs_1c <- cluster_fast_greedy(srs_1nw)
srs_2c <- cluster_fast_greedy(srs_2nw)
srs_3c <- cluster_fast_greedy(srs_3nw)
listofsrs_nws <- list(srs_1nw,srs_2nw,srs_3nw)
listofsrs_cs <- list(srs_1c,srs_2c,srs_3c)
colours <- c("red","blue","green","yellow")
par(mfrow=c(2,3))
for (i in length(listofsrs_nws)) {
c<-listofsrs_cs[[i]]
nw<-listofsrs_nws[[i]]
V(nw)$size <- log(strength(nw))*6 # weighted nodes
E(nw)$arrow.size <- 2 # arrow size
c.colours <- colours[membership(c)]
plot(c, nw, col = c.colours,
mark.col = adjustcolor(colours, alpha.f = 0.4),
mark.border = adjustcolor(colours, alpha.f = 1),
vertex.frame.width = 5, edge.curved = .15)
}
We can use mapply like below
mapply(function(c, nw) {
V(nw)$size <- log(strength(nw)) * 6 # weighted nodes
E(nw)$arrow.size <- 2 # arrow size
c.colours <- colours[membership(c)]
plot(c, nw,
col = c.colours,
mark.col = adjustcolor(colours, alpha.f = 0.4),
mark.border = adjustcolor(colours, alpha.f = 1),
vertex.frame.width = 5, edge.curved = .15
)
}, listofsrs_cs, listofsrs_nws)
I want to fit my points with logarithmic curve. Here is my data which contains x and y. I desire to plot x and y and the add a logarithmic fitting curve.
x<-structure(list(X2.y = c(39.99724745, 29.55541525, 23.39578201,
15.46797044, 10.52063652, 7.296161198, 6.232038434, 4.811851132,
4.641281547, 4.198523289, 3.325515839, 2.596563723, 1.894902523,
1.556380314), X5.y = c(62.76037622, 48.54726084, 37.71302646,
24.93942365, 17.71060023, 13.31130267, 10.36341862, 7.706914722,
7.170517624, 6.294292013, 4.917428837, 3.767836298, 2.891519878,
2.280974128), X10.y = c(77.83154815, 61.12151516, 47.19228808,
31.21034981, 22.47098182, 17.29384973, 13.09875178, 9.623698726,
8.845091983, 7.681873268, 5.971413758, 4.543320659, 3.551367285,
2.760718282), X25.y = c(96.87401383, 77.00911883, 59.16936025,
39.13368164, 28.48573658, 22.32580849, 16.55485248, 12.0455604,
10.96092113, 9.435085861, 7.303126501, 5.523147205, 4.385086234,
3.366876291), X50.y = c(111.0008027, 88.79545082, 68.05463659,
45.01166182, 32.94782526, 26.05880295, 19.11878542, 13.84223574,
12.53056405, 10.73571912, 8.291067088, 6.25003851, 5.003586577,
3.81655893), X100.y = c(125.0232816, 100.4947544, 76.87430545,
50.84623991, 37.37696657, 29.76423356, 21.66378667, 15.6256447,
14.08861698, 12.0267487, 9.271712877, 6.971562563, 5.61752001,
4.262921183)), class = "data.frame", row.names = c(NA, -14L))
I tried this:
single_idf<-function(x) {
idf<-x
durations = c(5/60, 10/60, 15/60, 30/60, 1, 2, 3, 4, 5, 6, 8, 12, 18, 24)
nd = length(durations)
Tp = c(2, 5, 10, 25, 50, 100)
nTp = length(Tp)
psym = seq(1, nTp)
# open new window for this graph, set plotting parameters for a single graph panel
windows()
par(mfrow = c(1,1), mar = c(5, 5, 5, 5), cex = 1)
# set up custom axis labels and grid line locations
ytick = c(1,2,3,4,5,6,7,8,9,10,20,30,40,50,60,70,80,90,100,
200,300,400,500,600,700,800,900,1000,1100,1200,1300,1400)
yticklab = as.character(ytick)
xgrid = c(5,6,7,8,9,10,15,20,30,40,50,60,120,180,240,300,360,
420,480,540,600,660,720,840,960,1080,1200,1320,1440)
xtick = c(5,10,15,20,30,60,120,180,240,300,360,480,720,1080,1440)
xticklab = c("5","10","15","20","30","60","2","3","4","5","6","8","12","18","24")
ymax1 = max(idf)
durations = durations*60
plot(durations, col=c("#FF00FF") ,lwd=c(1), idf[, 1],
xaxt="n",yaxt="n",
pch = psym[1], log = "xy",
xlim = c(4, 24*60), ylim = range(c(1,idf+150)),
xlab = "(min) Duration (hr)",
ylab = "Intensity (mm/hr)"
)
for (iT in 2:nTp) {
points(durations, idf[, iT], pch = psym[iT], col="#FF00FF",lwd=1)
}
for (iT in 1:nTp) {
mod.lm = lm(log10(idf[, iT]) ~ log10(durations))
b0 = mod.lm$coef[1]
b1 = mod.lm$coef[2]
yfit = log(10^(b0 + b1*log10(durations)))
lines(durations,col=c("#FF00FF"),yfit, lty = psym[iT],lwd=1)
}
}
But when I run this, the curves stands far away from the points. I want to see curves over the points. How can I arrange this?
single_idf(x)
Consider this as an option for you using ggplot2 and dplyr. Also added method='lm' to match OP expected output (Many thanks and credits to #AllanCameron for his magnificent advice):
library(ggplot2)
library(dplyr)
#Data
df <- data.frame(x,y)
#Plot
df %>%
pivot_longer(-y) %>%
ggplot(aes(x=log(y),y=log(value),color=name,group=name))+
geom_point()+
stat_smooth(geom = 'line',method = 'lm')
Output:
The main problem is that you were plotting the natural log of the fit rather than the fit itself.
If you change the line
yfit = log(10^(b0 + b1*log10(durations)))
To
yfit = 10^(b0 + b1*log10(durations))
And rerun your code, you get
I would like to plot several forecasts on the same plot in different colours, however, the scale is off.
I'm open to any other methods.
reproducible example:
require(forecast)
# MAKING DATA
data <- c(3.86000, 19.55810, 19.51091, 20.74048, 20.71333, 29.04191, 30.28864, 25.64300, 23.33368, 23.70870 , 26.16600 ,27.61286 , 27.88409 , 28.41400 , 24.81957 , 24.60952, 27.49857, 32.08000 , 29.98000, 27.49000 , 237.26150, 266.35478, 338.30000, 377.69476, 528.65905, 780.00000 )
a.ts <- ts(data,start=c(2005,1),frequency=12)
# FORECASTS
arima011_css =stats::arima(x = a.ts, order = c(0, 1, 1), method = "CSS") # css estimate
arima011_forecast = forecast(arima011_css, h=10, level=c(99.5))
arima321_css =stats::arima(x = a.ts, order = c(3, 2, 1), method = "CSS") # css estimate
arima321_forecast = forecast(arima321_css, h=10, level=c(99.5))
# MY ATTEMPT AT PLOTS
plot(arima321_forecast)
par(new=T)
plot(arima011_forecast)
Here is something similar to #jay.sf but using ggplot2.
library(ggplot2)
autoplot(a.ts) +
autolayer(arima011_forecast, series = "ARIMA(0,1,1)", alpha = 0.5) +
autolayer(arima321_forecast, series = "ARIMA(3,2,1)", alpha = 0.5) +
guides(colour = guide_legend("Model"))
Created on 2020-05-19 by the reprex package (v0.3.0)
You could do a manual plot using a sequence of dates.
rn <- format(seq.Date(as.Date("2005-01-01"), by="months", length.out=12*3), "%Y.%m")
Your ARIMAs you'll need as.matrix form.
arima321_mat <- as.matrix(as.data.frame(arima321_forecast))
arima011_mat <- as.matrix(as.data.frame(arima011_forecast))
Some colors with different alpha=.
col.1 <- rainbow(2, ,.7)
col.2 <- rainbow(2, ,.7, alpha=.2)
For the CIs use polygon.
plot(data, type="l", xlim=c(1, length(rn)), ylim=c(0, 3500), xaxt="n", main="Forecasts")
axis(1, axTicks(1), labels=F)
mtext(rn[(seq(rn)-1) %% 5 == 0], 1, 1, at=axTicks(1))
lines((length(data)+1):length(rn), arima321_mat[,1], col=col.1[1], lwd=2)
polygon(c(27:36, 36:27), c(arima321_mat[,2], rev(arima321_mat[,3])), col=col.2[1],
border=NA)
lines((length(data)+1):length(rn), arima011_mat[,1], col=col.1[2], lwd=3)
polygon(c(27:36, 36:27), c(arima011_mat[,2], rev(arima011_mat[,3])), col=col.2[2],
border=NA)
legend("topleft", legend=c("ARIMA(3,2,1)", "ARIMA(0,1,1)"), col=col.1, lwd=2, cex=.9)
Edit: To avoid the repetition of lines and polygon calls, you may unite them using Map.
mats <- list(arima321_mat, arima011_mat) ## put matrices into list
plot(.)
axis(.)
mtext(.)
Map(function(i) {
lines((length(data)+1):length(rn), mats[[i]][,1], col=col.1[i], lwd=2)
polygon(c(27:36, 36:27), c(mats[[i]][,2], rev(mats[[i]][,3])), col=col.2[i], border=NA)
}, 1:2)
legend(.)
require(forecast)
data <- c(3.86000, 19.55810, 19.51091, 20.74048, 20.71333, 29.04191, 30.28864, 25.64300, 23.33368, 23.70870 , 26.16600 ,27.61286 , 27.88409 , 28.41400 , 24.81957 , 24.60952, 27.49857, 32.08000 , 29.98000, 27.49000 , 237.26150, 266.35478, 338.30000, 377.69476, 528.65905, 780.00000 )
a.ts <- ts(data,start=c(2005,1),frequency=12)
arima011_css =stats::arima(x = a.ts, order = c(0, 1, 1), method = "CSS") # css estimate
arima011_forecast = predict(arima011_css, n.ahead = 2)$pred
arima321_css =stats::arima(x = a.ts, order = c(3, 2, 1), method = "CSS") # css estimate
arima321_forecast = predict(arima321_css, n.ahead = 2)$pred
plot(a.ts, type = "o", xlim = c(2005, 2007.5) , ylim = c(-1, 1200) , ylab = "price" ,main = "2 month Forecast")
range = c(2007+(3/12), 2007+(4/12)) # adding the dates for the prediction
lines(y = arima011_forecast , x = range , type = "o", col = "red")
lines(y = arima321_forecast, x = range , type = "o", col = "blue")
Just a quick question: I want to remove plot elements. Such as col, main etc.
I am adding a picture to you can understand better.
https://hizliresim.com/XMQr0R
str(nr)
kmncluster <- kmeans(na.omit(nr), centers = 10, iter.max = 500, nstart = 5, algorithm="Lloyd")
knr <- ndvi
knr[] <- kmncluster$cluster
values(knr) <- kmncluster$cluster
mycolor <- c("#fef65b","#ff0000", "#daa520","#0000ff","#0000ff","#00ff00","#cbbeb5",
"#c3ff5b", "#ff7373", "#00ff00", "#808080")
par(mfrow = c(1,2))
plot(ndvi, col = rev(terrain.colors(10)), main = 'Landsat-NDVI')
plot(knr, main = 'Unsupervised classification', col = mycolor )
dev.off()
I just want to keep the picture. I don't want to see any other information.
I want to make the fontsize of the y-axis labels adjustable to the input data size on the y-axis like in Fig. 3, in contrast to the current situation in Fig. 1-2 where labels are not next to the corresponding lines.
Code
library("corrgram")
# https://stackoverflow.com/a/40387233/54964
ids <- seq(1,18)
x_at <- seq(0.075, 0.925, length.out = length(ids))
y_at <- seq(0.075, 0.91, length.out = length(ids))
createLabels <- function(xlab, ylab, x_labels, y_labels){
ids <- y_labels # assume here
x_at <- seq(0.075, 0.925, length.out = length(ids))
y_at <- seq(0.075, 0.91, length.out = length(ids))
mtext(xlab, side = 1, line = 4)
mtext(ylab, side = 2, line = 3)
axis(1, at=x_at, labels=x_labels, line = 1.5, tick=F, cex.axis=.7)
axis(2, at=y_at, labels=y_labels, line = 1, tick=F, cex.axis=.7, las=1) # horizontal y-axis labels; rawr
}
corrgram(baseball,main="Baseball data PC2/PC1 order")
createLabels(xlab="Patient 1 ID", ylab="Patient 2 ID", x_labels=ids, y_labels=ids)
Fig. 1 Output with the limited test data baseball,
Fig. 2 Output with the real case,
Fig. 3 Expected output
Expected output: automatically adjustable label font size to the input data size on the y-axis; example of the output created by makeMatrixPlot(list, ids, title) found here in Fig. 3
Testing Istrel's answer with big data set where long IDs
Complete code here which visualises correctly but gives backside strange outputs an NULLs, here some key points about optimised parameters
# https://stackoverflow.com/a/40485734/54964
cex_lab<-0.9 # little smaller fontsize for matrix >= 20x20
oma<-c(4, 4, 6, 4)
gap<-0
las<-2 # both axis labels always perpendicular
Output complications as the warning and many NULLs
In max(l.wid) : no non-missing arguments to max; returning -Inf
[[1]]
[[1]][[1]]
NULL
...
[[1]][[7]]
NULL
[[2]]
[[2]][[1]]
NULL
...
[[2]][[7]]
NULL
[[3]]
[[3]][[1]]
NULL
...
[[3]][[7]]
NULL
Call it for instance by
library("corrplot")
library("psych")
ids <- seq(1,11)
M.cor <- cor(mtcars)
colnames(M.cor) <- ids
rownames(M.cor) <- ids
p.mat <- psych::corr.test(M.cor, adjust = "none", ci = F)
p.mat <- p.mat[["r"]]
corrplot(M.cor,
method = "color",
type = "upper",
tl.col = 'black',
diag = TRUE,
p.mat = p.mat,
sig.level = 0.0000005
)
createLabels(xlab="Patient 1 ID", ylab="Patient 2 ID and Ages", x_labels=ids, y_labels="")
R: 3.3.1
Used graphic objects: corrplot, corrgram, ...
OS: Debian 8.5
Corrgram uses mfrow from par() for squares drawing. We can use that for labeling. The number of labels should be equal to the number of columns in the matrix. If you set oma or gap arguments in corrgram function, you have to specify same parameters in createLabels function.
BTW, if you use corrgram without main argument, you will need oma=c(4,4,4,4) in createLabels
createLabels <- function(xlab, ylab, x_labels, y_labels,
cex_lab=1.3, oma=c(4, 4, 6, 4), gap=0, las=0){
# oma and gap args same as in corrgram
nc <- length(x_labels) # get number of columns
# Inititate mfrow partition as in corrgram
opar <- par(mfrow = c(nc, nc), mar = rep.int(gap/2, 4), oma = oma) #save old par parameters
# Create matrix of outer cells indexes and positions
left_side <- matrix(c(nc:1, rep(1, nc), rep(2, nc)), nc)
bottom_side <- matrix(c(rep(nc, nc), 1:nc, rep(1, nc)), nc)
sides <- rbind(left_side, bottom_side)
# Dublicate labels vector
labels <- c(y_labels, x_labels)
# Loop over each outer cell
for (i in c(1:(nc*2))){
cell_ind <- sides[i, ]
par(mfg=c(cell_ind[1], cell_ind[2], nc, nc)) # set current plotting cell
usr<-par("usr")
clip(usr[1], -2, usr[3], usr[4]) # alter clipping region
axis(cell_ind[3], at=0.5, labels=labels[i],
outer=TRUE, xpd=NA, lwd=NA, mgp=c(3,0,0.2), cex.axis=cex_lab, las=las)
}
# Add labels
par(opar)
mtext(xlab, side = 1, line = -1.5, outer=TRUE, xpd=NA)
mtext(ylab, side = 2, line = -1.5, outer=TRUE, xpd=NA)
}
corrgram(baseball,main="Baseball data PC2/PC1 order")
createLabels(xlab="Patient 1 ID", ylab="Patient 2 ID", 1:18, 1:18)
The corrgram package has been updated (version 1.11) with better support for labels along the axes. I've used the basic idea from Leo and added it to the package. For example:
require(corrgram)
labs=colnames(state.x77)
corrgram(state.x77, oma=c(7, 7, 2, 2),
outer.labels=list(bottom=list(labels=labs,cex=1.5,srt=60),
left=list(labels=labs,cex=1.5,srt=30)))
mtext("Bottom", side=1, cex=2, line = -1.5, outer=TRUE, xpd=NA)
mtext("Left", side=2, cex=2, line = -1.5, outer=TRUE, xpd=NA)