jmgirard / circumplex
Showing 3 of 91 files from the diff.
Other files ignored by Codecov
man/iis32.Rd has changed.
docs/LICENSE.html has changed.
man/raw_iipsc.Rd has changed.
man/iitc.Rd has changed.
NAMESPACE has changed.
man/jz2017.Rd has changed.
.travis.yml has changed.
man/igicr.Rd has changed.
docs/index.html has changed.
docs/pkgdown.css has changed.
docs/pkgdown.yml has changed.
R/circumplex.R has changed.
man/iipsc.Rd has changed.
man/iip32.Rd has changed.
man/csig.Rd has changed.
man/iis64.Rd has changed.
CRAN-RELEASE has changed.
docs/404.html has changed.
docs/SUPPORT.html has changed.
docs/authors.html has changed.
man/csip.Rd has changed.
docs/pkgdown.js has changed.
man/ipipipc.Rd has changed.
NEWS.md has changed.
man/aw2009.Rd has changed.
man/iip64.Rd has changed.
man/isc.Rd has changed.
man/csiv.Rd has changed.
man/csie.Rd has changed.
DESCRIPTION has changed.
cran-comments.md has changed.

@@ -17,10 +17,11 @@
Loading
17 17
#' @export
18 18
print.circumplex_instrument <- function(x, ...) {
19 19
  cat(
20 -
    glue("{x$Details$Abbrev}: {x$Details$Name}"), "\n",
21 -
    glue("{x$Details$Items} items, {x$Details$Scales} scales, {nrow(x$Norms[[2]])} normative data sets"), "\n",
22 -
    glue("{x$Details$Reference}"), "\n",
23 -
    glue("<{x$Details$URL}>"), "\n",
20 +
    x$Details$Abbrev, ": ", x$Details$Name, "\n",
21 +
    x$Details$Items, " items, ", x$Details$Scales, " scales, ", 
22 +
    nrow(x$Norms[[2]]), " normative data sets", "\n",
23 +
    x$Details$Reference, "\n",
24 +
    "<", x$Details$URL, ">", "\n",
24 25
    sep = ""
25 26
  )
26 27
}
@@ -66,25 +67,17 @@
Loading
66 67
scales <- function(x, items = FALSE) {
67 68
  assert_that(is_instrument(x), is.flag(items))
68 69
69 -
  cat(
70 -
    glue(
71 -
      "The {x$Details$Abbrev} contains {x$Details$Scales} circumplex scales."
72 -
    )
73 -
  )
74 -
  cat("\n")
70 +
  cat("The ", x$Details$Abbrev, " contains ", x$Details$Scales, 
71 +
      " circumplex scales.\n", sep = "")
75 72
  for (i in 1:nrow(x$Scales)) {
76 73
    xi <- x$Scales[i, ]
77 -
    cat(
78 -
      glue("{xi$Abbrev}: {xi$Label} ({xi$Angle} degrees)"),
79 -
      "\n",
80 -
      sep = ""
81 -
    )
74 +
    cat(xi$Abbrev, ": ", xi$Label, " (", xi$Angle, " degrees)", "\n", sep = "")
82 75
    if (items == TRUE) {
83 76
      item_nums <- as.integer(strsplit(xi$Items, ",")[[1]])
84 77
      for (j in 1:length(item_nums)) {
85 78
        num_j <- item_nums[[j]]
86 -
        item_j <- x$Items[num_j, "Text"]
87 -
        cat(glue("    {num_j}. {item_j}"), "\n", sep = "")
79 +
        item_j <- x$Items[[num_j, "Text"]]
80 +
        cat("    ", num_j, ". ", item_j, "\n", sep = "")
88 81
      }
89 82
    }
90 83
  }
@@ -108,19 +101,14 @@
Loading
108 101
items <- function(x) {
109 102
  assert_that(is_instrument(x))
110 103
111 -
  cat(
112 -
    glue(
113 -
      "The {x$Details$Abbrev} contains {x$Details$Items} items ({x$Details$Status}):"
114 -
    ),
115 -
    "\n",
116 -
    sep = ""
117 -
  )
104 +
  cat("The ", x$Details$Abbrev, " contains ", x$Details$Items, " items (", 
105 +
    x$Details$Status, "):\n", sep = "")
118 106
  for (i in 1:nrow(x$Items)) {
119 107
    xi <- x$Items[i, ]
120 108
    if (!is.na(xi$Number)) {
121 -
      cat(glue("{xi$Number}. "))
109 +
      cat(xi$Number, ". ", sep = "")
122 110
    }
123 -
    cat(glue("{xi$Text}"), "\n", sep = "")
111 +
    cat(xi$Text, "\n", sep = "")
124 112
  }
125 113
126 114
  invisible(x)
@@ -143,21 +131,11 @@
Loading
143 131
  assert_that(is_instrument(x))
144 132
145 133
  cat(
146 -
    glue(
147 -
      "The {x$Details$Abbrev} is rated using the following ",
148 -
      "{nrow(x$Anchors)}-point scale."
149 -
    ),
150 -
    "\n",
151 -
    sep = ""
134 +
    "The ", x$Details$Abbrev, " is rated using the following ",
135 +
    nrow(x$Anchors), "-point scale.", "\n", sep = ""
152 136
  )
153 137
  for (i in seq_along(x$Anchors$Value)) {
154 -
    cat(
155 -
      glue(
156 -
        "{x$Anchors$Value[[i]]}. {x$Anchors$Label[[i]]}"
157 -
      ),
158 -
      "\n",
159 -
      sep = ""
160 -
    )
138 +
    cat(x$Anchors$Value[[i]], ". ", x$Anchors$Label[[i]], "\n",sep = "")
161 139
  }
162 140
163 141
  invisible(x)
@@ -184,33 +162,22 @@
Loading
184 162
  n_norms <- nrow(samples)
185 163
186 164
  if (n_norms == 0) {
187 -
    cat(
188 -
      glue("The {x$Details$Abbrev} currently has no normative data sets."),
189 -
      "\n",
190 -
      sep = ""
191 -
    )
165 +
    cat("The ", x$Details$Abbrev, " currently has no normative data sets.", 
166 +
        "\n", sep = "")
192 167
    return()
193 168
  }
194 169
195 -
  cat(
196 -
    glue(
197 -
      "The {x$Details$Abbrev} currently has {n_norms} normative data set(s):"
198 -
    ),
199 -
    "\n",
200 -
    sep = ""
201 -
  )
170 +
  cat("The ", x$Details$Abbrev, " currently has ", n_norms, 
171 +
      " normative data set(s):", "\n", sep = "")
202 172
203 173
  for (i in 1:n_norms) {
204 174
    sample_i <- samples$Sample[[i]]
205 175
    size_i <- samples$Size[[i]]
206 176
    pop_i <- samples$Population[[i]]
207 177
    cat(
208 -
      glue("{sample_i}. {size_i} {pop_i}"),
209 -
      "\n  ",
210 -
      glue("{samples$Reference[[i]]}"),
211 -
      "\n  ",
212 -
      glue("<{samples$URL[[i]]}>"),
213 -
      "\n",
178 +
      sample_i, ". ", size_i, " ", pop_i, "\n",
179 +
      samples$Reference[[i]], "\n",
180 +
      "<", samples$URL[[i]], ">", "\n",
214 181
      sep = ""
215 182
    )
216 183
  }

@@ -21,61 +21,73 @@
Loading
21 21
22 22
# Class degree -----------------------------------------------------------------
23 23
24 -
# Set numeric object to class 'degree'
24 +
# S3 Constructor
25 25
new_degree <- function(x) {
26 26
  new_s3_num(x, class = c("circumplex_degree", "numeric"))
27 27
}
28 28
29 -
# S3 generic for class 'degree'
29 +
# S3 Generic
30 30
as_degree <- function(x, ...) {
31 31
  UseMethod("as_degree")
32 32
}
33 33
34 -
# Set numeric object to class 'degree'
34 +
# S3 Method
35 +
#' @method as_degree default
36 +
#' @export
35 37
as_degree.default <- function(x, ...) {
36 38
  new_degree(x)
37 39
}
38 40
39 -
# Return object if already class 'degree'
41 +
# S3 Method
42 +
#' @method as_degree circumplex_degree
43 +
#' @export
40 44
as_degree.circumplex_degree <- function(x, ...) {
41 45
  x
42 46
}
43 47
44 -
# Convert from class 'radian' to class 'degree'
48 +
# S3 Method
49 +
#' @method as_degree circumplex_radian
50 +
#' @export
45 51
as_degree.circumplex_radian <- function(x, ...) {
46 52
  new_degree(x * (180 / pi))
47 53
}
48 54
49 55
# Class radian -----------------------------------------------------------------
50 56
51 -
# Set numeric object to class 'radian'
57 +
# S3 Constructor
52 58
new_radian <- function(x) {
53 59
  new_s3_num(x, class = c("circumplex_radian", "numeric"))
54 60
}
55 61
56 -
# S3 generic for class 'radian'
62 +
# S3 Generic
57 63
as_radian <- function(x, ...) {
58 64
  UseMethod("as_radian")
59 65
}
60 66
61 -
# Set numeric object to class 'radian'
67 +
# S3 Method
68 +
#' @method as_radian default
69 +
#' @export
62 70
as_radian.default <- function(x, ...) {
63 71
  new_radian(x)
64 72
}
65 73
66 -
# Return object if already class 'radian'
74 +
# S3 Method 
75 +
#' @method as_radian circumplex_radian
76 +
#' @export
67 77
as_radian.circumplex_radian <- function(x, ...) {
68 78
  x
69 79
}
70 80
71 -
# Convert from class 'degree' to class 'radian'
81 +
# S3 Method
82 +
#' @method as_radian circumplex_degree
83 +
#' @export
72 84
as_radian.circumplex_degree <- function(x, ...) {
73 85
  new_radian(x * (pi / 180))
74 86
}
75 87
76 88
# Class ssm --------------------------------------------------------------------
77 89
78 -
# Constructor function
90 +
# S3 Constructor
79 91
new_ssm <- function(results, details, call, ...) {
80 92
  new_s3_scalar(
81 93
    results = results,
@@ -87,6 +99,7 @@
Loading
87 99
}
88 100
89 101
#  Print method for objects of ssm class
102 +
#' @method print circumplex_ssm
90 103
#' @export
91 104
print.circumplex_ssm <- function(x, digits = 3, ...) {
92 105
  # Print function call
@@ -119,6 +132,7 @@
Loading
119 132
}
120 133
121 134
# Summary method for objects of ssm class
135 +
#' @method summary circumplex_ssm
122 136
#' @export
123 137
summary.circumplex_ssm <- function(object, digits = 3, ...) {
124 138
  # Print function call

@@ -67,7 +67,7 @@
Loading
67 67
ssm_plot_circle <- function(.ssm_object, amax = NULL, fontsize = 12,
68 68
                            lowfit = TRUE) {
69 69
  df <- .ssm_object$results
70 -
  angles <- as.numeric(.ssm_object$details$angles)
70 +
  angles <- as.integer(round(.ssm_object$details$angles))
71 71
72 72
  assert_that(is.null(amax) || is.number(amax))
73 73
@@ -176,18 +176,23 @@
Loading
176 176
177 177
  # TODO: Check that these ifelse() statements are correct
178 178
179 -
  res <- dplyr::mutate(res,
180 -
    d_uci = ifelse(d_uci < d_lci && d_uci < 180, circ_dist(d_uci), d_uci),
181 -
    d_lci = ifelse(d_lci > d_uci && d_lci > 180, circ_dist(d_lci), d_lci)
182 -
  ) %>%
183 -
    tidyr::gather(key, value, -label, -fit_est) %>%
184 -
    tidyr::extract(key, c("Parameter", "Type"), "(.)_(...)") %>%
185 -
    tidyr::spread(Type, value) %>%
186 -
    dplyr::rename(Difference = est, Contrast = label) %>%
179 +
  res <- 
180 +
    res %>% 
187 181
    dplyr::mutate(
188 -
      Parameter = factor(Parameter, levels = c("e", "x", "y", "a", "d"))
189 -
    )
190 -
  p <- ggplot2::ggplot(res) +
182 +
      d_est = unclass(d_est),
183 +
      d_uci = unclass(ifelse(d_uci < d_lci && d_uci < 180, circ_dist(d_uci), d_uci)),
184 +
      d_lci = unclass(ifelse(d_lci > d_uci && d_lci > 180, circ_dist(d_lci), d_lci))
185 +
    ) %>%
186 +
    dplyr::select(-fit_est) %>% 
187 +
    tidyr::pivot_longer(cols = e_est:d_uci, names_to = "key", values_to = "value") %>% 
188 +
    tidyr::extract(col = key, into = c("Parameter", "Type"), "(.)_(...)") %>% 
189 +
    tidyr::pivot_wider(names_from = Type, values_from = value) %>% 
190 +
    dplyr::rename(Difference = est, Contrast = label) %>%
191 +
    dplyr::mutate(Parameter = factor(Parameter, levels = c("e", "x", "y", "a", "d")))
192 +
  
193 +
  p <- 
194 +
    res %>% 
195 +
    ggplot2::ggplot() +
191 196
    ggplot2::theme_bw(base_size = fontsize) +
192 197
    ggplot2::theme(
193 198
      legend.position = "top",
Files Coverage
R 89.93%
src 100.00%
Project Totals (11 files) 91.45%