data(gaschrom)
ref <- gaschrom[1,]
samp <- gaschrom[16,]
gaschrom.ptw <- ptw(ref, samp)
summary(gaschrom.ptw)
## same with sticks (peak lists)
refst <- gaschrom.st[1]
sampst <- gaschrom.st[16]
gaschrom.st.ptw <- stptw(refst, sampst, trwdth = 100)
summary(gaschrom.st.ptw)
## Not run:
# ## comparison between backward and forward warping
# gaschrom.ptw <- ptw(ref, samp, init.coef = c(0, 1, 0, 0), mode = "backward")
# summary(gaschrom.ptw)
# gaschrom.ptw <- ptw(ref, samp, init.coef = c(-10, 1, 0, 0), mode = "forward")
# summary(gaschrom.ptw)
#
# ## #############################
# ## many samples warped on one reference
# ref <- gaschrom[1,]
# samp <- gaschrom[2:16,]
# gaschrom.ptw <- ptw(ref, samp, warp.type = "individual", verbose = TRUE,
# optim.crit = "RMS", init.coef = c(0, 1, 0, 0))
# summary(gaschrom.ptw)
#
# ## "individual" warping not implemented for sticks; do separate warpings
# ## instead
# refst <- gaschrom.st[1]
# sampst <- gaschrom.st[2:16]
# gaschrom.st.ptw.list <- lapply(sampst,
# function(smpl)
# stptw(refst, list(smpl), trwdth = 100))
# t(sapply(gaschrom.st.ptw.list, coef))
#
# ## #############################
# ## several samples on several references individually
# ref <- gaschrom[1:8,]
# samp <- gaschrom[9:16,]
# gaschrom.ptw <- ptw(ref, samp, warp.type = "individual",
# optim.crit = "RMS", init.coef = c(0, 1, 0, 0))
# summary(gaschrom.ptw)
#
# ## stick version
# gaschrom.st.ptw.list <-
# mapply(function(x, y)
# stptw(list(x), list(y), trwdth = 100),
# gaschrom.st[1:8], gaschrom.st[9:16],
# SIMPLIFY = FALSE)
# t(sapply(gaschrom.st.ptw.list, coef))
#
# gaschrom.ptw <- ptw(ref, samp, warp.type = "global",
# optim.crit = "WCC", init.coef = c(0, 1, 0))
# summary(gaschrom.ptw)
#
# ## #############################
# ## several samples on several references: one, global warping
# refst <- gaschrom.st[1:8]
# sampst <- gaschrom.st[9:16]
# gaschrom.st.ptw <- stptw(refst, sampst, trwdth=100, init.coef = c(0, 1, 0))
# summary(gaschrom.st.ptw)
# ## End(Not run)
## #############################
## Example of a three-way data set
# first bring all samples to the same scale
data(lcms)
## Not run:
# lcms.scaled <- aperm(apply(lcms, c(1,3),
# function(x) x/mean(x) ), c(2,1,3))
# # add zeros to the start and end of the chromatograms
# lcms.s.z <- aperm(apply(lcms.scaled, c(1,3),
# function(x) padzeros(x, 250) ), c(2,1,3))
#
#
# # define a global 2nd degree warping
# warp1 <- ptw(lcms.s.z[,,2], lcms.s.z[,,3], warp.type="global")
# warp.samp <- warp1$warped.sample
# warp.samp[is.na(warp.samp)] <- 0
# # refine by adding 5th degree warpings for individual chromatograms
# warp2 <- ptw(lcms.s.z[,,2], warp.samp, init.coef=c(0,1,0,0,0,0))
# warp.samp2 <- warp2$warped.sample
# warp.samp2[is.na(warp.samp2)] <- 0
# # compare TICs
# layout(matrix(1:2,2,1, byrow=TRUE))
# plot(colSums(lcms.s.z[,,2]), type="l", ylab = "",
# main = "TIC: original data")
# lines(colSums(lcms.s.z[,,3]), col=2, lty=2)
# plot(colSums(lcms.s.z[,,2]), type="l", ylab = "",
# main = "TIC: warped data")
# lines(colSums(warp.samp2), lty=2, col=2)
# ## End(Not run)
## ###########################
## stick version of this warping - note that the peaks have been picked
## from the scaled profiles. Note that here we need to take list
## elements: every sample is a list of mz channels.
warp1.st <- stptw(lcms.pks[[2]], lcms.pks[[3]], trwdth = 100)
summary(warp1.st)
Run the code above in your browser using DataLab