Verified Commit 52ca2f92 authored by Cody L Marquart's avatar Cody L Marquart
Browse files

Updating summaries

parent 2a5d4e19
Pipeline #46978 failed with stages
in 3 minutes and 30 seconds
......@@ -17,6 +17,7 @@ Imports:
cli
Suggests:
testthat,
magrittr,
knitr,
rmarkdown
RoxygenNote: 6.1.1
......
......@@ -4,11 +4,9 @@ S3method(as.data.frame,Code)
S3method(as.data.frame,CodeSet)
S3method(print,summary.Code)
S3method(print,summary.CodeSet)
S3method(print,summary.Test)
S3method(print,summary.TestList)
S3method(summary,Code)
S3method(summary,CodeSet)
S3method(summary,Test)
S3method(summary,TestList)
export(CodeSet)
export(RegexCode)
......
......@@ -76,7 +76,7 @@ print.summary.CodeSet = function(x, ...){
#' rs = RS.data
#' newcode = create.code(name = "Data",
#' expressions = c("number","data"), excerpts = rs$text)
#' #newcode = handcode(code = newcode, excerpts = rs$text, n = 4)
#' newcode <- handcode(newcode, this.set = 10:15, results = 0)
#' newcode = test(code = newcode, kappa_threshold = 0.65)
#' summary(newcode$statistics)
#' @return list of Test summary
......@@ -84,20 +84,16 @@ print.summary.CodeSet = function(x, ...){
summary.TestList = function(object, ...) {
args = list(...)
stats <- object[[length(object)]]$one_v_classifier
summary = list(
stats$test_set$kappa, stats$test_set$N, stats$test_set$rho,
stats$training_set$kappa, stats$training_set$N
)
which.tests = c("test","training")
if(!is.null(args$which.tests)) {
which.tests = args$which.tests
}
summaries = sapply(which.tests, function(t) {
res = object[[paste0(t,"Set")]]
if(!is.null(res) && length(res) > 0) {
summary(res[[length(res)]], which.test = t)
}
})
summaries
class(summary) = "summary.TestList"
summary
}
#' Print a TestList summary
#'
#' @param x list from summary()
......@@ -106,88 +102,35 @@ summary.TestList = function(object, ...) {
#' @examples
#' data(RS.data)
#' rs = RS.data
#' newcode = create.code( name = "Data",
#' expressions = c("number","data"), excerpts = rs$text)
#' #newcode = handcode(code = newcode, excerpts = rs$text, n = 4)
#' newcode <- create.code("Data", expressions = c("number","data"), excerpts = rs$text)
#' newcode <- handcode(newcode, this.set = 10:15, results = 0)
#' newcode = test(code = newcode, kappa_threshold = 0.65)
#' summary(newcode$statistics)
#'
#' @return prints summary
#' @export
print.summary.TestList = function(x, ...) {
browser()
}
#' Obtain a summary of a Code's test results
#'
#' @param object Test object of Code
#' @param ... Additional parameters
#'
#' @examples
#' data(RS.data)
#' rs = RS.data
#' newcode = create.code(name = "Data",
#' expressions = c("number","data"), excerpts = rs$text)
#' #newcode = handcode(code = newcode, excerpts = rs$text, n = 4)
#' newcode = test(code = newcode, kappa_threshold = 0.65)
#' summary(newcode$statistics)
#' @return list of Test summary
#' @export
summary.Test = function(object, ...) {
# browser()
args = list(...)
width = 40;
which.test = "test"
if(!is.null(args$which.test)) which.test = args$which.test;
this.summary = c(
which = which.test,
kappa = object$kappa,
N = object$N
)
if(!is.null(args$width)) width = args$width
if(which.test == "test") {
this.summary = c(this.summary, rho = object$rho)
}
test_vals = paste0(float(x[[1]]),"\t| ",float(x[[3]]),"\t| ",x[[2]])
class(this.summary) = "summary.Test"
this.summary
}
#' Print a Test summary
#'
#' @param x list from summary()
#' @param ... Additional parameters
#'
#' @examples
#' data(RS.data)
#' rs = RS.data
#' newcode = create.code( name = "Data",
#' expressions = c("number","data"), excerpts = rs$text)
#' #newcode = handcode(code = newcode, excerpts = rs$text, n = 4)
#' newcode = test(code = newcode, kappa_threshold = 0.65)
#' summary(newcode$statistics)
#' @return prints summary
#' @export
print.summary.Test = function(x, ...) {
args = list(...)
width = 40;
if(!is.null(args$width)) width = args$width
training_vals = paste0(float(x[[4]]),"\t| ",x[[5]])
header = NULL
vals = NULL
if(x[1] == "test") {
header = "kappa\t| rho\t| N"
vals = paste0(float(x[2]),"\t| ",float(x[4]),"\t| ",x[3])
}
else if(x[1] == "training" || x[1] == "secondRater") {
header = "kappa\t| N"
vals = paste0(float(x[2]),"\t| ",x[3])
}
writeLines(c(
"\nTest Set",
paste0(rep("-",width), collapse=""),
"kappa\t| rho\t| N",
paste0(rep("-",width), collapse=""),
test_vals,
paste0(rep("-",width), collapse=""),
"\nTraining Set",
paste0(rep("-",width), collapse=""),
header,
"kappa\t| N",
paste0(rep("-",width), collapse=""),
vals,
training_vals,
paste0(rep("-",width), collapse=""),
""
))
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/summary&print.R
\name{print.summary.Test}
\alias{print.summary.Test}
\title{Print a Test summary}
\usage{
\method{print}{summary.Test}(x, ...)
}
\arguments{
\item{x}{list from summary()}
\item{...}{Additional parameters}
}
\value{
prints summary
}
\description{
Print a Test summary
}
\examples{
data(RS.data)
rs = RS.data
newcode = create.code( name = "Data",
expressions = c("number","data"), excerpts = rs$text)
#newcode = handcode(code = newcode, excerpts = rs$text, n = 4)
newcode = test(code = newcode, kappa_threshold = 0.65)
summary(newcode$statistics)
}
......@@ -20,9 +20,9 @@ Print a TestList summary
\examples{
data(RS.data)
rs = RS.data
newcode = create.code( name = "Data",
expressions = c("number","data"), excerpts = rs$text)
#newcode = handcode(code = newcode, excerpts = rs$text, n = 4)
newcode <- create.code("Data", expressions = c("number","data"), excerpts = rs$text)
newcode <- handcode(newcode, this.set = 10:15, results = 0)
newcode = test(code = newcode, kappa_threshold = 0.65)
summary(newcode$statistics)
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/summary&print.R
\name{summary.Test}
\alias{summary.Test}
\title{Obtain a summary of a Code's test results}
\usage{
\method{summary}{Test}(object, ...)
}
\arguments{
\item{object}{Test object of Code}
\item{...}{Additional parameters}
}
\value{
list of Test summary
}
\description{
Obtain a summary of a Code's test results
}
\examples{
data(RS.data)
rs = RS.data
newcode = create.code(name = "Data",
expressions = c("number","data"), excerpts = rs$text)
#newcode = handcode(code = newcode, excerpts = rs$text, n = 4)
newcode = test(code = newcode, kappa_threshold = 0.65)
summary(newcode$statistics)
}
......@@ -22,7 +22,7 @@ data(RS.data)
rs = RS.data
newcode = create.code(name = "Data",
expressions = c("number","data"), excerpts = rs$text)
#newcode = handcode(code = newcode, excerpts = rs$text, n = 4)
newcode <- handcode(newcode, this.set = 10:15, results = 0)
newcode = test(code = newcode, kappa_threshold = 0.65)
summary(newcode$statistics)
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment