# NOT RUN { polf("p", cutpoint = 2, short = FALSE) polf("p", cutpoint = 2, tag = TRUE) p <- seq(0.01, 0.99, by = 0.01) y <- polf(p, cutpoint = 2) y. <- polf(p, cutpoint = 2, deriv = 1) max(abs(polf(y, cutpoint = 2, inv = TRUE) - p)) # Should be 0 #\ dontrun{ par(mfrow = c(2, 1), las = 1) #plot(p, y, type = "l", col = "blue", main = "polf()") #abline(h = 0, v = 0.5, col = "orange", lty = "dashed") # #plot(p, y., type = "l", col = "blue", # main = "(Reciprocal of) first POLF derivative") #} # Rutherford and Geiger data ruge <- data.frame(yy = rep(0:14, times = c(57,203,383,525,532,408,273,139,45,27,10,4,0,1,1))) with(ruge, length(yy)) # 2608 1/8-minute intervals cutpoint <- 5 ruge <- transform(ruge, yy01 = ifelse(yy <= cutpoint, 0, 1)) fit <- vglm(yy01 ~ 1, binomialff(link = polf(cutpoint = cutpoint)), ruge) coef(fit, matrix = TRUE) exp(coef(fit)) # Another example pdata <- data.frame(x2 = sort(runif(nn <- 1000))) pdata <- transform(pdata, x3 = runif(nn)) pdata <- transform(pdata, mymu = exp( 3 + 1 * x2 - 2 * x3)) pdata <- transform(pdata, y1 = rpois(nn, lambda = mymu)) cutpoints <- c(-Inf, 10, 20, Inf) pdata <- transform(pdata, cuty = Cut(y1, breaks = cutpoints)) #\ dontrun{ with(pdata, plot(x2, x3, col = cuty, pch = as.character(cuty))) } with(pdata, table(cuty) / sum(table(cuty))) fit <- vglm(cuty ~ x2 + x3, data = pdata, trace = TRUE, cumulative(reverse = TRUE, parallel = TRUE, link = polf(cutpoint = cutpoints[2:3]), multiple.responses = TRUE)) head(depvar(fit)) head(fitted(fit)) head(predict(fit)) coef(fit) coef(fit, matrix = TRUE) constraints(fit) fit@misc$earg # }
Run the code above in your browser using DataCamp Workspace