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 have created 3 rows with 3 figures each and would like to centre the last 2 figures to achieve visual representativity since they are aligned to the left side of my multiple plot. Is there any way of doing that without modifying the size of the graphs?
dat=read.csv("r1new.csv", header=TRUE, sep=",", dec="."); dat
par(mfrow=c(4,3))
par(mar=c(4,4,2,2))
############################################### WC 0.1 ###############################################
res.lm1 = lm(dat$wc_10_1~dat$m_wc_10_1, data=dat)
res.lm2 = lm(dat$wc_10_3~dat$m_wc_10_3, data=dat)
res.lm3 = lm(dat$wc_10_5~dat$m_wc_10_5, data=dat)
res.res1 = resid(res.lm1)
res.res2 = resid(res.lm2)
res.res3 = resid(res.lm3)
plot(dat$m_wc_10_1 [1:1731], res.res1,
ylab="Residuals",
xlab="modelled water content, 0.1 m",
main="",
xlim=c(0.05,0.55), ylim=c(-0.25,0.15),
type="p",
col="blue",
pch=16)
points(dat$m_wc_10_3 [1:814],res.res2, col="green3",pch=16)
points(dat$m_wc_10_5 [1:1768],res.res3, col="red",pch=16)
abline(0, 0, col="gold3", lwd=2)
You should check out layout. You need to define a matrix that shows the order and placement of graphs. Then these are filled in according to number. I believe the following example is approximately what you are looking for:
M <- matrix(rep(1:12, each = 2), nrow = 4, ncol = 3*2, byrow = T)
M[4,] <- c(0,10,10,11,11,0)
M
png("testplot.png", width = 6, height = 7, units = "in", res = 200)
layout(M)
layout.show(11)
op <- par(mar = c(3,3,0.5,0.5))
for(i in seq(11)){
plot(rnorm(10), rnorm(10))
}
par(op)
dev.off()
I have made a loop for making multiply plots, however i have no way of saving them, my code looks like this:
#----------------------------------------------------------------------------------------#
# RING data: Mikkel
#----------------------------------------------------------------------------------------#
# Set working directory
setwd()
#### Read data & Converting factors ####
dat <- read.table("Complete RING.txt", header =TRUE)
str(dat)
dat$Vial <- as.factor(dat$Vial)
dat$Line <- as.factor(dat$Line)
dat$Fly <- as.factor(dat$Fly)
dat$Temp <- as.factor(dat$Temp)
str(dat)
datSUM <- summaryBy(X0.5_sec+X1_sec+X1.5_sec+X2_sec+X2.5_sec+X3_sec~Vial_nr+Concentration+Sex+Line+Vial+Temp,data=dat, FUN=sum)
fl<-levels(datSUM$Line)
colors = c("#e41a1c", "#377eb8", "#4daf4a", "#984ea3")
meltet <- melt(datSUM, id=c("Concentration","Sex","Line","Vial", "Temp", "Vial_nr"))
levels(meltet$variable) <- c('0,5 sec', '1 sec', '1,5 sec', '2 sec', '2,5 sec', '3 sec')
meltet20 <- subset(meltet, Line=="20")
meltet20$variable <- as.factor(meltet20$variable)
AllConcentrations <- levels(meltet20$Concentration)
for (i in AllConcentrations) {
meltet.i <- meltet20[meltet20$Concentration ==i,]
quartz()
print(dotplot(value~variable|Temp, group=Sex, data = meltet.i ,xlab="Time", ylab="Total height pr vial [mm above buttom]", main=paste('Line 20 concentration ', meltet.i$Concentration[1]),
key = list(points = list(col = colors[1:2], pch = c(1, 2)),
text = list(c("Female", "Male")),
space = "top"), col = colors, pch =c(1, 2))) }
I have tried with the quartz.save function, but that just overwrites the files. Im using a mac if that makes any difference.
When I want to save multiple plots in a loop I tend to do something like...
for(i in AllConcentrations){
meltet.i <- meltet20[meltet20$Concentration ==i,]
pdf(paste("my_filename", i, ".pdf", sep = ""))
dotplot(value~variable|Temp, group=Sex, data = meltet.i ,xlab="Time", ylab="Total height pr vial [mm above buttom]", main=paste('Line 20 concentration ', meltet.i$Concentration[1]),
key = list(points = list(col = colors[1:2], pch = c(1, 2)),
text = list(c("Female", "Male")),
space = "top"), col = colors, pch =c(1, 2))
dev.off()
}
This will create a pdf file for every level in AllConcentrations and save it in your working directory. It will paste together my_filename, the number of the iteration i, and then .pdf together to make each file unique. Of course, you will want to adjust height and width in the pdf function.
I am trying to develop pictorial charts. Is it possible to develop such charts in R ?
myd <- data.frame (categories = c("Planes", "Ships", "Cars", "Trains"),
values = c(15, 18, 22, 11))
Component icons are here:
Hope that this would be helpful four your house / parliament floor
Edit: I forget to mention my reference and I add some explanations.
library(lattice)
library(grid)
imgs.names <- c('WNinq','7dqJM','9E3Wj','tStmx')
library(png)
images <- lapply(imgs.names, function(x)
readPNG(paste(mypath,x,'.png',sep=''),native=TRUE))
## I generate some data because we don't give a reproducible example
x <- c(rep(0,4),rep(10,9),rep(20,3),rep(5,8),rep(4,8),rep(15,4),rep(13,8))
barchart(1:4~x, origin=0, col="yellow",xlim=c(0,30),
xlab ='values',ylab='categories',title = 'Pictorial',
scales = list(
y = list(cex=2,col='blue', at = 1:4,labels = c('Trains','Cars','Ships','Planes')),
x = list(cex=2,col='blue',at=seq(0,30,by=10))
),
panel=function(x, y, ...) {
panel.fill(col = rgb(1,1,205/255)) ## I had to pick up the same yellow color!!
panel.grid()
lapply(1:4,function(id){
grid.raster(images[[id]], x=x[which(y==id)], y=y[which(y==id)],
default.units="native",
just="left",
width =unit(2, "native"),
height=unit(0.7, "native"))
}
)
}
)