options(prompt = "> ", continue="  ", useFancyQuotes = FALSE)
options(width = 80)
options(digits = 5)




## ------------------------------------------------------------------------
library("VGAM")
library("VGAMdata")
 ps.options(pointsize = 12, family = "Times")
pdf.options(pointsize = 12, family = "Times")




## ------------------------------------------------------------------------
pvec <- seq(0.1, 0.8, by = 0.1)
eta <- 0:4
logitlink(pvec)
logitlink(eta, inverse = TRUE)  # Also known as the antilogit
logitlink("prob")
logitlink("prob", tag = TRUE, short = FALSE)
logitlink(pvec, deriv = 1)
logitlink(pvec, deriv = 1, inverse = TRUE)
logitlink(pvec, deriv = 2)
logitlink(pvec, deriv = 2, inverse = TRUE)


## ------------------------------------------------------------------------
theta2eta(pvec, "logitlink")
eta2theta(eta, "logitlink")
dtheta.deta(pvec, "logitlink")
d2theta.deta2(pvec, "logitlink")


## ------------------------------------------------------------------------
print(simple.exponential)




## ------------------------------------------------------------------------
appletree <- data.frame(y = 0:7, w = c(70, 38, 17, 10, 9, 3, 2, 1))
apple.nbfit <- vglm(cbind(y, y) ~ 1, negbinomial, data = appletree,
                    weights = w)
(keep <- unlist(apple.nbfit@family@infos()))





## ------------------------------------------------------------------------
args(betabinomialff)


## ------------------------------------------------------------------------
args(cratio)


## ------------------------------------------------------------------------
head(gpd, 10)


## ------------------------------------------------------------------------
print(better.exponential)


## ------------------------------------------------------------------------
args(acat()@loglikelihood)


## ------------------------------------------------------------------------
if (FALSE) {
    ncoly <- 5  # Suppose there are 5 responses
    lshape1 <- lshape2 <- "loglink"  # Defaults
    eshape1 <- eshape2 <- NULL  # No extra arguments
    M1 <- 2  # 2 parameters per response

    M <- M1 * ncoly
    mynames1 <- paste("shape1", if (ncoly > 1) 1:ncoly else "", sep = "")
    mynames2 <- paste("shape2", if (ncoly > 1) 1:ncoly else "", sep = "")
    predictors.names <-
        c(namesof(mynames1, lshape1 , earg = eshape1 , tag = FALSE),
          namesof(mynames2, lshape2 , earg = eshape2 , tag = FALSE))[
          interleave.VGAM(M, M = M1)]
    mynames1
    mynames2
    predictors.names
}


## ------------------------------------------------------------------------
iam(2, 3, M = 4)


## ------------------------------------------------------------------------
betaR()@weight


## ------------------------------------------------------------------------
iam(NA, NA, M = 4, both = TRUE, diag = TRUE)



## ------------------------------------------------------------------------
uninormal()@weight


## ------------------------------------------------------------------------
args(multinomial)
print(multinomial()@constraints)



## ------------------------------------------------------------------------
getClasses("package:VGAM")



## ------------------------------------------------------------------------
getClass("vglm")


## ------------------------------------------------------------------------
extends("rrvglm")  # "vlmsmall" is experimental & may soon be depreciated


## ------------------------------------------------------------------------
showMethods(classes = "vglm")



## ------------------------------------------------------------------------
if (FALSE) {
  Depvar.vlm <- function(object, ...) object@y

  if (!isGeneric("Depvar"))
    setGeneric("Depvar", function(object, ...) standardGeneric("Depvar"))

  setMethod("Depvar", "vlm", function(object, ...) Depvar.vlm(object, ...))
}


## ------------------------------------------------------------------------
print(kumar)


## ------------------------------------------------------------------------
options(width = 120)


## ------------------------------------------------------------------------
VGAM:::slash.control
slash()@deriv
slash()@weight






## ------------------------------------------------------------------------
options(width = 80)

## ------------------------------------------------------------------------
print(sm.min1)

## ------------------------------------------------------------------------
print(sm.scale1)

## ------------------------------------------------------------------------
"stdze" <- function(x, center = TRUE, scale = TRUE) {
  x <- x  # Evaluate x
  if (smart.mode.is("read")) {
    smart  <- get.smart()
    return((x - smart$Center) / smart$Scale)
  }
  if (is.logical(center))
    center <- if (center) mean(x) else 0
  if (is.logical(scale))
    scale <- if (scale) sqrt(var(x)) else 1
  if (smart.mode.is("write"))
    put.smart(list(Center = center, Scale = scale))
  (x - center) / scale
}




## ------------------------------------------------------------------------
"stdze2" <- function(x, center = TRUE, scale = TRUE) {
  x <- x  # Evaluate x
  if (smart.mode.is("read")) {
    return(eval(smart.expression))
  }
  if (is.logical(center))
    center <- if (center) mean(x) else 0
  if (is.logical(scale))
    scale <- if (scale) sqrt(var(x)) else 1
  if (smart.mode.is("write"))
    put.smart(list(center = center, scale = scale))
  (x - center) / scale
}


## ------------------------------------------------------------------------
print(sm.scale2)



## ------------------------------------------------------------------------
print(sm.min2)