-
Notifications
You must be signed in to change notification settings - Fork 5
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
25 changed files
with
3,487 additions
and
3,481 deletions.
There are no files selected for viewing
Large diffs are not rendered by default.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,50 +1,50 @@ | ||
| #' Create an Adjacency Matrix for a set of Rankings | ||
| #' | ||
| #' Convert a set of rankings to an adjacency matrix summarising wins | ||
| #' and losses between pairs of items. | ||
| #' | ||
| #' For a \code{"rankings"} object based on N items, the adjacency matrix is an | ||
| #' N by N matrix, with element (i, j) being the number of times item i wins over | ||
| #' item j. For example, in the ranking \\{1\\} > \\{3, 4\\} > \\{2\\}, item 1 wins over | ||
| #' items 2, 3, and 4, and items 3 and 4 win over item 2. | ||
| #' | ||
| #' If \code{weights} is specified, the values in the adjacency matrix are the | ||
| #' weighted counts. | ||
| #' | ||
| #' @param object a \code{\link{rankings}} object, or an object that can be | ||
| #' coerced by \code{as.rankings}. | ||
| #' @param weights an optional vector of weights for the rankings. | ||
| #' @param ... further arguments passed to/from methods. | ||
| #' | ||
| #' @return An N by N matrix, where N is the number of items that can be ranked. | ||
| #' | ||
| #' @examples | ||
| #' X <- matrix(c(2, 1, 2, 1, 2, | ||
| #' 3, 2, 0, 0, 1, | ||
| #' 1, 0, 2, 2, 3), nrow = 3, byrow = TRUE) | ||
| #' X <- as.rankings(X) | ||
| #' adjacency(X) | ||
| #' | ||
| #' adjacency(X, weights = c(1, 1, 2)) | ||
| #' | ||
| #' @export | ||
| adjacency <- function(object, weights = NULL, ...){ | ||
| if (!inherits(object, "rankings")) object <- as.rankings(object) | ||
| N <- ncol(object) | ||
| if (is.null(weights)) { | ||
| weights <- rep.int(1L, nrow(object)) | ||
| } else stopifnot(length(weights) == nrow(object)) | ||
| nset <- apply(object, 1L, max) | ||
| m <- max(nset) | ||
| nm <- colnames(object) | ||
| X <- matrix(0.0, nrow = N, ncol = N, dimnames = list(nm, nm)) | ||
| for (i in 1L:m){ | ||
| r <- which(nset >= (i + 1L)) | ||
| for(j in r) { | ||
| one <- object[j,] == i | ||
| two <- object[j,] > i # > gives rest; == i + 1 gives next best | ||
| X[one, two] <- X[one, two] + weights[j] | ||
| } | ||
| } | ||
| structure(X, class = c("adjacency", "matrix")) | ||
| } | ||
| #' Create an Adjacency Matrix for a set of Rankings | ||
| #' | ||
| #' Convert a set of rankings to an adjacency matrix summarising wins | ||
| #' and losses between pairs of items. | ||
| #' | ||
| #' For a \code{"rankings"} object based on N items, the adjacency matrix is an | ||
| #' N by N matrix, with element (i, j) being the number of times item i wins over | ||
| #' item j. For example, in the ranking \\{1\\} > \\{3, 4\\} > \\{2\\}, | ||
| #' item 1 wins over items 2, 3, and 4, and items 3 and 4 win over item 2. | ||
| #' | ||
| #' If \code{weights} is specified, the values in the adjacency matrix are the | ||
| #' weighted counts. | ||
| #' | ||
| #' @param object a \code{\link{rankings}} object, or an object that can be | ||
| #' coerced by \code{as.rankings}. | ||
| #' @param weights an optional vector of weights for the rankings. | ||
| #' @param ... further arguments passed to/from methods. | ||
| #' | ||
| #' @return An N by N matrix, where N is the number of items that can be ranked. | ||
| #' | ||
| #' @examples | ||
| #' X <- matrix(c(2, 1, 2, 1, 2, | ||
| #' 3, 2, 0, 0, 1, | ||
| #' 1, 0, 2, 2, 3), nrow = 3, byrow = TRUE) | ||
| #' X <- as.rankings(X) | ||
| #' adjacency(X) | ||
| #' | ||
| #' adjacency(X, weights = c(1, 1, 2)) | ||
| #' | ||
| #' @export | ||
| adjacency <- function(object, weights = NULL, ...){ | ||
| if (!inherits(object, "rankings")) object <- as.rankings(object) | ||
| N <- ncol(object) | ||
| if (is.null(weights)) { | ||
| weights <- rep.int(1L, nrow(object)) | ||
| } else stopifnot(length(weights) == nrow(object)) | ||
| nset <- apply(object, 1L, max) | ||
| m <- max(nset) | ||
| nm <- colnames(object) | ||
| X <- matrix(0.0, nrow = N, ncol = N, dimnames = list(nm, nm)) | ||
| for (i in 1L:m){ | ||
| r <- which(nset >= (i + 1L)) | ||
| for(j in r) { | ||
| one <- object[j,] == i | ||
| two <- object[j,] > i # > gives rest; == i + 1 gives next best | ||
| X[one, two] <- X[one, two] + weights[j] | ||
| } | ||
| } | ||
| structure(X, class = c("adjacency", "matrix")) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,70 +1,70 @@ | ||
| #' Plackett-Luce Model Summaries | ||
| #' | ||
| #' Obtain the coefficients, model summary or coefficient variance-covariance | ||
| #' matrix for a model fitted by \code{PlackettLuce}. | ||
| #' | ||
| #' By default, parameters are returned on the log scale, as most suited for | ||
| #' inference. If \code{log = FALSE}, the worth parameters are returned, | ||
| #' constrained to sum to one so that they represent the probability that | ||
| #' the corresponding item comes first in a ranking of all items, given that | ||
| #' first place is not tied. | ||
| #' | ||
| #' The variance-covariance matrix is returned for the worth and tie parameters | ||
| #' on the log scale, with the reference as specified by \code{ref}. For models | ||
| #' estimated by maximum likelihood, the variance-covariance is the inverse of | ||
| #' the Fisher information of the log-likelihood. | ||
| #' | ||
| #' For models with a normal or gamma prior, the variance-covariance is based on | ||
| #' the Fisher information of the log-posterior. When adherence parameters have | ||
| #' been estimated, the log-posterior is not linear in the parameters. In this | ||
| #' case there is a difference between the expected and observed Fisher | ||
| #' information. By default, \code{vcov} will return the variance-covariance | ||
| #' based on the expected information, but \code{type} gives to option to use | ||
| #' the observed information instead. For large samples, the difference between | ||
| #' these options should be small. Note that the estimation of the adherence | ||
| #' parameters is accounted for in the computation of the variance-covariance | ||
| #' matrix, but only the sub-matrix corresponding to the worth and tie | ||
| #' parameters is estimated. | ||
| #' @param object An object of class "PlackettLuce" as returned by | ||
| #' \code{PlackettLuce}. | ||
| #' @param ref An integer or character string specifying the reference item (for | ||
| #' which log worth will be set to zero). If \code{NULL} the sum of the log worth | ||
| #' parameters is set to zero. | ||
| #' @param log A logical indicating whether to return parameters on the log scale | ||
| #' with the item specified by \code{ref} set to zero. | ||
| #' @param type For \code{coef}, the type of coefficients to return: one of | ||
| #' \code{"ties"}, \code{"worth"} or \code{"all"}. For \code{vcov}, the type of | ||
| #' Fisher information to base the estimation on: either \code{"expected"} or | ||
| #' \code{"observed"}. | ||
| #' @param ... additional arguments, passed to \code{vcov} by \code{summary}. | ||
| #' @name summaries | ||
| #' @export | ||
| coef.PlackettLuce <- function(object, ref = 1L, log = TRUE, | ||
| type = "all", ...){ | ||
| type <- match.arg(type, c("ties", "worth", "all")) | ||
| ncoefs <- length(object$coefficients) | ||
| id <- seq_len(ncoefs - length(object$ties) + 1L) | ||
| if (!log) { | ||
| # ignore ref here, always return probabilities | ||
| const <- sum(object$coefficients[id]) | ||
| coefs <- c(object$coefficients[id]/const, object$coefficients[-id]) | ||
| } else { | ||
| const <- mean(log(object$coefficients[id])[ref]) | ||
| item <- itempar.PlackettLuce(object, ref = ref, log = log, vcov = FALSE) | ||
| ref <- attr(item, "ref") | ||
| coefs <- c(item, log(object$coefficients[-id])) | ||
| } | ||
| cls <- c("coef.PlackettLuce", "numeric") | ||
| switch(type, | ||
| "ties" = return(coefs[-id]), | ||
| "worth" = return(structure(coefs[id], ref = ref, log = log, | ||
| const = const, class = cls)), | ||
| "all" = return(structure(coefs, ref = ref, log = log, | ||
| const = const, class = cls))) | ||
| } | ||
|
|
||
| #' @method print coef.PlackettLuce | ||
| #' @export | ||
| print.coef.PlackettLuce <- function (x, ...) { | ||
| print.default(c(x)) | ||
| } | ||
| #' Plackett-Luce Model Summaries | ||
| #' | ||
| #' Obtain the coefficients, model summary or coefficient variance-covariance | ||
| #' matrix for a model fitted by \code{PlackettLuce}. | ||
| #' | ||
| #' By default, parameters are returned on the log scale, as most suited for | ||
| #' inference. If \code{log = FALSE}, the worth parameters are returned, | ||
| #' constrained to sum to one so that they represent the probability that | ||
| #' the corresponding item comes first in a ranking of all items, given that | ||
| #' first place is not tied. | ||
| #' | ||
| #' The variance-covariance matrix is returned for the worth and tie parameters | ||
| #' on the log scale, with the reference as specified by \code{ref}. For models | ||
| #' estimated by maximum likelihood, the variance-covariance is the inverse of | ||
| #' the Fisher information of the log-likelihood. | ||
| #' | ||
| #' For models with a normal or gamma prior, the variance-covariance is based on | ||
| #' the Fisher information of the log-posterior. When adherence parameters have | ||
| #' been estimated, the log-posterior is not linear in the parameters. In this | ||
| #' case there is a difference between the expected and observed Fisher | ||
| #' information. By default, \code{vcov} will return the variance-covariance | ||
| #' based on the expected information, but \code{type} gives to option to use | ||
| #' the observed information instead. For large samples, the difference between | ||
| #' these options should be small. Note that the estimation of the adherence | ||
| #' parameters is accounted for in the computation of the variance-covariance | ||
| #' matrix, but only the sub-matrix corresponding to the worth and tie | ||
| #' parameters is estimated. | ||
| #' @param object An object of class "PlackettLuce" as returned by | ||
| #' \code{PlackettLuce}. | ||
| #' @param ref An integer or character string specifying the reference item (for | ||
| #' which log worth will be set to zero). If \code{NULL} the sum of the log worth | ||
| #' parameters is set to zero. | ||
| #' @param log A logical indicating whether to return parameters on the log scale | ||
| #' with the item specified by \code{ref} set to zero. | ||
| #' @param type For \code{coef}, the type of coefficients to return: one of | ||
| #' \code{"ties"}, \code{"worth"} or \code{"all"}. For \code{vcov}, the type of | ||
| #' Fisher information to base the estimation on: either \code{"expected"} or | ||
| #' \code{"observed"}. | ||
| #' @param ... additional arguments, passed to \code{vcov} by \code{summary}. | ||
| #' @name summaries | ||
| #' @export | ||
| coef.PlackettLuce <- function(object, ref = 1L, log = TRUE, | ||
| type = "all", ...){ | ||
| type <- match.arg(type, c("ties", "worth", "all")) | ||
| ncoefs <- length(object$coefficients) | ||
| id <- seq_len(ncoefs - length(object$ties) + 1L) | ||
| if (!log) { | ||
| # ignore ref here, always return probabilities | ||
| const <- sum(object$coefficients[id]) | ||
| coefs <- c(object$coefficients[id]/const, object$coefficients[-id]) | ||
| } else { | ||
| const <- mean(log(object$coefficients[id])[ref]) | ||
| item <- itempar.PlackettLuce(object, ref = ref, log = log, vcov = FALSE) | ||
| ref <- attr(item, "ref") | ||
| coefs <- c(item, log(object$coefficients[-id])) | ||
| } | ||
| cls <- c("coef.PlackettLuce", "numeric") | ||
| switch(type, | ||
| "ties" = return(coefs[-id]), | ||
| "worth" = return(structure(coefs[id], ref = ref, log = log, | ||
| const = const, class = cls)), | ||
| "all" = return(structure(coefs, ref = ref, log = log, | ||
| const = const, class = cls))) | ||
| } | ||
|
|
||
| #' @method print coef.PlackettLuce | ||
| #' @export | ||
| print.coef.PlackettLuce <- function (x, ...) { | ||
| print.default(c(x)) | ||
| } |
Oops, something went wrong.