Re-implement textmodel_svmlim() without dependencies
kbenoit
| 1 |
#' Influence plot for text scaling models
|
|
| 2 |
#'
|
|
| 3 |
#' Plot the results of a fitted scaling model, from (e.g.) a predicted
|
|
| 4 |
#' [textmodel_affinity] model.
|
|
| 5 |
#' @param x the object output from `influence()` run on the
|
|
| 6 |
#' fitted or predicted scaling model object to be plotted
|
|
| 7 |
#' @param n the number of features whose influence will be plotted
|
|
| 8 |
#' @param ... additional arguments passed to [plot()]
|
|
| 9 |
#' @seealso [textmodel_affinity()]
|
|
| 10 |
#' @importFrom graphics plot
|
|
| 11 |
#' @export
|
|
| 12 |
#' @author Patrick Perry and Kenneth Benoit
|
|
| 13 |
#' @seealso [influence.predict.textmodel_affinity()]
|
|
| 14 |
#' @keywords textplot
|
|
| 15 |
#' @examples
|
|
| 16 |
#' tmod <- textmodel_affinity(data_dfm_lbgexample, y = c("L", NA, NA, NA, "R", NA))
|
|
| 17 |
#' pred <- predict(tmod)
|
|
| 18 |
#' textplot_influence(influence(pred))
|
|
| 19 |
textplot_influence <- function(x, n = 30, ...) { |
|
| 20 | 1 |
UseMethod("textplot_influence") |
| 21 |
}
|
|
| 22 |
|
|
| 23 |
#' @export
|
|
| 24 |
textplot_influence.default <- function(x, n = 30, ...) { |
|
| 25 | 1 |
stop(friendly_class_undefined_message(class(x), "textplot_influence")) |
| 26 |
}
|
|
| 27 |
|
|
| 28 |
#' @export
|
|
| 29 |
#' @method textplot_influence influence.predict.textmodel_affinity
|
|
| 30 |
textplot_influence.influence.predict.textmodel_affinity <- function(x, n = 30, ...) { |
|
| 31 | 1 |
ans <- summary(x, ...) |
| 32 | 1 |
textplot_influence(ans, n, ...) |
| 33 |
}
|
|
| 34 |
|
|
| 35 |
#' @importFrom graphics legend text points
|
|
| 36 |
#' @method textplot_influence summary.influence.predict.textmodel_affinity
|
|
| 37 |
#' @export
|
|
| 38 |
textplot_influence.summary.influence.predict.textmodel_affinity <- function(x, n = 30, ...) { |
|
| 39 | 1 |
word <- x$word[x$support] |
| 40 | 1 |
rate <- x$rate[x$support] |
| 41 | 1 |
influence <- x$median[x$support] |
| 42 | 1 |
direction <- x$direction[x$support] |
| 43 | 1 |
imbalance <- influence / rate |
| 44 |
|
|
| 45 | 1 |
x <- log10(rate) |
| 46 | 1 |
y <- 100 * influence |
| 47 | 1 |
col <- as.integer(direction) |
| 48 | 1 |
plot(x, y, type = "n", xlab=expression(Log[10]("Median Rate")), |
| 49 | 1 |
ylab=expression("Median Influence" %*% 100)) |
| 50 |
|
|
| 51 | 1 |
if (!is.null(n) && !is.na(n)) { |
| 52 | 1 |
n <- min(n, nrow(x)) |
| 53 | 1 |
subset <- rank(-influence, ties.method="first") <= n |
| 54 |
} else { |
|
| 55 |
subset <- rep(TRUE, length(word)) |
|
| 56 |
}
|
|
| 57 | 1 |
points(x[!subset], y[!subset], cex=0.5, col=col[!subset]) |
| 58 | 1 |
text(x[subset], y[subset], word[subset], cex=0.75, col=col[subset]) |
| 59 |
|
|
| 60 | 1 |
levels <- levels(direction) |
| 61 | 1 |
legend("topleft", legend = levels, fill = seq_along(levels), inset=0.05) |
| 62 |
}
|
Read our documentation on viewing source code .