Verified Commit 9feded17 authored by Cody L Marquart's avatar Cody L Marquart
Browse files

Cleaning up checks

[check rhub]
parent 66d6957f
Pipeline #64180 canceled with stages
in 15 minutes and 24 seconds
......@@ -21,4 +21,4 @@ Suggests:
tm,
knitr,
rmarkdown
RoxygenNote: 7.0.2
RoxygenNote: 7.1.0
......@@ -8,6 +8,7 @@ S3method(print,summary.TestList)
S3method(summary,Code)
S3method(summary,CodeSet)
S3method(summary,TestList)
export(Code)
export(CodeSet)
export(RegexCode)
export(autocode)
......@@ -18,7 +19,6 @@ export(expression.match)
export(getHandSetIndices)
export(getHandSetIndices2)
export(handcode)
export(ncode)
export(old_test)
export(resolve)
export(test)
......
......@@ -12,7 +12,6 @@
#'
#' # Generate a Code
#' newcode = create.code(name = "Data", expressions = c("number","data"), excerpts = rs$text)
#'
#'
#' @return Code object
#' @export
......@@ -21,24 +20,29 @@ create.code <- function(name = "NewCode", definition = NULL, excerpts = NULL, ty
return(newCode)
}
# Title
#
# @param name
# @param definition
# @param codeSet
# @param testSet
# @param trainingSet
# @param computerSet
# @param ignoredSet
# @param examples
# @param excerpts
# @param ...
#
# @examples
#
#
# @return Code object
# @export
#' ncodeR Code object
#'
#' @field call TBD
#' @field name TBD
#' @field definition TBD
#' @field codeSet TBD
#' @field testSet TBD
#' @field trainingSet TBD
#' @field computerSet TBD
#' @field ignoredSet TBD
#' @field examples TBD
#' @field excerpts TBD
#' @field holdoutExcerpts TBD
#' @field touchableExcerpts TBD
#' @field touchedIndices TBD
#' @field additionalExcerpts TBD
#' @field secondRaterSet TBD
#' @field statistics TBD
#' @field baserate TBD
#' @field baserateInflation TBD
#'
#' @export
#' @return Code object
Code = R6::R6Class("Code",
public = list(
call = NULL,
......@@ -61,9 +65,22 @@ Code = R6::R6Class("Code",
baserateInflation = NA,
baserate = NA,
###
# Main class constructor
###
#' Create Code
#'
#' @param name TBD
#' @param definition TBD
#' @param testSet TBD
#' @param trainingSet TBD
#' @param computerSet TBD
#' @param secondRaterSet TBD
#' @param ignoredSet TBD
#' @param examples TBD
#' @param excerpts TBD
#' @param holdoutSize TBD
#' @param ... TBD
#'
#' @return Code object
initialize = function(
name,
definition,
......@@ -132,9 +149,17 @@ Code = R6::R6Class("Code",
self$ignoredSet = ignoredSet;
},
#' Function to override
#' @return Default, error, unless overridden
process = function() {
stop(paste0("This function needs to be overridden by the implementing Code class: ", class(self)[1]));
},
#' Kappa on Code
#'
#' @param which TBD
#'
#' @return double
kappa = function(which = c("training","test")) {
which = match.arg(which, choices = c("training","test"))
......@@ -147,33 +172,61 @@ Code = R6::R6Class("Code",
NA
}
},
#' Differences in sets
#'
#' @param data TBD
#' @param col1 TBD
#' @param col2 TBD
#' @param cols TBD
#'
#' @return vector of indices
differences = function(data = NULL, col1 = NULL, col2 = NULL, cols = NULL) {
differences(self)
},
#' Clear TestSet
#' @return NULL
clearTestSet = function() {
self$trainingSet = rbind(self$trainingSet, self$testSet)
self$testSet = self$testSet[-c(1:nrow(self$testSet)),]
private$testedTestSet = F
},
#' Concatenate Expressions
#'
#' @return character of concatenated expressions
concat = function(){
return (paste(self$expressions, collapse="|"));
},
print = function() {
to.print = list();
ss = get(class(self))
fields = Filter(function(f) {
cls = class(self[[f]]);
!is(self[[f]], "function") && !is.null(self[[f]]) && cls != "environment"
}, c(names(ss$public_fields), names(ss$get_inherit()$public_fields)))
for(field in fields) {
to.print[[field]] = self[[field]]
}
print(to.print)
},
# print = function() {
# # print(self$excerpts)
# self$excerpts
# # to.print = list();
# # ss = get(class(self))
# # fields = Filter(function(f) {
# # cls = class(self[[f]]);
# # !is(self[[f]], "function") && !is.null(self[[f]]) && cls != "environment"
# # }, c(names(ss$public_fields), names(ss$get_inherit()$public_fields)))
# # for(field in fields) {
# # to.print[[field]] = self[[field]]
# # }
# # print(to.print)
# },
#' Get Value
#'
#' @param wh character
#'
#' @return value stored at wh
getValue = function(wh) {
private[[wh]]
},
#' Set Value
#'
#' @param wh character
#' @param val object
setValue = function(wh, val) {
private[[wh]] = val
}
......
#' @title Create CodeSet
#' Create CodeSet
#' @description Create a new CodeSet object
#'
#' @param title Title for the CodeSet
......@@ -11,29 +11,29 @@
#' rs = RS.data
#' code.set = code.set("Demo RS CodeSet", "CodeSet made for the demo", excerpts = rs$text, codes = c())
#'
#' @return CodeSet object
#' @export
#' @return CodeSet object
###
code.set <- function(title = "", description = "", excerpts = c(), codes = c()) {
CodeSet$new(title, description, excerpts, codes);
}
#' @title CodeSet
#' CodeSet
#' @description Object representing a set of codes
#'
#' @field title Title of the CodeSet
#' @field call TBD
#' @field codes list of Codes
#' @field description String description of the set of codes to be included
#' @field excerpts Character vector of text excerpts to code (optional)
#' @field expressions Codes to include in the CodeSet (optional)
#'
#' @examples
#' data(RS.data)
#' rs = RS.data
#' code.set = code.set("Demo RS CodeSet", "CodeSet made for the demo", excerpts = rs$text, codes = c())
#'
#' @return CodeSet object
#' @export
#' @return CodeSet
#' @return CodeSet object
###
CodeSet = R6::R6Class("CodeSet",
public = list(
......@@ -45,9 +45,15 @@ CodeSet = R6::R6Class("CodeSet",
excerpts = c(), #character vector containing the set of excerpts that the codes are being applied to
codes = c(), #collection of codes belonging to the set
###
# Main class constructor
###
#' Create CodeSet
#'
#' @param title TBD
#' @param description TBD
#' @param excerpts TBD
#' @param codes TBD
#'
#' @return CodeSet
initialize = function(
title = "ne",
description = NULL,
......
#' @title RegexCode
#' RegexCode
#' @description Creates an object for Regular Expression coding. No need to call this
#' directly, create.code is a nice wrapper around this and any other types of Codes
#'
#' @field name Name of the Code
#' @field definition Definition of the Code
#' @field excerpts Character vector of text excerpts to code
#' @field ... Additional parameters not specific to a RegexCode
#' @field expressions Character vector of regular expressions
#' @field metadata TBD
#'
#' @examples
#' data(RS.data)
......@@ -16,8 +13,8 @@
#' newcode = RegexCode$new(name = "New Code", definition = "Some definition",
#' excerpts = rs$text, expressions = c("number","data"))
#'
#' @return RegexCode object
#' @export
#' @return RegexCode object
RegexCode = R6::R6Class("RegexCode",
inherit = Code,
......@@ -27,9 +24,16 @@ RegexCode = R6::R6Class("RegexCode",
expressions = c(),
metadata = data.frame(),
###
# Main class constructor
######
#' Create RegexCode
#'
#' @param name TBD
#' @param definition TBD
#' @param ... TBD
#' @param excerpts TBD
#' @param expressions TBD
#'
#' @return
initialize = function(
name,
definition,
......@@ -47,17 +51,22 @@ RegexCode = R6::R6Class("RegexCode",
},
#####
###
# Process function to override that on Code
#####
#' Process Code
#'
#' @param excerpts Options excerpts to code
#'
#' @return Code results
process = function(excerpts = self$excerpts) {
expression.match(excerpts, self$expressions, names = list(NULL, self$name))
},
#####
###
# Adds a new expression to the code's list
#####
#' Add word
#'
#' @param word To add to expressions
#'
#' @return NULL
add = function(
word
){
......@@ -66,14 +75,16 @@ RegexCode = R6::R6Class("RegexCode",
}
self$expressions = c(self$expressions, word);
###DOES THIS AFFECT TRAINING/TEST SETS?
message("###DOES THIS AFFECT TRAINING/TEST SETS?")
},
#####
###
# Removes an expression from the code's list
#####
remove = function(
#' Remove word
#'
#' @param word to remove
#'
#' @return NULL
remove = function(
word
){
if(class(word) != "character"){
......@@ -86,17 +97,16 @@ RegexCode = R6::R6Class("RegexCode",
self$expressions = self$expressions[-index];
}
###DOES THIS AFFECT TRAINING/TEST SETS?
message("###DOES THIS AFFECT TRAINING/TEST SETS?")
},
#####
###
# Concatenate expressions list as single regular expression
#####
#' Concatenate expressions
#'
#' @return character of concatentated expressions
concat = function(){
return (paste(self$expressions, collapse="|"));
}
#####
),
private = list()
......
......@@ -23,15 +23,15 @@ calc_statistics <- function(set, kappa_threshold = 0.9, baserate_inflation = 0.2
stats
}
#' Title
#' Test code
#'
#' @param code [TBD]
#' @param kappa_threshold [TBD]
#' @param baserate_inflation [TBD]
#' @param ... [TBD]
#'
#' @return code object
#' @export
#' @return code object
test <- function(code, kappa_threshold = 0.65, baserate_inflation = 0.2, ...) {
args <- list(...)
if(!is.null(args$kappaThreshold)) {
......@@ -124,7 +124,7 @@ test <- function(code, kappa_threshold = 0.65, baserate_inflation = 0.2, ...) {
code.to.use
}
#' @title Calculate statistics
#' Calculate statistics
#' @description Run tests (kappa, rho) on the given Code
#'
#' @param code Code object to test
......@@ -132,8 +132,8 @@ test <- function(code, kappa_threshold = 0.65, baserate_inflation = 0.2, ...) {
#' @param baserateInflation inflation rate to use when sampling handsets
#' @param type vector indicating which stats should be calculated
#'
#' @return Code object with updated statistics property
#' @export
#' @return Code object with updated statistics property
old_test <- function(code, kappaThreshold = 0.65, baserateInflation = 0.2, type = c("training", "test")) {
if(is.null(code) || !is(object=code, class=c("Code")))
stop("Supplied `code` must be an instance of `Code`")
......
#' Title
#' Code to data.frame
#'
#' @param x Code object to convert
#' @param row.names NULL or a character vector giving the row names for the data frame. Missing values are not allowed.
......@@ -11,8 +11,8 @@
#' newcode = create.code(name = "Data", expressions = c("number","data"), excerpts = rs$text)
#' as.data.frame(newcode)
#'
#' @return data.frame
#' @export
#' @return data.frame
as.data.frame.Code <- function(x, row.names = NULL, optional = FALSE, ...) {
len = length(x$excerpts)
args = list(...)
......
#' Title
#' CodeSet to data.frame
#'
#' @param x CodeSet to convert
#' @param row.names NULL or a character vector giving the row names for the data frame. Missing values are not allowed.
......
......@@ -9,7 +9,6 @@
#' @param mode Either all, training, or test representing the set of excerpts that should be recoded in the computerSet
#'
#' @return data.frame of is simplify = T (default), otherwise the Code or CodeSet object with updated computerSets
#'
#' @export
autocode <- function(x = NULL, expressions = NULL, excerpts = NULL, simplify = T, mode = "all") {
modes = c("all", "training", "test")
......
#' Find rows that differ within a data.frame or two vectors
#' @title Find Differences
#' Find Differences
#' @description Find rows that differ within a data.frame or two vectors
#'
#' @param code Code object to search for differences
......
#' @title Handset indices
#' Handset indices
#' @description Handset indices
#' @param codeToUse [TBD]
#' @param handSetLength [TBD]
......
#' Handcode a set of excerpts using a vector of expressions
#' @title Handcode excerpts
#' Handcode Code
#' @description Handcode a set of excerpts using a vector of expressions
#'
#' @param code Code object to handcode
......@@ -11,7 +10,6 @@
#' @param this.set [TBD]
#' @param results [TBD]
#'
#' @import cli
#' @export
#' @return Code
handcode = function(
......
#' Wrapper for the entire coding process
#' @description Wrapper for the entire coding process
#' @import cli
#' @export
ncode <- function() {
}
\ No newline at end of file
# Wrapper for the entire coding process
# @description Wrapper for the entire coding process
# @import cli
# @export
# ncode <- function() {
#
# }
\ No newline at end of file
#' @title ncodeR for qualitative coding
#' ncodeR for qualitative coding
#' @description ncodeR is used for generating codes and coding datasets
#' @name ncodeR
#' @import R6
......
#' @title Resolve differences
#' Resolve differences
#' @description Resolve differing results
#'
#' @param code Code to resolve coding differences
......
......@@ -158,14 +158,14 @@ summary.Code = function( object, ... ) {
}
this.summary <- list(
object$name,
object$codeSet$title,
object$definition,
object$examples,
statsSummary,
object$expressions,
object$baserate,
object$baserateInflation
Name = object$name,
CodeBook = object$codeSet$title,
Definition = object$definition,
# Examples = object$examples,
Statistics = statsSummary,
Expressions = object$expressions,
Baserate = object$baserate,
BaserateInflation = object$baserateInflation
)
class(this.summary) <- "summary.Code"
......@@ -193,15 +193,15 @@ print.summary.Code = function(x, ...) {
to.write = c(
paste0("Name: ", x[[1]]),
paste0("Baserate: ", float(x[[7]])),
paste0("Baserate Inflation: ", float(x[[8]]))
paste0("Baserate: ", float(x[[6]])),
paste0("Baserate Inflation: ", float(x[[7]]))
);
if(!is.null(x[[3]]) && x[[3]] != "")
to.write = c(to.write, paste0("Definition: ", x[[3]]))
if(!is.null(x[[4]]))
to.write = c(to.write, paste0("Examples: ", x[[4]]))
# if(!is.null(x[[4]]))
# to.write = c(to.write, paste0("Examples: ", x[[4]]))
if(!is.null(x[[6]]))
to.write = c(to.write, paste0("Expressions: ", paste(x[[6]], collapse=", ")))
to.write = c(to.write, paste0("Expressions: ", paste(x[[5]], collapse=", ")))
to.write = c(to.write, "Statistics: ")
......
......@@ -90,7 +90,7 @@ unseen_words <- function(code, unweighted = TRUE, include_handcoded = FALSE, exc
ret <- NULL;
if(any(unseen_set_sums > 0)) {
unseen_set_found <- unseen_set_sums[unseen_set_sums > 0]
ret <- as.integer(names(tail(sort(unseen_set_found), 2)))
ret <- as.integer(names(utils::tail(sort(unseen_set_found), 2)))
}
return(ret);
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/Code.R
\name{Code}
\alias{Code}
\title{ncodeR Code object}
\value{
Code object
Create Code
}
\description{
ncodeR Code object
ncodeR Code object
}
\section{Public fields}{
\if{html}{\out{<div class="r6-fields">}}
\describe{
\item{\code{call}}{TBD}
\item{\code{name}}{TBD}
\item{\code{definition}}{TBD}
\item{\code{codeSet}}{TBD}
\item{\code{testSet}}{TBD}
\item{\code{trainingSet}}{TBD}
\item{\code{computerSet}}{TBD}
\item{\code{ignoredSet}}{TBD}
\item{\code{examples}}{TBD}
\item{\code{excerpts}}{TBD}
\item{\code{holdoutExcerpts}}{TBD}
\item{\code{touchableExcerpts}}{TBD}
\item{\code{touchedIndices}}{TBD}
\item{\code{additionalExcerpts}}{TBD}
\item{\code{secondRaterSet}}{TBD}
\item{\code{statistics}}{TBD}
\item{\code{baserate}}{TBD}
\item{\code{baserateInflation}}{TBD}
}
\if{html}{\out{</div>}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-new}{\code{Code$new()}}
\item \href{#method-process}{\code{Code$process()}}
\item \href{#method-kappa}{\code{Code$kappa()}}
\item \href{#method-differences}{\code{Code$differences()}}
\item \href{#method-clearTestSet}{\code{Code$clearTestSet()}}
\item \href{#method-concat}{\code{Code$concat()}}
\item \href{#method-getValue}{\code{Code$getValue()}}
\item \href{#method-setValue}{\code{Code$setValue()}}
\item \href{#method-clone}{\code{Code$clone()}}
}
}
\if{html}{\out{<hr>}}
\if{html}{\out{<a id="method-new"></a>}}
\if{latex}{\out{\hypertarget{method-new}{}}}
\subsection{Method \code{new()}}{
\subsection{Usage}{
\if{html}{\out{<div class="r">}}\preformatted{Code$new(
name,
definition,
testSet = NULL,
trainingSet = NULL,
computerSet = NULL,