Nothing
## ---- include = FALSE---------------------------------------------------------
# see https://r-pkgs.org/vignettes.html
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.width=6.5,fig.height=4,fig.align='center'
)
## ----eval=FALSE---------------------------------------------------------------
# setwd(".../NADA2")
## ----warning=F,message=F,eval=F,results="hide"--------------------------------
# check.packages <- function(pkg){
# new.pkg <- pkg[!(pkg %in% installed.packages()[, "Package"])]
# if (length(new.pkg))
# install.packages(new.pkg, dependencies = TRUE)
# sapply(pkg, require, character.only = TRUE)
# }
#
# pkg <- c("bestglm","car","cenGAM","EnvStats","fitdistrplus","Kendall",
# "mgcv","multcomp","NADA","nlme","perm","rms","survminer",
# "vegan","NADA2","bestglm")
# check.packages(pkg)
## ----setup,warning=F,message=F,results="hide"---------------------------------
# Load Package
library(cenGAM)
library(EnvStats)
library(fitdistrplus)
library(Kendall)
library(mgcv)
library(multcomp)
library(NADA)
library(perm)
library(rms)
library(survminer)
library(vegan)
library(NADA2)
library(bestglm)
library(car)
library(nlme)
library(rms)
## ----load data example--------------------------------------------------------
data(Golden); # From NADA package
head(Golden,5L)
## ----eval=F-------------------------------------------------------------------
# dat<-load(".../path/to/data/data.rda")
## ----eval=F-------------------------------------------------------------------
# library(readxl)
# dat <- read_excel(".../path/to/data/data.xlsx",sheet=4)
#
# # or
#
# library(openxlsx)
# dat <- read.xlsx(".../path/to/data/data.xlsx",sheet=4)
#
## ----eval=F-------------------------------------------------------------------
# dat <- read.csv(".../path/to/data/data.csv")
## ----eval=F-------------------------------------------------------------------
# dat <- read.table(".../path/to/data/data.txt")
## ----bxplot1,fig.width=6.5,fig.height=4,fig.align='center'--------------------
data(CuZn); # Data from the NADA package
cboxplot(CuZn$Zn,CuZn$ZnCen,CuZn$Zone,minmax = TRUE,Xlab="Zone",Ylab="Zn")
## ----bxplot2,fig.width=6.5,fig.height=4,fig.align='center'--------------------
cboxplot(CuZn$Zn,CuZn$ZnCen,CuZn$Zone,LOG=TRUE,Xlab="Zone",Ylab="Zn")
## ----bxplot3,fig.width=6.5,fig.height=4,fig.align='center'--------------------
cboxplot(CuZn$Zn,CuZn$ZnCen,CuZn$Zone,LOG=TRUE,show = TRUE, minmax = TRUE,
Xlab="Zone",Ylab="Zn")
## ----scatplot1,fig.width=6.5,fig.height=4,fig.align='center'------------------
data(TCEReg); # Data from the NADA package
cenxyplot(TCEReg$PopDensity, 1-TCEReg$PopAbv1, TCEReg$TCEConc, TCEReg$TCECen)
## ----scatplot2,fig.width=6.5,fig.height=4,fig.align='center'------------------
cenxyplot(TCEReg$PopDensity, 1-TCEReg$PopAbv1, TCEReg$TCEConc, TCEReg$TCECen,
xlab="Population Denisty",ylab="TCE Concentration, in ug/L")
## ----scatplot3,fig.width=6.5,fig.height=4,fig.align='center'------------------
cenxyplot(TCEReg$PopDensity, 1-TCEReg$PopAbv1, TCEReg$TCEConc, TCEReg$TCECen,
xlab="Population Denisty",ylab="TCE Concentration, in ug/L",
main = "Your Title Here", log ="y")
## ----cdf1,fig.width=6.5,fig.height=4,fig.align='center'-----------------------
# Data already loaded
cen_ecdf(CuZn$Zn, CuZn$ZnCen)
## ----cdf2,fig.width=6.5,fig.height=4,fig.align='center'-----------------------
cen_ecdf(CuZn$Zn, CuZn$ZnCen,CuZn$Zone,
Ylab="Zinc Concentration, in ug/L")
## ----cdf comp1,fig.width=6.5,fig.height=4,fig.align='center'------------------
data(ShePyrene); # From the NADA package
cenCompareCdfs(ShePyrene$Pyrene,ShePyrene$PyreneCen)
## ----cdf comp2,fig.width=6.5,fig.height=4,fig.align='center'------------------
cenCompareCdfs(ShePyrene$Pyrene,ShePyrene$PyreneCen,dist3 = "weibull")
## ----QQ1,fig.width=6.5,fig.height=4,fig.align='center'------------------------
cenQQ(ShePyrene$Pyrene,ShePyrene$PyreneCen)
## ----QQ2,fig.width=7,fig.height=6,fig.align='center'--------------------------
cenCompareQQ(ShePyrene$Pyrene,ShePyrene$PyreneCen,Yname="Pyrene",cex=0.75)
## ----sum----------------------------------------------------------------------
censummary(ShePyrene$Pyrene,ShePyrene$PyreneCen)
## -----------------------------------------------------------------------------
Pyr.mle.nada <- with(ShePyrene,
cenmle(Pyrene,PyreneCen))
Pyr.mle.nada
## -----------------------------------------------------------------------------
Pyr.mle <- with(ShePyrene,
elnormAltCensored(Pyrene, PyreneCen,
ci=TRUE, ci.method ="bootstrap",
n.bootstraps = 5000))
print(Pyr.mle)
## -----------------------------------------------------------------------------
Pyr.km.nada <- with(ShePyrene,
cenfit(Pyrene, PyreneCen))
Pyr.km.nada
## -----------------------------------------------------------------------------
Pyr.km <- with(ShePyrene,
enparCensored(Pyrene, PyreneCen,
ci=TRUE, ci.method ="bootstrap",
n.bootstraps = 5000))
print(Pyr.km)
## ---- fig.width=6.5,fig.height=4,fig.align='center',fig.cap="Lognormal probability of pyrene data"----
Pyr.ROS.nada <- with(ShePyrene,
cenros(Pyrene, PyreneCen))
mean(Pyr.ROS.nada)
sd(Pyr.ROS.nada)
quantile(Pyr.ROS.nada)
plot(Pyr.ROS.nada)
## -----------------------------------------------------------------------------
Pyr.ROS <- with(ShePyrene,
elnormAltCensored(Pyrene, PyreneCen, method="rROS",
ci=TRUE, ci.method ="bootstrap",
n.bootstraps = 5000))
print(Pyr.ROS)
## -----------------------------------------------------------------------------
with(ShePyrene,censtats(Pyrene, PyreneCen))
## -----------------------------------------------------------------------------
## from above
print(Pyr.km)
## -----------------------------------------------------------------------------
Pyr.km2 <- with(ShePyrene,enparCensored(Pyrene,PyreneCen, ci=TRUE))
print(Pyr.km2)
## -----------------------------------------------------------------------------
pymle <- with(ShePyrene,cenmle(Pyrene, PyreneCen,conf.int=0.95))
mean(pymle)
## -----------------------------------------------------------------------------
pymlenorm <- with(ShePyrene,cenmle(Pyrene, PyreneCen, dist="gaussian"))
mean(pymlenorm)
## -----------------------------------------------------------------------------
pyr.lnorm <- with(ShePyrene,
elnormAltCensored(Pyrene, PyreneCen,
ci=TRUE, ci.method ="bootstrap",
n.bootstraps = 5000))
print(pyr.lnorm)
## -----------------------------------------------------------------------------
# from above
print(Pyr.ROS)
## -----------------------------------------------------------------------------
with(ShePyrene,cenPredInt(Pyrene, PyreneCen))
## -----------------------------------------------------------------------------
with(ShePyrene,cenPredInt(Pyrene, PyreneCen,newobs =2, method = "rROS"))
## ---- fig.width=6.5,fig.height=4,fig.align='center'---------------------------
with(ShePyrene,cenTolInt(Pyrene, PyreneCen, cover=0.9))
## -----------------------------------------------------------------------------
example <- with(ShePyrene,
eqlnormCensored (Pyrene, PyreneCen, p=0.9,
ci=TRUE, ci.type ="upper"))
print(example)
## -----------------------------------------------------------------------------
dat.gamma <- ShePyrene$Pyrene^(1/3)
obj.gamma <- eqnormCensored(dat.gamma, ShePyrene$PyreneCen, p=0.9,
ci=TRUE, ci.type ="upper")
pct.gamma <- obj.gamma$quantiles^3 # the 90th percentile in orig units
pct.gamma
ti.gamma <- (obj.gamma$interval$limits[2])^3 # the upper tol limit in orig units
ti.gamma
## ---- fig.width=6.5,fig.height=5,fig.align='center'---------------------------
data(Example1) # From NADA2 package
head(Example1,5L)
with(Example1,cen_paired(Arsenic, NDisTRUE, 10, alt = "greater"))
## ---- fig.width=6.5,fig.height=5,fig.align='center'---------------------------
data(Atra); # From NADA package
head(Atra,5L)
with(Atra,cen_paired(June, JuneCen, Sept, SeptCen))
## -----------------------------------------------------------------------------
# test for the median difference = 0 using the sign test.
with(Atra,cen_signtest(June, JuneCen, Sept, SeptCen))
## -----------------------------------------------------------------------------
# test for a difference in the cdfs of the two months using the signed-rank
with(Atra,cen_signedranktest(June, JuneCen, Sept, SeptCen))
## ----fig.width=6.5,fig.height=4,fig.align='center'----------------------------
with(Example1,
cboxplot(Arsenic, NDisTRUE, Ylab="Arsenic Conc", show = TRUE))
## ----fig.width=6.5,fig.height=4,fig.align='center'----------------------------
with(Example1,
cenCompareCdfs (Arsenic, NDisTRUE, Yname = "Arsenic concentration in ug/L"))
## -----------------------------------------------------------------------------
egam <- with(Example1,
egammaAltCensored(Arsenic, NDisTRUE,
ci=TRUE, ci.type = "upper",
ci.method = "normal.approx"))
print(egam)
## -----------------------------------------------------------------------------
arsenic.out <- with(Example1,
enparCensored(Arsenic, NDisTRUE,
ci=TRUE, ci.method="bootstrap", ci.type="upper",
n.bootstraps=5000))
print(arsenic.out)
## -----------------------------------------------------------------------------
data(Example2)
## -----------------------------------------------------------------------------
mibk.ucl95 <- with(Example2,
elnormAltCensored (MIBK, MIBKcen, method = "rROS",
ci=TRUE, ci.method = "bootstrap",
ci.type = "upper", n.bootstraps = 5000))
print(mibk.ucl95)
## -----------------------------------------------------------------------------
mibk2.out <- with(Example2,
elnormAltCensored (MIBK2, MIBK2cen, method = "rROS",
ci=TRUE, ci.method = "bootstrap",
ci.type = "upper", n.bootstraps = 5000))
print(mibk2.out)
## -----------------------------------------------------------------------------
data(Example3)
## -----------------------------------------------------------------------------
binom.test(0,14,alternative="less")
## ----fig.width=6.5,fig.height=4,fig.align='center'----------------------------
with(CuZn,cen2means(Zn,ZnCen,Zone,LOG=FALSE))
## ----fig.width=6.5,fig.height=4,fig.align='center'----------------------------
with(CuZn,cenperm2(Zn,ZnCen,Zone))
## ----fig.width=6.5,fig.height=4,fig.align='center'----------------------------
with(CuZn,cen2means(Zn,ZnCen,Zone))
## ----fig.width=6.5,fig.height=4,fig.align='center'----------------------------
with(CuZn,cen1way(Zn,ZnCen,Zone))
## ----fig.width=6.5,fig.height=4,fig.align='center'----------------------------
with(CuZn,cen_ecdf (Zn,ZnCen,Zone,
Ylab="Zinc Concentration, in ug/L"))
## ----fig.width=6.5,fig.height=4,fig.align='center'----------------------------
with(CuZn,cboxplot(Zn,ZnCen,Zone,
Ylab="Zinc Concentration, in ug/L"))
## -----------------------------------------------------------------------------
data(TCE2)
with(TCE2,ftable(Density~Below5Cens))
tab=with(TCE2,xtabs(~Below5Cens+Density))
chisq.test(tab)
## -----------------------------------------------------------------------------
TCE2$Below5[TCE2$Below5Cens== 1] <- -1 # all <5s are now a -1
wilcox.test(Below5~Density,TCE2)
## -----------------------------------------------------------------------------
t.test(Half.DL~Density,TCE2)
## ----fig.width=6.5,fig.height=4,fig.align='center'----------------------------
data(Golden)
with(Golden,cboxplot(Liver, LiverCen, Dosage,
Ylab = "Lead concentrations in liver, in ppb"))
## -----------------------------------------------------------------------------
Golden$Below04 <- Golden$Liver
Golden$Below04[Golden$Liver<0.04] <- -1
Golden$Below04[Golden$LiverCen==TRUE] <- -1
## -----------------------------------------------------------------------------
kruskal.test(Below04~Dosage,Golden)
## -----------------------------------------------------------------------------
with(Golden,cen1way(Liver,LiverCen,Dosage))
## ----fig.width=6.5,fig.height=4,fig.align='center'----------------------------
with(Golden,cen_ecdf(Liver,LiverCen,Dosage))
## ----fig.width=6.5,fig.height=4,fig.align='center'----------------------------
Golden$lnLiver=log(Golden$Liver)
with(Golden,cen_ecdf(lnLiver,LiverCen,Dosage,
xlim = c(min(lnLiver), max(lnLiver)),
Ylab = "Natural Logs of Lead Concentrations in Liver"))
## -----------------------------------------------------------------------------
with(Golden,cenanova(Liver,LiverCen,Dosage))
## -----------------------------------------------------------------------------
with(Golden,cenpermanova(Liver,LiverCen,Dosage))
## -----------------------------------------------------------------------------
with(Golden,cenanova(Liver,LiverCen,Dosage,LOG=FALSE))
## -----------------------------------------------------------------------------
# Load data
data(Gales_Creek)
Gales_Creek <- as.data.frame(Gales_Creek)
# set Year to factor by making a new variable.
Gales_Creek$Yr.f <- as.factor(Gales_Creek$Yr)
with(Gales_Creek,cen2way(TCr, CrND, Yr.f, Season))
## -----------------------------------------------------------------------------
data(Recon)
## -----------------------------------------------------------------------------
vif(lm(AtraConc ~ Area + Applic + PctCorn + SoilGp + Temp + Precip + Dyplant + Pctl,Recon))
## -----------------------------------------------------------------------------
recon.8 <- with(Recon,data.frame(Area, Applic, PctCorn, SoilGp, Temp, Precip, Dyplant, Pctl))
reg.recon.8 <- with(Recon,cencorreg(AtraConc, AtraCen, recon.8))
summary(reg.recon.8)
## ----fig.height=10------------------------------------------------------------
layout(matrix(1:8,4,2))
with(Recon,partplots(AtraConc, AtraCen, recon.8,multiplot = F))
## -----------------------------------------------------------------------------
Recon$cbrtPctCorn <- recon.8$PctCorn^(1/3)
recon.8onecube <- cbind(recon.8[, -3], Recon$cbrtPctCorn)
reg.recon.8onecube = with(Recon,cencorreg(AtraConc, AtraCen, recon.8onecube))
## ----fig.height=10------------------------------------------------------------
layout(matrix(1:8,4,2))
with(Recon,partplots(AtraConc, AtraCen, recon.8onecube,multiplot = F))
## -----------------------------------------------------------------------------
summary(reg.recon.8onecube)
## -----------------------------------------------------------------------------
# an alternative way to make a data.frame without using data.frame(...)
recon.7 <- Recon[,c("Area", "Applic", "cbrtPctCorn", "Temp", "Precip", "Dyplant", "Pctl")]
reg.recon.7 <- with(Recon,cencorreg(AtraConc, AtraCen, recon.7))
## -----------------------------------------------------------------------------
recon.6 <- Recon[,c("Area", "Applic", "cbrtPctCorn", "Temp","Dyplant", "Pctl")]
reg.recon.6 <- with(Recon,cencorreg(AtraConc, AtraCen, recon.6))
summary(reg.recon.6)
## -----------------------------------------------------------------------------
recon.5 <- Recon[,c("Applic", "cbrtPctCorn", "Temp","Dyplant", "Pctl")]
reg.recon.5 <- with(Recon,cencorreg(AtraConc, AtraCen, recon.5))
summary(reg.recon.5)
## -----------------------------------------------------------------------------
recon.4 <- Recon[,c( "cbrtPctCorn", "Temp","Dyplant", "Pctl")]
reg.recon.4 <- with(Recon,cencorreg(AtraConc, AtraCen, recon.4))
summary(reg.recon.4)
## -----------------------------------------------------------------------------
with(Recon,bestaic(AtraConc, AtraCen, recon.8onecube))
## -----------------------------------------------------------------------------
reg.recon.cbrtPctCorn <- with(Recon,cencorreg(AtraConc, AtraCen, cbrtPctCorn))
## -----------------------------------------------------------------------------
reg.recon.Temp <- with(Recon,cencorreg(AtraConc, AtraCen, Temp))
## -----------------------------------------------------------------------------
reg.recon.Dyplant <- with(Recon,cencorreg(AtraConc, AtraCen, Dyplant ))
## -----------------------------------------------------------------------------
reg.recon.Pctl <- with(Recon,cencorreg(AtraConc, AtraCen, Pctl))
## -----------------------------------------------------------------------------
summary(reg.recon.Dyplant)
## -----------------------------------------------------------------------------
with(Recon,cencorreg(AtraConc, AtraCen, Dyplant,pred.plot=TRUE))
## -----------------------------------------------------------------------------
recon.5.alt <- Recon[,c("Dyplant","Applic", "cbrtPctCorn", "Temp", "Pctl")]
plot.reg.recon.5 <- with(Recon,cencorreg(AtraConc, AtraCen, recon.5.alt,pred.plot = TRUE))
## -----------------------------------------------------------------------------
with(Recon,ATS(AtraConc, AtraCen, Dyplant))
## -----------------------------------------------------------------------------
with(Recon,ATS(AtraConc, AtraCen, Dyplant,retrans=TRUE))
## -----------------------------------------------------------------------------
with(Recon,ATS(AtraConc,AtraCen, Pctl,retrans=TRUE))
## -----------------------------------------------------------------------------
data(Gales_Creek)
## -----------------------------------------------------------------------------
with(Gales_Creek,ATS(TCr,CrND,dectime,LOG=FALSE))
## -----------------------------------------------------------------------------
with(Gales_Creek,centrend(TCr,CrND,discharge,dectime))
## -----------------------------------------------------------------------------
with(Gales_Creek,censeaken(dectime,TCr,CrND,Season,seaplots=TRUE))
## -----------------------------------------------------------------------------
with(Gales_Creek,centrendsea(TCr,CrND,discharge,dectime,Season))
## -----------------------------------------------------------------------------
with(Gales_Creek,cencorreg(TCr,CrND,dectime))
## -----------------------------------------------------------------------------
timeflow <- with(Gales_Creek,data.frame(dectime, discharge))
with(Gales_Creek,cencorreg(TCr,CrND,timeflow))
## -----------------------------------------------------------------------------
sinT <- with(Gales_Creek, sin(2*pi*dectime))
cosT <- with(Gales_Creek, cos(2*pi*dectime))
timeflowseas <- with(Gales_Creek,data.frame(dectime, discharge))
timeflowseas <- cbind(timeflowseas,sinT,cosT)
with(Gales_Creek, cencorreg(TCr, CrND, timeflowseas))
## -----------------------------------------------------------------------------
data(ReconLogistic)
head(ReconLogistic,3)
## -----------------------------------------------------------------------------
glm.1 <- glm(GT_1~
APPLIC+
CORNpct+
SOILGP+
PRECIP+
DYPLANT+
FPCTL,
ReconLogistic,family=binomial(logit))
vif(glm.1)
## -----------------------------------------------------------------------------
summary(glm.1)
## -----------------------------------------------------------------------------
glm.null <- glm(GT_1~1,ReconLogistic,family=binomial(logit))
anova(glm.null,glm.1,test="Chisq")
## -----------------------------------------------------------------------------
residualPlots(glm.1,type="deviance")
## -----------------------------------------------------------------------------
glm.3 <- glm(GT_1~
CORNpct+
SOILGP+
PRECIP+
DYPLANT+
FPCTL,
ReconLogistic,family=binomial(logit))
summary(glm.3)
## -----------------------------------------------------------------------------
glm.4 <- glm(GT_1~
CORNpct+
PRECIP+
DYPLANT+
FPCTL,
ReconLogistic,family=binomial(logit))
summary(glm.4)
## ----warning=FALSE------------------------------------------------------------
bestglm(ReconLogistic,family = binomial(logit), IC = "AIC")
## -----------------------------------------------------------------------------
anova(glm.4, glm.1, test="Chisq")
## -----------------------------------------------------------------------------
Recon.frame = with(ReconLogistic, datadist(CORNpct, DYPLANT, FPCTL, TEMP, GT_1))
options(datadist = "Recon.frame")
lrm4 <- lrm(GT_1 ~ CORNpct + DYPLANT + FPCTL + TEMP, data = ReconLogistic)
lrm4
## ----message = FALSE,results="hide"-------------------------------------------
data(Markers)
head(Markers,3)
Mdat <- Markers[, -15] # remove the Site Name column
M.usc <- uscoresi(Mdat) # uscoresi drops rows with NAs (row 13 here)
M.euclid <- dist(M.usc)
Site <- Markers$Site_Name[-13] # delete the site entry for row 13 with NAs
M.anosim <- anosim(M.euclid, Site)
M.anosim
anosimPlot(M.anosim)
## ----message = FALSE,results="hide"-------------------------------------------
uMDS(M.usc, group = Site,
legend.pos = "topright",
title = "NMDS of rank(uscores) for markers + entero")
## ----message = FALSE,results="hide"-------------------------------------------
M.nmds <- metaMDS(M.euclid)
Site <- as.factor(Site)
gp.color <- as.integer(Site)
Mplot <- ordiplot(M.nmds, type="none", display = "sites",
main="NMDS of rank(uscores) for markers + entero")
points(Mplot, "sites", pch=19, col=gp.color)
text(Mplot, "sites", pos=4, cex = 0.8)
leg.col <- c(1: length(levels(Site)))
legend("topright", legend=levels(Site), bty="n", col = leg.col, text.col = leg.col, pch = 19)
## -----------------------------------------------------------------------------
Mdata <- Markers[-13,] # delete row with NAs
M6 <- Mdata[, -(13:15)] # only keep columns for the 6 markers
M6.usc <- uscoresi(M6)
M6.euclid <- dist(M6.usc) # matrix for the 6 MST markers
ent <- Mdata[, 13:14] # the entero1A data
ent.usc<-uscoresi(ent)
ent.euclid<-dist(ent.usc) # matrix for the entero1A data
M6.Ktau <- mantel(ent.euclid, M6.euclid, method="kendall", permutations = 9999)
M6.Ktau
## -----------------------------------------------------------------------------
Site <- as.factor(Markers$Site_Name)
gp.color <- as.numeric(Site) # assigns numbers to group names in Site_Name
plot(ent.euclid, M6.euclid, pch = 19,
col = gp.color,
main = "Correlation of distance matrix of rank(uscores)")
lws <- lowess(ent.euclid, M6.euclid)
lines(lws)
legend("bottomright", legend=levels(Site), bty="n", col = 1:nlevels(Site), pch = 19)
## -----------------------------------------------------------------------------
bioenv(ent.euclid, M6.usc, method = "kendall")
## -----------------------------------------------------------------------------
plot(ent.usc, M6.usc[,4], pch = 19)
## -----------------------------------------------------------------------------
plot(ent.usc, M6.usc[,5], ylab = "HPyv rank of uscores")
## ----eval=F-------------------------------------------------------------------
# enormCensored(Data, Cen,ci=TRUE, ci.type="upper", ci.method="normal.approx")
# elnormAltCensored(Data, Cen, ci=TRUE, ci.type="upper", ci.method="bootstrap")
# egammaAltCensored(Data, Cen, ci=TRUE, ci.type="upper", ci.method="bootstrap")
## ----eval=F-------------------------------------------------------------------
# enparCensored(Data, Cen, ci=TRUE, ci.method="bootstrap", ci.type="upper", n.bootstraps=5000)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.