Skip to content

Commit

Permalink
small fixes for cran submission
Browse files Browse the repository at this point in the history
  • Loading branch information
emitanaka committed May 6, 2024
1 parent 75d3fbf commit bb9a831
Show file tree
Hide file tree
Showing 8 changed files with 115 additions and 116 deletions.
7 changes: 7 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,12 @@ S3method(examine_recipe,edbl_table)
S3method(examine_recipe,takeout)
S3method(format,edbl_fct)
S3method(format,edbl_lvls)
S3method(graph_input,cond_lvls)
S3method(graph_input,cross_lvls)
S3method(graph_input,default)
S3method(graph_input,edbl_lvls)
S3method(graph_input,formula)
S3method(graph_input,nest_lvls)
S3method(levels,edbl_fct)
S3method(levels,edbl_lvls)
S3method(names,edbl_design)
Expand Down Expand Up @@ -132,6 +138,7 @@ export(fct_edges)
export(fct_generator)
export(fct_graph)
export(fct_nodes)
export(graph_input)
export(index_levels)
export(is_cross_levels)
export(is_edibble)
Expand Down
9 changes: 7 additions & 2 deletions R/graph-input.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
#' @param input An input.
#' @param prov A provenance object.
#' @param ... Unused.
#' @keywords internal
#' @export
graph_input <- function(input, prov, ...) {
UseMethod("graph_input")
}
Expand All @@ -18,6 +18,7 @@ graph_input_type = function(input) {
return("unimplemented")
}

#' @export
graph_input.default <- function(input, prov, name, class, ...) {
type <- graph_input_type(input)
levels <- switch(type,
Expand All @@ -29,6 +30,7 @@ graph_input.default <- function(input, prov, name, class, ...) {
graph_input.edbl_lvls(levels, prov, name, class)
}

#' @export
graph_input.edbl_lvls <- function(input, prov, name, class, ...) {
fattrs <- as.data.frame(attr(input, "attrs"))
prov$append_fct_nodes(name = name, role = class, attrs = fattrs)
Expand All @@ -39,12 +41,14 @@ graph_input.edbl_lvls <- function(input, prov, name, class, ...) {
prov$append_lvl_nodes(value = value, n = n, fid = prov$fct_id(name = name), attrs = lattrs)
}

#' @export
graph_input.formula <- function(input, prov, name, class, ...) {
tt <- stats::terms(input)
vars <- rownames(attr(tt, "factors"))
graph_input.cross_lvls(vars, prov, name, class)
}

#' @export
graph_input.cross_lvls <- function(input, prov, name, class, ...) {
flevels <- prov$fct_levels(return = "value")
vars <- input
Expand All @@ -66,6 +70,7 @@ graph_input.cross_lvls <- function(input, prov, name, class, ...) {
}
}

#' @export
graph_input.nest_lvls <- function(input, prov, name, class, ...) {
parent <- input %@% "keyname"
cross_parents <- input %@% "parents"
Expand Down Expand Up @@ -94,7 +99,7 @@ graph_input.nest_lvls <- function(input, prov, name, class, ...) {
}



#' @export
graph_input.cond_lvls <- function(input, prov, name, class, ...) {
parent <- input %@% "keyname"
cross_parents <- input %@% "parents"
Expand Down
8 changes: 4 additions & 4 deletions R/simulate.R
Original file line number Diff line number Diff line change
Expand Up @@ -475,14 +475,14 @@ effects_code <- function(dep_fcts, .data, nlevels = 1) {
sprintf('%s_degree <- sample(1:%d, 1)', fct, ifelse(nfct > 5, 5, nfct - 1)),
paste(sprintf('%s_effects <- as.vector(poly(%s, %s_degree)', fct, fct, fct),
"%*%",
sprintf('rnorm(%s_degree, 0, %.1f))', fct, runif(1, 1, 10))))
sprintf('rnorm(%s_degree, 0, %.1f))', fct, stats::runif(1, 1, 10))))
code_list$model_code <- c(code_list$model_code, sprintf("%s_effects", fct))

# logical not accounted for
} else if(any(c("factor", "character") %in% fct_class)) {
code_list$process_code <- c(code_list$process_code,
sprintf(' %s_effects <- rnorm(%d, 0, %.1f)',
fct, nfct, runif(1, 1, 10)))
fct, nfct, stats::runif(1, 1, 10)))
code_list$model_code <- c(code_list$model_code, sprintf("%s_effects[index_levels(%s)]", fct, fct))
}
}
Expand All @@ -495,13 +495,13 @@ effects_code <- function(dep_fcts, .data, nlevels = 1) {
if("numeric" %in% fct_class) {
code_list$process_code <- c(code_list$process_code,
sprintf(' %s_degree <- lapply(1:%d, function(i) sample(1:%d, 1))', fct, nlevels, nfct),
sprintf(' %s_effects <- lapply(1:%d, function(i) as.vector(poly(%s, %s_degree[[i]]) %*% rnorm(%s_degree[[i]], 0, %.1f)))', fct, nlevels, fct, fct, fct, runif(1, 1, 10)))
sprintf(' %s_effects <- lapply(1:%d, function(i) as.vector(poly(%s, %s_degree[[i]]) %*% rnorm(%s_degree[[i]], 0, %.1f)))', fct, nlevels, fct, fct, fct, stats::runif(1, 1, 10)))

code_list$model_code <- c(code_list$model_code, sprintf("%s_effects[[i]]", fct))
} else if(any(c("factor", "character") %in% fct_class)) {
code_list$process_code <- c(code_list$process_code,
sprintf(' %s_effects <- lapply(1:%d, function(i) rnorm(%d, 0, %.1f))',
fct, nlevels, nfct, runif(1, 1, 10)))
fct, nlevels, nfct, stats::runif(1, 1, 10)))
code_list$model_code <- c(code_list$model_code, sprintf("%s_effects[[i]][index_levels(%s)]", fct, fct))
}
}
Expand Down
14 changes: 7 additions & 7 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -65,16 +65,16 @@ serve_table(des)
#> class student style exam
#> <U(4)> <U(120)> <T(2)> <T(3)>
#> <chr> <chr> <chr> <chr>
#> 1 class1 student001 traditional take-home
#> 2 class1 student002 traditional take-home
#> 3 class1 student003 traditional take-home
#> 4 class1 student004 traditional open-book
#> 1 class1 student001 traditional take-home
#> 2 class1 student002 traditional take-home
#> 3 class1 student003 traditional take-home
#> 4 class1 student004 traditional open-book
#> 5 class1 student005 traditional closed-book
#> 6 class1 student006 traditional closed-book
#> 7 class1 student007 traditional closed-book
#> 8 class1 student008 traditional open-book
#> 9 class1 student009 traditional open-book
#> 10 class1 student010 traditional open-book
#> 8 class1 student008 traditional open-book
#> 9 class1 student009 traditional open-book
#> 10 class1 student010 traditional open-book
#> # ℹ 110 more rows
```

Expand Down
24 changes: 6 additions & 18 deletions cran-comments.md
Original file line number Diff line number Diff line change
@@ -1,29 +1,17 @@
## Release summary

This update makes a number of bug fixes, addition of new features and
quality of life improvements as shown below.
This update makes fix a couple of bugs and small improvements as shown below.

Bug fixes

* Bug fix for export_design when no record factor exists
* Bug fix for order assignment
* Factor inputs were displayed integers. Fixed so this does not happen.
* S3 methods are exported.

Quality of life improvements
Improvements

* Format change for the title page in the export
* Change behaviour of `fct_attrs()` when levels supplied as numeric or vector
instead of `lvls()`.
* Change the print out of edibble table.
* Improve the assignment algorithm.
* If an edibble object is created from existing data, level edges are added when using `allot_trts()`.
* If a record factor is specified from existing data, the unit levels are added as attributes.

New features

* Added new functions `count_by()` and `split_by()`.
* Added ability to specify conditional treatment.
* The `simuluate_rcrds()` has now a facelift with delineation of the process specification to `simulate_process()`.
* `autofill_rcrds()` implemented.
* Added ability to add two designs by `+`.
* Ability to add metadata through design().

## R CMD check results

Expand Down
1 change: 0 additions & 1 deletion man/graph_input.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

60 changes: 30 additions & 30 deletions tests/testthat/_snaps/rcrds.md
Original file line number Diff line number Diff line change
Expand Up @@ -8,16 +8,16 @@
class student style exam exam_mark room
<U(4)> <U(120)> <T(2)> <T(3)> <R(120)> <R(4)>
<chr> <chr> <chr> <chr> <dbl> <dbl>
1 class1 student001 flipped take-home o o
2 class1 student002 flipped take-home o x
3 class1 student003 flipped closed-book o x
4 class1 student004 flipped take-home o x
5 class1 student005 flipped take-home o x
6 class1 student006 flipped take-home o x
7 class1 student007 flipped open-book o x
8 class1 student008 flipped open-book o x
9 class1 student009 flipped take-home o x
10 class1 student010 flipped closed-book o x
1 class1 student001 flipped closed-book o o
2 class1 student002 flipped take-home o x
3 class1 student003 flipped open-book o x
4 class1 student004 flipped closed-book o x
5 class1 student005 flipped closed-book o x
6 class1 student006 flipped open-book o x
7 class1 student007 flipped closed-book o x
8 class1 student008 flipped open-book o x
9 class1 student009 flipped take-home o x
10 class1 student010 flipped take-home o x
# i 110 more rows

---
Expand All @@ -44,16 +44,16 @@
class student style exam exam_mark room
<U(4)> <U(120)> <T(2)> <T(3)> <R(120)> <R(4)>
<chr> <chr> <chr> <chr> <dbl> <dbl>
1 class1 student001 flipped take-home o o
2 class1 student002 flipped take-home o x
3 class1 student003 flipped closed-book o x
4 class1 student004 flipped take-home o x
5 class1 student005 flipped take-home o x
6 class1 student006 flipped take-home o x
7 class1 student007 flipped open-book o x
8 class1 student008 flipped open-book o x
9 class1 student009 flipped take-home o x
10 class1 student010 flipped closed-book o x
1 class1 student001 flipped closed-book o o
2 class1 student002 flipped take-home o x
3 class1 student003 flipped open-book o x
4 class1 student004 flipped closed-book o x
5 class1 student005 flipped closed-book o x
6 class1 student006 flipped open-book o x
7 class1 student007 flipped closed-book o x
8 class1 student008 flipped open-book o x
9 class1 student009 flipped take-home o x
10 class1 student010 flipped take-home o x
# i 110 more rows

---
Expand Down Expand Up @@ -83,16 +83,16 @@
class student style exam exam_mark quiz1_mark quiz2_mark gender
<U(4)> <U(120)> <T(2)> <T(3)> <R(120)> <R(120)> <R(120)> <R(120)>
<chr> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
1 class1 student001 flipped take-home~ o o o o
2 class1 student002 flipped take-home~ o o o o
3 class1 student003 flipped closed-bo~ o o o o
4 class1 student004 flipped take-home~ o o o o
5 class1 student005 flipped take-home~ o o o o
6 class1 student006 flipped take-home~ o o o o
7 class1 student007 flipped open-book~ o o o o
8 class1 student008 flipped open-book~ o o o o
9 class1 student009 flipped take-home~ o o o o
10 class1 student010 flipped closed-bo~ o o o o
1 class1 student001 flipped closed-bo~ o o o o
2 class1 student002 flipped take-home o o o o
3 class1 student003 flipped open-book o o o o
4 class1 student004 flipped closed-bo~ o o o o
5 class1 student005 flipped closed-bo~ o o o o
6 class1 student006 flipped open-book o o o o
7 class1 student007 flipped closed-bo~ o o o o
8 class1 student008 flipped open-book o o o o
9 class1 student009 flipped take-home o o o o
10 class1 student010 flipped take-home o o o o
# i 110 more rows
# i 2 more variables: room <R(4)>, teacher <R(4)>

Expand Down
Loading

0 comments on commit bb9a831

Please sign in to comment.