I draw a calibration plot with the R code from:http://rpubs.com/IL2/519772
require(rms)
library(Hmisc)
library(grid)
library(lattice)
library(Formula)
library(ggplot2)
library(survival)
library(survival)
data(lung)
lung$sex <- factor(lung$sex,levels = c(1,2),labels = c("male", "female"))
dd=datadist(lung)
options(datadist="dd")
fit1<- lrm(status~ age + sex+ ph.karno,x=T,y=T, data = lung)
cal1 <- calibrate(fit1,X=T,Y=T, method='boot',m=76,B=228)
plot(cal1,lwd=2,lty=1,
cex.lab=1.2, cex.axis=1, cex.main=1.2, cex.sub=0.6,
xlim = c(0,1),ylim= c(0,1),
xlab="Nomogram-Predicted Probability of death risk",
ylab="Actual death (proportion)",
col=c("#00468BFF","#ED0000FF","#42B540FF")
)
lines(cal1[,c(1:3)],
type ="o",
lwd = 1,
pch = 16,
col=c("#00468BFF"))
abline(0,1,lty = 3,
lwd = 2,
col = c("#224444")
)
However, my plot cannot show all the legend of "apparent, Bias-corrected, Ideal".
How to edit the plot like the following?
You could use legend=FALSE option and create a custom legend and define exact positions.
plot(cal1, lwd=2, lty=1,
cex.lab=1.2, cex.axis=1, cex.main=1.2, cex.sub=0.6,
xlim=c(0, 1), ylim= c(0, 1),
xlab="Nomogram-Predicted Probability of death risk",
ylab="Actual death (proportion)",
col=c("#00468BFF", "#ED0000FF", "#42B540FF"),
legend=FALSE)
lines(cal1[, c(1:3)], type ="o", lwd=1, pch=16, col=c("#00468BFF"))
abline(0, 1, lty=3, lwd=2, col=c("#224444"))
legend(x=.6, y=.4, legend=c("Apparent", "Bias-corrected", "Ideal"),
lty=c(3, 1, 2), bty="n")
As you just found out on your own, to make the legend even narrower we can use option y.intersp inside legend, e.g. legend(... y.intersp=.8).
Related
Am trying to plot 2 different columns of a time series data type in a single plot, however the year appears which seems to block the view of the chart. How do I remove the year in the chart so that I can see the charts nicely?
The below code is how i created the chart
data('fertil3')
fertil = ts(fertil3, frequency = 1, start = 1913)
plot(x = fertil[,"year"], y = fertil[,"gfr"], type="l", col="red", ylim = c(0, 250), xlab="Time", ylab="")
par(new=TRUE)
plot(x = fertil[,"year"], y = fertil[,"pe_1"], type="l", col="blue", ylim = c(0, 250),xlab="Time", ylab="")
You should convert the time series object ts to as.numeric which then is a vector and can be used to plot it like lines like this:
library(wooldridge)
data('fertil3')
fertil = ts(fertil3, frequency = 1, start = 1913)
plot(x = as.numeric(fertil[,"year"]), y = as.numeric(fertil[,"gfr"]), type="l", col="red", ylim = c(0, 250), xlab="Time", ylab="")
par(new=TRUE)
plot(x = as.numeric(fertil[,"year"]), y = as.numeric(fertil[,"pe_1"]), type="l", col="blue", ylim = c(0, 250),xlab="Time", ylab="")
Created on 2022-10-15 with reprex v2.0.2
Perhaps plot as a base R time series...
Saves a bit of typing too!
library(wooldridge)
plot.ts(fertil[, c("gfr", "pe_1")], plot.type = "single", col=c("red", "blue"), ylim = c(0, 250), xlab="Time", ylab="" )
Created on 2022-10-15 with reprex v2.0.2
I was trying to follow this tutorial (https://popgen.nescent.org/2018-03-27_RDA_GEA.html) and plot the RDA, but I would like to remove the two dashed lines (x=0 and y=0). Does anyone know how to get rid of them?
This is the graph I'm talking about
According to this post you can alter a plot.rda() to remove the dotted lines if you build the plot up yourself from scratch, but it's a complicated/challenging task. The easiest/best solution in my opinion is to draw white lines over the dotted lines with abline(h = 0, v = 0, col = "white", lwd = 2) and redraw the plot borders with box() before you plot the points/lines. See the ## PLOTTING ## section below for an example:
## OBTAIN & LOAD THE DATA ##
#install.packages(c("psych","vegan"), dependencies=TRUE)
library(psych) # Used to investigate correlations among predictors
library(vegan) # Used to run RDA
temp <- tempfile()
download.file("https://github.com/NESCent/popgenInfo/blob/master/data/wolf_geno_samp_10000.zip?raw=true",
temp)
gen <- read.csv(unzip(temp, "wolf_geno_samp_10000.csv"), row.names=1)
dim(gen)
sum(is.na(gen))
gen.imp <- apply(gen,
2,
function(x) replace(x,
is.na(x),
as.numeric(names(which.max(table(x))))))
sum(is.na(gen.imp)) # No NAs
env <- read.csv(url("https://raw.githubusercontent.com/NESCent/popgenInfo/master/data/wolf_env.csv"))
str(env)
env$individual <- as.character(env$individual)
env$land_cover <- as.factor(env$land_cover)
identical(rownames(gen.imp), env[,1])
pairs.panels(env[,5:16], scale=T)
pred <- subset(env, select=-c(precip_coldest_quarter, max_temp_warmest_month, min_temp_coldest_month))
table(pred$land_cover)
pred <- subset(pred, select=-c(land_cover))
pred <- pred[,5:12]
colnames(pred) <- c("AMT","MDR","sdT","AP","cvP","NDVI","Elev","Tree")
pairs.panels(pred, scale=T)
wolf.rda <- rda(gen.imp ~ ., data=pred, scale=T)
wolf.rda
RsquareAdj(wolf.rda)
summary(eigenvals(wolf.rda, model = "constrained"))
screeplot(wolf.rda)
signif.full <- anova.cca(wolf.rda, parallel=getOption("mc.cores"))
signif.full
signif.axis <- anova.cca(wolf.rda, by="axis", parallel=getOption("mc.cores"))
signif.axis
vif.cca(wolf.rda)
plot(wolf.rda, scaling=3)
plot(wolf.rda, choices = c(1, 3), scaling=3)
levels(env$ecotype) <- c("Western Forest","Boreal Forest","Arctic","High Arctic","British Columbia","Atlantic Forest")
eco <- env$ecotype
bg <- c("#ff7f00","#1f78b4","#ffff33","#a6cee3","#33a02c","#e31a1c")
## PLOTTING ##
plot(wolf.rda, type="n", scaling=3)
abline(h = 0, v = 0, col = "white", lwd = 2)
box()
points(wolf.rda, display="species", pch=20, cex=0.7, col="gray32", scaling=3) # the SNPs
points(wolf.rda, display="sites", pch=21, cex=1.3, col="gray32", scaling=3, bg=bg[eco]) # the wolves
text(wolf.rda, scaling=3, display="bp", col="#0868ac", cex=1) # the predictors
legend("bottomright", legend=levels(eco), bty="n", col="gray32", pch=21, cex=1, pt.bg=bg)
plot(wolf.rda, type="n", scaling=3, choices=c(1,3))
abline(h = 0, v = 0, col = "white", lwd = 2)
box()
points(wolf.rda, display="species", pch=20, cex=0.7, col="gray32", scaling=3, choices=c(1,3))
points(wolf.rda, display="sites", pch=21, cex=1.3, col="gray32", scaling=3, bg=bg[eco], choices=c(1,3))
text(wolf.rda, scaling=3, display="bp", col="#0868ac", cex=1, choices=c(1,3))
legend("topleft", legend=levels(eco), bty="n", col="gray32", pch=21, cex=1, pt.bg=bg)
Also, in future, if you could please post the code required to obtain and load the data or a minimal, reproducible example, it would have made this question a lot easier to answer; see How to make a great R reproducible example
I have trouble in changing the month from numeric to name in the x-axis (refer to picture). Below are my code. I want to change the month (1,2,3,4,..) to (Jan,Feb,Mar,...) in the x-axis.
dd <- data.frame(beginning=c(6,6,6,7,7,8),
end=c(7,7,7,7,7,12),
solution=c("death", "death","death","death","death","recovered")
)
dd$id <- c(1:length(dd[,1]))
par(mfcol=c(1,1), mar=c(5,5,1.6,1),cex.lab=1)
plot(id~beginning, data=dd,
xlim=c(1,12), ylim=c(0, max(dd$id)+2),# axis limits
pch=NA, # dont plot points yet
yaxt="n", xaxt="n",
xlab="Month", ylab="Case No.")
axis(side=2, at=dd$id, labels=dd$id, las=1)
axis(side=1,
at=seq(1,12, by=1),
labels=seq(1,12, by=1))
with(dd, arrows(y0=id, x0=beginning, y1=id, x1=end, length = 0))
with(dd, points(beginning, id, pch=25, bg="red", cex=1.5))
dd$my.pch <- ifelse(dd$solution=="recovered",24,4)
with(dd, points(end, id, pch= my.pch, bg="green", cex=1.5))
legend("topleft", legend=c("ill", "recovered", "death"),
pch=c(25,24,4),
pt.bg= c("red", "green", "black"),
bty="n"
)
You need only a super small change to your code.
Replace labels=seq(1,12, by=1) with labels=month.name for full names or labels=month.abb for the abbreviated names:
dd <- data.frame(beginning=c(6,6,6,7,7,8),
end=c(7,7,7,7,7,12),
solution=c("death", "death","death","death","death","recovered")
)
dd$id <- c(1:length(dd[,1]))
par(mfcol=c(1,1), mar=c(5,5,1.6,1),cex.lab=1)
plot(id~beginning, data=dd,
xlim=c(1,12), ylim=c(0, max(dd$id)+2),# axis limits
pch=NA, # dont plot points yet
yaxt="n", xaxt="n",
xlab="Month", ylab="Case No.")
axis(side=2, at=dd$id, labels=dd$id, las=1)
axis(side=1,
at=seq(1,12, by=1),
labels=month.abb)
with(dd, arrows(y0=id, x0=beginning, y1=id, x1=end, length = 0))
with(dd, points(beginning, id, pch=25, bg="red", cex=1.5))
dd$my.pch <- ifelse(dd$solution=="recovered",24,4)
with(dd, points(end, id, pch= my.pch, bg="green", cex=1.5))
legend("topleft", legend=c("ill", "recovered", "death"),
pch=c(25,24,4),
pt.bg= c("red", "green", "black"),
bty="n"
)
Gives:
I have this line-and-dots plot:
#generate fake data
xLab <- seq(0, 50, by=5);
yLab <- c(0, sort(runif(10, 0, 1)));
#this value is fixed
fixedVal <- 27.3
#new window
dev.new();
#generate the plot
paste0(plot(xLab, yLab, col=rgb(50/255, 205/255, 50/255, 1), type="o", lwd=3,
main="a line-and-dots plot", xlab="some values", ylab="a percentage",
pch=20, xlim=c(0, 50), ylim=c(0, 1), xaxt="n", cex.lab=1.5, cex.axis=1.5,
cex.main=1.5, cex.sub=1.5));
#set axis
axis(side = 1, at=c(seq(min(xLab), max(xLab), by=5)))
#plot line
abline(v=fixedVal, col="firebrick", lwd=3, lty=1);
now, I would like to find the y coordinate of the intersection point between the green and the red lines.
Can I achieve the goal without the need of a regression line? Is there a simple way of getting the coordinates of that unknown point?
You can use approxfun to do the interpolation:
> approxfun(xLab,yLab)(fixedVal)
[1] 0.3924427
Alternatively, just use approx:
> approx(xLab,yLab,fixedVal)
$x
[1] 27.3
$y
[1] 0.3924427
Quick fix like #JohnColeman said:
# find the two points flanking your value
idx <- findInterval(fixedVal,xLab)
# calculate the deltas
y_delta <- diff(yLab[idx:(idx+1)])
x_delta <- diff(xLab[idx:(idx+1)])
# interpolate...
ycut = (y_delta/x_delta) * (fixedVal-xLab[idx]) + yLab[idx]
ycut
[1] 0.4046399
So we try it on the plot..
paste0(plot(xLab, yLab, col=rgb(50/255, 205/255, 50/255, 1), type="o", lwd=3,
main="a line-and-dots plot", xlab="some values", ylab="a percentage",
pch=20, xlim=c(0, 50), ylim=c(0, 1), xaxt="n", cex.lab=1.5, cex.axis=1.5,
cex.main=1.5, cex.sub=1.5));
#set axis
axis(side = 1, at=c(seq(min(xLab), max(xLab), by=5)))
#plot line
abline(v=fixedVal, col="firebrick", lwd=3, lty=1);
abline(h=ycut, col="lightblue", lwd=3, lty=1);
I have 3 sets of data that I am trying to plot on a single plot. The first data set x values range from ~ 1 to 1700 whereas the other two data sets x values are less than 20. Therefore I want to plot them on a log axis to show variations in all the data sets. However I do not want to transform the data as I want to be able to read the values off the graph. The x axis labels I would like are 1, 10, 100 and 1000 all equally spaced. Does anyone know how to do this? I can only find examples where the data is log as well as the axis. I have attached the code I am currently using below:
Thanks in advance for any help given.
Holly
Stats_nineteen<-read.csv('C:/Users/Holly/Documents/Software Manuals/R Stuff/Stats_nineteen.csv')
attach(Stats_nineteen)
x<-Max
x1<-Min
x2<-Max
y1<-Depth
y2<-Depth
par(bg="white")
par(xlog=TRUE)
plot(x2,y1, type="n", ylim=c(555,0), log="x", axes=FALSE, ann=FALSE)
box()
axis(3, at=c(1,10,100,1000), label=c(1,10,100,1000), pos=0, cex.axis=0.6)
axis(1, at=c(1,10,100,1000), label=c(1,10,100,1000), cex.axis=0.6)
axis(2, at=c(600,550,500,450,400,350,300,250,200,150,100,50,0), label=c
(600,"",500,"",400,"",300,"",200,"",100,"",0), cex.axis=0.6)
mtext("CLAST SIZE / mm", side=3, line=1, cex=0.6, las=0, col="black")
mtext("DEPTH / m", side=2, line=2, cex=0.6, las=0, col="black")
grid(nx = NULL, ny = NULL, col = "lightgray", lty = "solid",
lwd = par("lwd"), equilogs = TRUE)
par(new=TRUE)
lines(x1,y1, col="black", lty="solid", lwd=1)
lines(x2,y2, col="black", lty="solid", lwd=1)
polygon(c(x1,rev(x2)), c(y1,rev(y2)), col="grey", border="black")
par(new=TRUE)
plot(x=Average,y=Depth, type="o",
bg="red", cex=0.5, pch=21,
col="red", lty="solid",
axes=FALSE, xlim=c(0,1670), ylim=c(555,0),
ylab = "",xlab = "")
par(new=TRUE)
plot(x=Mode,y=Depth, type="o",
bg="blue", cex=0.5, pch=21,
col="blue", lty="solid",
axes=FALSE, xlim=c(0,1670), ylim=c(555,0),
ylab = "",xlab = "")
You can do this in ggplot using scale_x_log
so something like:
myplot <- ggplot( StatsNinetee,
aes (x = myResponse,
y = myPredictor,
groups = myGroupingVariable) ) +
geom_point() +
scale_x_log()
myplot
also, avoid attach() it can give odd behavior.