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
Related
I have a line graph time series and I wanna make a filling color red for positive y values and blue for negative y values. How can i do it using polygon function because iam not using ggplot?
Thank you!
plot(ts.NAO$NAO_index, type="l",ann=FALSE, xaxt="n", yaxt="n",xlim=c(0,123))
par(new=TRUE)
plot(running_mean, type="l",
lty=2, lwd=2, col="red", ann=FALSE, xaxt="n", yaxt="n")
title(xlab="Years", ylab="NAO SLP Index")
abline(h=0, col="blue")
axis(side=1, at=seq(1,123,10), labels=seq(1900,2020,10), las=1) # customizing the x axis
axis(side=2, at=seq(-6,6,0.5), labels=seq(-6,6,0.5)) # customizing the y axis
polygon(c(ts.NAO$Year,rev(ts.NAO$Year),
c(ts.NAO$NAO_index,rev(ts.NAO$NAO_index),
col = "darkgreen",border=NA)))
Sample data,
set.seed(2022)
dat <- data.frame(x=1:100, y=cumsum(runif(100, -10, 10)))
head(dat)
# x y
# 1 1 8.296121
# 2 2 17.037629
# 3 3 12.760420
# 4 4 19.369372
# 5 5 22.204283
# 6 6 22.586202
First cut: we'll split the sequence into blocks of neg/pos, then plot each polygon. (data.table::rleid works well, if you must use something else we can contrive a naive version that does the same thing.
my_rleid <- function(z) {
r <- rle(z)
rep.int(seq_along(r$lengths), times = r$lengths)
} # or you can use data.table::rleid
spl <- split(dat, my_rleid(dat$y < 0))
lapply(spl[1:2], head)
# $`1`
# x y
# 1 1 6.319553
# 2 2 9.264740
# 3 3 1.671311
# 4 4 2.547314
# $`2`
# x y
# 5 5 -3.758086
# 6 6 -1.042269
# 7 7 -9.556289
# 8 8 -18.716770
# 9 9 -21.310428
# 10 10 -16.165370
miny <- min(dat$y)
plot(y ~ x, data = dat, type = "l")
abline(h = 0, lty = 2)
for (Z in spl) {
polygon(Z$x[c(1, 1:nrow(Z), nrow(Z))], c(miny, Z$y, miny),
col = if (Z$y[1] < 0) "red" else "blue")
}
As you can see, we need to extend each element of spl to extend to the next block (since the x values will show a gap). There are many options for this depending on your preferences: carry-forward (add a row to the bottom of each), push-backward (add a row to the top of each from the preceding block), or interpolate between the first row in one with the bottom row in the preceding. I think the first two are fairly simple, I'll opt for the more-difficult (but visually more consistent) one of interpolation.
for (ind in 2:length(spl)) {
x1 <- spl[[ind-1]]
x2 <- spl[[ind]]
newdat <- do.call(approx, c(setNames(rbind(x1[nrow(x1),], x2[1,]), c("y", "x")), list(xout = 0)))
names(newdat) <- c("y", "x")
newdat <- data.frame(newdat)[,2:1]
spl[[ind-1]] <- rbind(spl[[ind-1]], newdat)
spl[[ind]] <- rbind(newdat, spl[[ind]])
}
plot(y ~ x, data = dat, type = "l")
abline(h = 0, lty = 2)
for (Z in spl) {
polygon(Z$x[c(1, 1:nrow(Z), nrow(Z))], c(miny, Z$y, miny),
col = if (mean(Z$y) < 0) "red" else "blue")
}
(Note that the col= conditional changed, since we know that the first value should "always" be 0.)
Edit: I assumed making the polygon start at the bottom of the plot, as defined by miny <- min(dat$y). As a cue from AllanCameron's excellent answer, if you set miny <- 0 instead, you get this:
My guess is you are looking for something like this. Create two new series in your data frame - one that is 0 if the y value is negative, and another that is 0 if your y value is positive. Bookend both these series with 0 values. You can then use these two series as the outlines of your polygons:
Thanks ro r2evans for the dataset, which I have modified somewhat to make it more in keeping with the ranges of the OP's data.
set.seed(2022)
dat <- data.frame(x = 1:123, y = cumsum(runif(123, -1.5, 1.5)))
dat$y_up <- ifelse(dat$y > 0, dat$y, 0)
dat$y_dn <- ifelse(dat$y < 0, dat$y, 0)
plot(dat$x, dat$y, type = "l", ann = FALSE, xaxt = "n", yaxt = "n")
title(xlab = "Years", ylab = "NAO SLP Index")
abline(h = 0)
axis(side = 1, at = seq(1, 123, 10), labels = seq(1900, 2020, 10), las = 1)
axis(side = 2, at = seq(-6, 6, 0.5), labels = seq(-6, 6, 0.5))
polygon(c(dat$x[1], dat$x, tail(dat$x, 1)), c(0, dat$y_up, 0), col = "red")
polygon(c(dat$x[1], dat$x, tail(dat$x, 1)), c(0, dat$y_dn, 0), col = "blue")
Created on 2022-12-23 with reprex v2.0.2
Here's an alternative approach. Instead of dividing the time series into many polygons I decided to draw everything at once (well, twice actually) and limit the plotting region instead.
Generating data and initial plotting:
# random data
set.seed(1)
ts.NAO <- list(NAO_index=rnorm(123, sd=2))
running_mean <- stats::filter(ts.NAO$NAO_index, rep(1, 7)/7)
plot(ts.NAO$NAO_index, type='n', ann=F, xaxt='n', yaxt='n', xlim=c(0, 123))
title(xlab="Years", ylab="NAO SLP Index")
axis(side=1, at=seq(1,123,10), labels=seq(1900,2020,10), las=1) # customizing the x axis
axis(side=2, at=seq(-6,6,0.5), labels=seq(-6,6,0.5)) # customizing the y axis
# save for later use
par0 <- par(c('usr', 'mar'))
# vertical value of dividing point between red and blue
split.at <- 0
# normalized device coordinates of plotting region x and y limits and
# the split point
coords <- list(x=grconvertX(par0$usr[1:2], to='ndc'),
y=grconvertY(c(par0$usr[3:4], split.at), to='ndc'))
Here's a function that creates the lower or upper subfigure and draws the polygon. I didn't want to repeat some parts of code twice, hence the function (although it would be shorter without it).
sub_fig <- function(upper=T, color='red') {
if (upper) {
y.fig <- coords$y[3:2] # subfigure bottom and top
y.usr <- c(split.at, par0$usr[4]) # plot y limits
} else {
y.fig <- coords$y[c(1, 3)]
y.usr <- c(par0$usr[3], split.at)
}
par(fig=c(coords$x, y.fig), mar=rep(0, 4), new=T)
frame()
plot.window(par0$usr[1:2], y.usr, xaxs='i', yaxs='i')
polygon(c(1, seq_along(ts.NAO$NAO_index), length(ts.NAO$NAO_index)),
c(split.at, ts.NAO$NAO_index, split.at),
col=color)
}
# upper
sub_fig()
# lower
sub_fig(F, 'blue')
# restore initial plot coordinates
par(fig=c(0, 1, 0, 1), mar=par0$mar, new=T)
frame()
plot.window(par0$usr[1:2], par0$usr[3:4], xaxs='i', yaxs='i')
abline(h=0, col="blue")
lines(running_mean, col=gray(.7), lty=2, lwd=2)
An alternative approach using bars.
set.seed(2022)
dat <- data.frame(x = seq(1900, 2022, 1), y = cumsum(runif(123, -1.5, 1.5)))
dat$col <- ifelse(dat$y < 0, "blue3", "red3")
bp <- barplot(dat$y, border=F, col=dat$col, space=0, xlab="Year", ylab="Index")
lines(bp, dat$y, col="gray45")
lines(bp, rnorm(nrow(dat), 1.5, 0.3), lt=2, col="red2")
abline(h=0, col="blue")
axis(1, bp[c(T, rep(F, 9))], labels=dat$x[c(T,rep(F, 9))])
box()
plot(ts.NAO$Year, ts.NAO$NAO_index, type="l", xaxt="n", yaxt="n", xlim=c(1900,2020))
par(new=TRUE)
plot(ts.NAO$Year, running_mean, type="l", lty=2, lwd=2, col="red", xaxt="n", yaxt="n")
title(xlab="Years", ylab="NAO SLP Index")
abline(h=0, col="blue")
axis(side=1, at=seq(1900,2020,10), labels=seq(1900,2020,10), las=1)
axis(side=2, at=seq(-6,6,0.5), labels=seq(-6,6,0.5))
for (i in 1:length(ts.NAO$NAO_index)) {
if (ts.NAO$NAO_index[i] > 0) {
polygon(c(ts.NAO$Year[i], ts.NAO$Year[i+1], ts.NAO$Year[i+1], ts.NAO$Year[i]),
c(0, 0, ts.NAO$NAO_index[i], ts.NAO$NAO_index[i]),
col="red", border=NA)
} else {
polygon(c(ts.NAO$Year[i], ts.NAO$Year[i+1], ts.NAO$Year[i+1], ts.NAO$Year[i]),
c(0, 0, ts.NAO$NAO_index[i], ts.NAO$NAO_index[i]),
col="blue", border=NA)
}#you can choose to remove the polygon borders which is standard
#practice for presentation purposes where I work, certainly not
#the best way by any means
}
I am working in RStudio and trying to make a 3x3 grid of the triangle plots built with the functions below. I’ve included a reproducible example, and the error I am running into is that the margins are too large to plot multiple plot, even though I am reducing the width and height.
I’ve also tried saving these as png and loading them in to arrange with cowplot, but the figure is very blurry and I’m not sure how to adjust the text size or line thickness to make the figures more legible.
#Data
iris$nrm.Sepal <- iris$Sepal.Width / iris$Sepal.Length
iris$nrm.Petal <- iris$Petal.Width / iris$Petal.Length
df_list <- split(iris, (iris$Species))
top.triangle <- function() {
plot(my.y ~ my.x, data= my.data, axes=FALSE, ylab='', xlab="",
main='', xlim=c(0, 1), ylim=c(0, 1), xaxt="n", yaxt="n", asp=1)
mtext("Here could be your title", 3, 5, font=2, cex=1.3, adj=.95)
mtext("Position.2", 2, .75)
mtext("Position.1", 3, 2)
axis(side=2, las=1, pos=0)
axis(side=3, las=1, pos=1)
lines(0:1, 0:1)
}
bottom.triangle <- function() {
points(my.x ~ my.y, data=my.data.2, xpd=TRUE)
mtext("Position.2", 1, 1.5, at=mean(par()$usr[1:2]) + x.dist)
mtext("Position.1", 4, 3, padj=par()$usr[1] + 10)
x.at <- axisTicks(par()$usr[1:2], 0) + x.dist
axis(side=1, las=1, pos=0, at=x.at,
labels=F, xpd=TRUE)
mtext(seq(0, 1, .2), 1, 0, at=x.at)
axis(4, las=1, pos=1 + x.dist)
lines(0:1 + x.dist, 0:1, xpd=TRUE)
}
#loop for generating species specific plots
for(i in 1:(length(df_list))){
current.strain <- as.character(df_list[[i]]$Species[1])
#declare file for saving png
# png(paste0("~.test.triangle_", current.strain, ".png"), width=650, height=500)
plot.new()
my.data = iris
my.x.top = (iris %>% filter(Species == current.strain) )$nrm.Petal
my.y.top = (iris %>% filter(Species == current.strain) )$nrm.Sepal
my.x.bottom = (iris %>% filter(Species == current.strain) )$nrm.Petal
my.y.bottom = (iris %>% filter(Species == current.strain) )$nrm.Sepal
op <- par(mar=c(3, 2, 2, 2) + 0.1, oma=c(2, 0, 0, 2))
top.triangle(my.y.top, my.x.top, my.data)
bottom.triangle(my.y.bottom+x.dist, my.x.bottom, my.data)
par(op)
RP[[i]] <- recordPlot()
dev.off()
}
#for margins too large error
graphics.off()
par("mar")
par(mar=c(.1,.1,.1,.1))
#draw and arrange the plots
ggdraw() +
draw_plot(RP[[1]], x=0, y=0)
#Add remaining plots
#draw_plot(RP[[2]], x=.25, y=.25)
#draw_plot(RP[[3]], x=.25, y=.25)
(this is built off the answer I posted from this question, R base plot, combine mirrored right triangles )
To use plot solution at specified link, you need to adjust to the iris data including your calculated columns, nrm.Sepal and nrm.Petal inside both functions. Then, instead of split, consider by to pass subsets into both functions for plotting. However, the plot will only generate 1 X 3. It is unclear how 3 X 3 is generated. Your posted link above actually duplicates
Data
iris$nrm.Sepal <- iris$Sepal.Width / iris$Sepal.Length
iris$nrm.Petal <- iris$Petal.Width / iris$Petal.Length
Functions
top.triangle <- function(my.data) {
plot(nrm.Sepal ~ nrm.Petal, data= my.data, axes=FALSE, ylab="", xlab="",
main='', xlim=c(0, 1), ylim=c(0, 1), xaxt="n", yaxt="n", asp=1)
mtext(my.data$Species[[1]], 3, 5, font=2, cex=1.3, adj=.95)
mtext("Position.2", 2, .75)
mtext("Position.1", 3, 2)
axis(side=2, las=1, pos=0)
axis(side=3, las=1, pos=1)
lines(0:1, 0:1)
}
bottom.triangle <- function(my.data) {
x.dist <- .5
my.data.2 <- transform(my.data, nrm.Sepal=nrm.Sepal + x.dist)
points(nrm.Petal ~ nrm.Sepal, data=my.data.2, col="red", xpd=TRUE)
mtext("Position.2", 1, 1.5, at=mean(par()$usr[1:2]) + x.dist)
mtext("Position.1", 4, 3, padj=par()$usr[1] + 3)
x.at <- axisTicks(par()$usr[1:2], 0) + x.dist
axis(side=1, las=1, pos=0, at=x.at,
labels=FALSE, xpd=TRUE)
mtext(seq(0, 1, 0.2), 1, 0, at=x.at, cex=0.7)
axis(4, las=1, pos=1 + x.dist)
lines(0:1 + x.dist, 0:1, xpd=TRUE)
}
Plot
par(mar=c(1, 4, 8, 6), oma=c(2, 0, 0, 2), mfrow=c(2,3))
by(iris, iris$Species, function(sub){
top.triangle(sub)
bottom.triangle(sub)
})
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).
I am making a graph using these datas:
Upper_limit_graph_wt <- (((log(8)/50:5000)-log(d_wt))/log(g_wt))
Lower_limit_graph_wt <- (((log(1/8)/50:5000)-log(d_wt))/log(g_wt))
plot(Upper_limit_graph_wt, type="l", ylim=g_range, xlim=range(0:5000), ann=FALSE, col="pink")
par(new=TRUE)
plot(Lower_limit_graph_wt, type="l", ylim=g_range, xlim=range(0:5000), ann=FALSE, col="gold")
par(new=TRUE)
plot(Total_count, (Alt_count/Total_count), pch=16, ann=FALSE, ylim=g_range, xlim=range(0:5000), col="dark green")
I can't add an image but I basically get a graph with 2 curves and 1 dot.
The coordinates for my dot are x=Total_count and y=(Alt_count/Total_count)
However I don't seem to be able to add the function if else
When I do :
if((Total_count, (Alt_count/Total_count))> Upper_limit_graph)print"Fail"
It tells me "," was unexpected
How do I make it print something when my dot is above my curves?
Thanks
You should use text to add the text to your plot. Please see as follows:
d_wt <- 2
g_wt <- 3
Upper_limit_graph_wt <- (((log(8) / 50:5000) - log(d_wt)) / log(g_wt))
Lower_limit_graph_wt <- (((log(1/8)/50:5000) - log(d_wt)) / log(g_wt))
g_range <- seq_along(Upper_limit_graph_wt)
plot(c(Lower_limit_graph_wt, Upper_limit_graph_wt), xlim = range(g_range), type = "n")
lines(Lower_limit_graph_wt)
lines(Upper_limit_graph_wt)
Total_count <- 1000
Alt_count <- -600
points(Total_count, Alt_count/Total_count, cex = 2, col = "blue", pch = 19)
text(2000, -0.62,
ifelse((Alt_count / Total_count > Upper_limit_graph_wt[Total_count]), "Fail", ""),
col = "red")
Output:
Does anyone know how to create log probability plot like this one in R where the x-axis is probability and y-axis is in log-scale. I read and downloaded the package heR.Misc package but I don't know how to use it.
!
#create log probablity plot
#MPM 131201
#Make some dummy data
set.seed(21)
Dt<-as.data.frame(rlnorm(625, log(10), log(2.5)))
names(Dt)<-"Au_ppm"
#Create probablity scale lines and associated labels -
PrbGrd <- qnorm(c(0.001,0.01, 0.05, 0.10,0.20,0.30,0.40, 0.50, 0.60, 0.70,0.80,0.90,0.95,0.99,0.999))
PrbGrdL<-c("0.1","1","5","10","20","30","40","50","60","70","80","90","95","99","99.9")
#create some value grid lines then convert to logs
ValGrd<-c(seq(0.001,0.01,0.001),seq(0.01,0.1,0.01),seq(0.1,1,0.1),seq(1,10,1),seq(10,100,10))
ValGrd<-log10(ValGrd)
#load up lattice packages - latticeExtra for nice log scale
require(lattice)
require(latticeExtra)
#Use qqmath to make the plot (note lattice does not work for weighted data - shame about that)
qqmath(~ Au_ppm,
data= Dt,
distribution = function(p) qnorm(p),
main = "Normal probablity / log (base 10) plot",
pch=20,
cex=0.5,
xlab="Normal distribution scale (%)",
scales=list(y=list(log=10,alternating=1),x = list(at = PrbGrd, labels = PrbGrdL, cex = 0.8)),
yscale.components=yscale.components.log10ticks,
panel=function(x,...){
panel.abline(v=PrbGrd ,col="grey",lty=3)
panel.abline(h=ValGrd,col="grey",lty=3)
panel.qqmath(x,distribution=qnorm)
}
)
Here is an example using base R, simplified a bit from this post: (https://stat.ethz.ch/pipermail/r-help/2004-February/045370.html).
## Make some data
y <- rnorm(n=175, mean=100, sd=75)
y <- sort(y)
pct <- 1:length(y)/(length(y)+1)
## For x ticks
probs <- c(0.0001, 0.001, 0.01, 0.1, 0.3, 0.5, 0.7,
0.9, 0.99, 0.999, 0.9999)
x.vals <- qnorm(probs)
## Plotting area
xs <- c(-4, 4)
ys <- seq(-2,4)
par(xaxs="i", yaxs="i")
plot(NA, NA, xlim=c(xs[1], xs[2]), ylim=c(min(ys), max(ys)),
axes=FALSE, xlab=NA, ylab=NA)
## X Axis
axis(side=1, at=x.vals, labels=FALSE, tck=-0.01)
text(x=x.vals, y=rep(min(ys)-0.35, length(x.vals)),
labels=probs*100, xpd=TRUE, srt=325, font=2)
## Y Axis
axis(side=2, at=ys, labels=FALSE)
text(y=ys, x=rep(xs[1]-.08, length(ys)),
labels= as.character(10^ys), xpd = NA, font=2,
pos=2)
for (i in ys){
axis(side=2, at=log10(seq(2,9))+ i,
labels=NA, tck = -0.01)
}
## Grid lines and box
abline(h=ys, col="grey80", lty=2)
abline(v=qnorm(probs), col="grey80", lty=2)
box()
## Plot Data
lines(x=qnorm(pct), y=log10(y), col="blue")