## -----------------------------------------------------------------------------
#| label: model

mtcars2 <- mtcars
mtcars2$cyl <- factor(mtcars2$cyl)
mtcars2$gear <- factor(mtcars2$gear)
mtcars2$vs <- factor(mtcars2$vs, levels=0:1, labels=c("V", "S"))

fit <- glm(mpg ~ poly(wt, 2) + poly(disp,2) + cyl*gear + vs,
           data=mtcars2, family=gaussian(link="inverse"))
summary(fit)


## -----------------------------------------------------------------------------
#| label: nom1

library(R6Nomogram)

n1 <- R6Nomogram$new(fit)


## -----------------------------------------------------------------------------
#| label: nom2

n1$plot()


## -----------------------------------------------------------------------------
#| label: response

n1$plot.lp <- TRUE
n1$v.pos.r <- NULL
n1$lp.lab <- "G/M"
n1$resp.lab <- "M/G"
n1$plot()


## -----------------------------------------------------------------------------
#| label: interaction

dput(n1$x.pretty.vals$`cyl:gear`)
n1$x.pretty.vals$`cyl:gear` <-
   c("Other", "", "", "", "6:4", "", "6:5", "8:5")
n1$plot()


## -----------------------------------------------------------------------------
#| label: ticks1

n1$pretty.y(seq(60, 200, by=10))
n1$pretty('wt', c(1.5, 2, 3, 3.5, 4, 4.25, 4.5, 
                 4.75, 5, 5.25, 5.4))
n1$pretty('disp', c(75, 100, 125, 150, 175, 200, 250,
                   300, 400, 450))
n1$plot()


## -----------------------------------------------------------------------------
#| label: options

n1$options$text.par[['linear predictor']] <- list(cex=0.7)
n1$options$tik.len <- 0.4
n1$options$txt.pos <- 1.2
n1$options$signif.digits <- 3
n1$plot()


## -----------------------------------------------------------------------------
#| label: predict

oldpar <- par(oma=c(0,0,1,0))
n1$plot(predict = mtcars2[1,])
mtext(rownames(mtcars2)[1], line=1)

n1$plot(predict = mtcars2[20,])
mtext(rownames(mtcars2)[20], line=1)

n1$plot(predict = mtcars2[15,])
mtext(rownames(mtcars2)[15], line=1)

par(oldpar)


## -----------------------------------------------------------------------------
#| label: tables

n2 <- n1$clone()

n2$pretty.y(seq(60, 200, by=5))
n2$pretty('wt', seq(1.5, 5.4, by=0.1))
n2$pretty('disp', seq(75, 450, by=25))
n2$tables()


## -----------------------------------------------------------------------------
#| label: model2

contrasts(mtcars2$cyl) <- contr.sum(3)
contrasts(mtcars2$gear) <- contr.sum(3)

fit2 <- glm(mpg ~ poly(wt, 2) + poly(disp,2) + cyl*gear + vs,
           data=mtcars2, family=gaussian(link="inverse"))
n3 <- R6Nomogram$new(fit2)
n3$options$tik.len <- 0.4
n3$options$txt.pos <- 1.2
n3$options$signif.digits <- 3
n3$plot.lp <- TRUE
n3$lp.lab <- "G/M"
n3$resp.lab <- "M/G"
n3$options$text.par[['linear predictor']] <- list(cex=0.8)

n3$plot()


## -----------------------------------------------------------------------------
#| label: model3

mtcars2$`cyl:gear` <- interaction(mtcars2$cyl, mtcars2$gear,
                                 sep=':')
fit3 <- glm(mpg ~ poly(wt, 2) + poly(disp, 2) +
             `cyl:gear`,
           data=mtcars2, family=gaussian(link='inverse'))
n4 <- R6Nomogram$new(fit3, verbose=FALSE)
n4$options$tik.len <- 0.4
n4$options$txt.pos <- 1.2
n4$options$signif.digits <- 3
n4$plot.lp <- TRUE
n4$lp.lab <- "G/M"
n4$resp.lab <- "M/G"
n4$x.y.offsets$`cyl:gear` <- c(-1, 1, 2, -1, 1, -1, 1, -2)
n4$options$text.par[['linear predictor']] <- list(cex=0.8)
n4$options$text.par[['cyl:gear']] <- list(col=c(
  c("red", "forestgreen", "blue")[c(1,1,1,2,2,3,3,3)]
))

n4$plot()