inst/doc/doby.R

In doBy: Groupwise Statistics, LSmeans, Linear Estimates, Utilities

## ----echo=FALSE---------------------------------------------------------------
require( doBy )
prettyVersion <- packageDescription("doBy")$Version
prettyDate <- format(Sys.Date())

## ----include=FALSE------------------------------------------------------------
library(knitr)

## ----r setup, echo=FALSE----------------------------------------------------------------
knitr::opts_chunk$set(prompt=TRUE) 
library(doBy)
if (!dir.exists("figures")) dir.create("figures")
opts_chunk$set(
               tidy=FALSE,fig.path='figures/doBy'
           )

oopt <- options()
options("digits"=4, "width"=90, "prompt"="> ", "continue"="  ")
options(useFancyQuotes="UTF-8")

## ----echo=F-----------------------------------------------------------------------------
library(doBy)

## ---------------------------------------------------------------------------------------
head(mtcars)
tail(mtcars)

## ---------------------------------------------------------------------------------------
myfun1 <- function(x){
    c(m=mean(x), s=sd(x))
}
summaryBy(cbind(mpg, cyl, lh=log(hp)) ~ vs, 
          data=mtcars, FUN=myfun1)

## ---------------------------------------------------------------------------------------
summaryBy(mpg ~ vs, data=mtcars, FUN=mean)

## ---------------------------------------------------------------------------------------
summaryBy(list(c("mpg", "cyl"), "vs"), 
          data=mtcars, FUN=myfun1)

## ---------------------------------------------------------------------------------------
mtcars |> summary_by(cbind(mpg, cyl, lh=log(hp)) ~ vs,
                      FUN=myfun1)

## ---------------------------------------------------------------------------------------
x1 <- orderBy(~ gear + carb, data=mtcars)
head(x1, 4)
tail(x1, 4)

## ---------------------------------------------------------------------------------------
x2 <- orderBy(~ -gear + carb, data=mtcars)

## ---------------------------------------------------------------------------------------
x3 <- orderBy(c("gear", "carb"), data=mtcars)
x4 <- orderBy(c("-gear", "carb"), data=mtcars)
x5 <- mtcars |> order_by(c("gear", "carb"))
x6 <- mtcars |> order_by(~ -gear + carb)

## ---------------------------------------------------------------------------------------
x <- splitBy(~ Month, data=airquality)
x <- splitBy(~ vs, data=mtcars)
lapply(x, head, 4)
attributes(x)

## ---------------------------------------------------------------------------------------
splitBy("vs", data=mtcars)
mtcars |> split_by(~ vs)

## ---------------------------------------------------------------------------------------
x <- subsetBy(~am, subset=mpg > mean(mpg), data=mtcars)
head(x)

## ---------------------------------------------------------------------------------------
x <- subsetBy("am", subset=mpg > mean(mpg), data=mtcars)
x <- mtcars  |> subset_by("vs", subset=mpg > mean(mpg))
x <- mtcars  |> subset_by(~vs, subset=mpg > mean(mpg))

## ---------------------------------------------------------------------------------------
head(x)
x <- transformBy(~vs, data=mtcars, 
                 min.mpg=min(mpg), max.mpg=max(mpg))
head(x)

## ---------------------------------------------------------------------------------------
x <- transformBy("vs", data=mtcars, 
                 min.mpg=min(mpg), max.mpg=max(mpg))
x <- mtcars |> transform_by("vs",
                             min.mpg=min(mpg), max.mpg=max(mpg))

## ---------------------------------------------------------------------------------------
lapplyBy(~vs, data=mtcars,
         FUN=function(d) lm(mpg~cyl, data=d)  |> summary()  |> coef())

## ---------------------------------------------------------------------------------------
x <- c(1, 1, 1, 2, 2, 2, 1, 1, 1, 3)
firstobs(x)
lastobs(x)

## ---------------------------------------------------------------------------------------
firstobs(~vs, data=mtcars)
lastobs(~vs, data=mtcars)

## ---------------------------------------------------------------------------------------
x <- c(1:4, 0:5, 11, NA, NA)
which.maxn(x, 3)
which.minn(x, 5)

## ---------------------------------------------------------------------------------------
x <- c(1, 1, 2, 2, 2, 1, 1, 3, 3, 3, 3, 1, 1, 1)
subSeq(x)
subSeq(x, item=1)
subSeq(letters[x])
subSeq(letters[x], item="a")

## ---------------------------------------------------------------------------------------
x <- c("dec", "jan", "feb", "mar", "apr", "may")
src1 <- list(c("dec", "jan", "feb"), c("mar", "apr", "may"))
tgt1 <- list("winter", "spring")
recodeVar(x, src=src1, tgt=tgt1)

## ---------------------------------------------------------------------------------------
head(renameCol(mtcars, c("vs", "mpg"), c("vs_", "mpg_")))

## ---------------------------------------------------------------------------------------
yvar <- c(0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0)

## ---------------------------------------------------------------------------------------
tvar <- seq_along(yvar) + c(0.1, 0.2)

## ---------------------------------------------------------------------------------------
tse <- timeSinceEvent(yvar, tvar)
tse

## ----fig.height=4-----------------------------------------------------------------------
plot(sign.tse ~ tvar, data=tse, type="b")
grid()
rug(tse$tvar[tse$yvar == 1], col="blue",lwd=4)
points(scale(tse$run), col=tse$run, lwd=2)
lines(abs.tse + .2 ~ tvar, data=tse, type="b",col=3)

## ----fig.height=4-----------------------------------------------------------------------
plot(tae ~ tvar, data=tse, ylim=c(-6,6), type="b")
grid()
lines(tbe ~ tvar, data=tse, type="b", col="red")
rug(tse$tvar[tse$yvar==1], col="blue", lwd=4)
lines(run ~ tvar, data=tse, col="cyan", lwd=2)

## ----fig.height=4-----------------------------------------------------------------------
plot(ewin ~ tvar, data=tse, ylim=c(1, 4))
rug(tse$tvar[tse$yvar==1], col="blue", lwd=4)
grid()
lines(run ~ tvar, data=tse, col="red")

## ---------------------------------------------------------------------------------------
tse$tvar[tse$abs <= 1]

## ----fig.height=4-----------------------------------------------------------------------
lynx <- as.numeric(lynx)
tvar <- 1821:1934
plot(tvar, lynx, type="l")

## ---------------------------------------------------------------------------------------
yyy <- lynx > mean(lynx)
head(yyy)
sss <- subSeq(yyy, TRUE)
sss

## ----fig.height=4-----------------------------------------------------------------------
plot(tvar, lynx, type="l")
rug(tvar[sss$midpoint], col="blue", lwd=4)

## ---------------------------------------------------------------------------------------
yvar <- rep(0, length(lynx))
yvar[sss$midpoint] <- 1
str(yvar)

## ---------------------------------------------------------------------------------------
tse <- timeSinceEvent(yvar,tvar)
head(tse, 20)

## ---------------------------------------------------------------------------------------
len1 <- tapply(tse$ewin, tse$ewin, length)
len2 <- tapply(tse$run, tse$run, length)
c(median(len1), median(len2), mean(len1), mean(len2))

## ----fig.height=4-----------------------------------------------------------------------
tse$lynx <- lynx
tse2 <- na.omit(tse)
plot(lynx ~ tae, data=tse2)

## ----fig.height=4-----------------------------------------------------------------------
plot(tvar, lynx, type="l", lty=2)
mm <- lm(lynx ~ tae + I(tae^2) + I(tae^3), data=tse2)
lines(fitted(mm) ~ tvar, data=tse2, col="red")

## ----echo=F-------------------------------------------------------------------
options(oopt)