Skip to content

Commit

Permalink
fix of fns
Browse files Browse the repository at this point in the history
  • Loading branch information
@matthewphamilton
matthewphamilton committed Nov 4, 2024
1 parent 5fb8b53 commit cb95404
Show file tree
Hide file tree
Showing 5 changed files with 59 additions and 62 deletions.
3 changes: 2 additions & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,14 +20,15 @@ Description: ready4use provides a set of tools for managing data for
of the ready4use package has been made available as part of the
process of testing and documenting the package. If you have any
questions, please contact the authors (matthew.hamilton1@monash.edu).
License: GPL-3 + file LICENSE
License: GPL-3
URL: https://ready4-dev.github.io/ready4use/,
https://github.com/ready4-dev/ready4use, https://www.ready4-dev.com/
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.3.2
Suggests:
knitr,
pkgload,
rmarkdown,
testthat
VignetteBuilder: knitr
Expand Down
8 changes: 6 additions & 2 deletions R/fn_make.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -79,8 +79,12 @@ make_imputed_distinct_cases <- function (data_tb, method_1L_chr = c("first", "sa
.x[which(!is.na(.x))[1]]
}
else {
ifelse(identical(which(!is.na(.x)), integer(0)),
.x[1], .x[which(!is.na(.x)) %>% sample(1)])
if (identical(which(!is.na(.x)), integer(0))) {
.x[1]
}
else {
.x[which(!is.na(.x)) %>% sample(1)]
}
})) %>% dplyr::ungroup()
distinct_tb <- distinct_tb %>% dplyr::filter(!(!!rlang::sym(uid_1L_chr) %in%
most_complete_tb[, uid_1L_chr][[1]])) %>% dplyr::bind_rows(most_complete_tb)
Expand Down
73 changes: 33 additions & 40 deletions data-raw/fns/add.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -143,8 +143,7 @@ add_fields_from_lup <- function(ds_tb,
}
add_files_to_dv <- function (files_tb, data_dir_rt_1L_chr = ".", ds_url_1L_chr,
key_1L_chr = Sys.getenv("DATAVERSE_KEY"),
server_1L_chr = Sys.getenv("DATAVERSE_SERVER"))
{
server_1L_chr = Sys.getenv("DATAVERSE_SERVER")){
lifecycle::deprecate_soft("0.0.0.9149", "add_files_to_dv()", "ready4::write_to_dv_from_tbl()")
ds_ls <- dataverse::get_dataset(ds_url_1L_chr)
is_draft_1L_lgl <- ds_ls$versionState == "DRAFT"
Expand All @@ -164,50 +163,44 @@ add_files_to_dv <- function (files_tb, data_dir_rt_1L_chr = ".", ds_url_1L_chr,
})
return(fl_ids_int)
}
add_from_lup_prototype <- function(data_tb,
arrange_1L_chr = character(0),
exclude_chr = character(0),
lup_prototype_tb = NULL,
match_var_nm_1L_chr = "UID_chr",
method_1L_chr = c("first", "sample"),
type_1L_chr = c("sequential", "batch", "self"),
vars_chr = character(0)){
add_from_lup_prototype <- function (data_tb, arrange_1L_chr = character(0), exclude_chr = character(0),
lup_prototype_tb = NULL, match_var_nm_1L_chr = "UID_chr",
method_1L_chr = c("first", "sample"), type_1L_chr = c("sequential",
"batch", "self"), vars_chr = character(0)){
method_1L_chr <- match.arg(method_1L_chr)
type_1L_chr <- match.arg(type_1L_chr)
if(type_1L_chr == "sequential"){
data_tb <- purrr::reduce(vars_chr,
.init = data_tb,
~ .x %>%
dplyr::left_join(lup_prototype_tb %>% dplyr::select(tidyselect::all_of(c(match_var_nm_1L_chr, .y))) %>% dplyr::distinct()))
if (type_1L_chr == "sequential") {
data_tb <- purrr::reduce(vars_chr, .init = data_tb, ~.x %>%
dplyr::left_join(lup_prototype_tb %>% dplyr::select(tidyselect::all_of(c(match_var_nm_1L_chr,
.y))) %>% dplyr::distinct()))
}
if(type_1L_chr == "batch"){
distinct_tb <- lup_prototype_tb %>% dplyr::select(tidyselect::all_of(c(match_var_nm_1L_chr,setdiff(setdiff(names(lup_prototype_tb), names(data_tb)), exclude_chr)))) %>%
make_imputed_distinct_cases(uid_1L_chr = match_var_nm_1L_chr,
method_1L_chr = method_1L_chr)
data_tb <- data_tb %>%
dplyr::left_join(distinct_tb)
if (type_1L_chr == "batch") {
distinct_tb <- lup_prototype_tb %>% dplyr::select(tidyselect::all_of(c(match_var_nm_1L_chr,
setdiff(setdiff(names(lup_prototype_tb), names(data_tb)),
exclude_chr)))) %>% make_imputed_distinct_cases(uid_1L_chr = match_var_nm_1L_chr,
method_1L_chr = method_1L_chr)
data_tb <- data_tb %>% dplyr::left_join(distinct_tb)
}
if(type_1L_chr == "self"){
if(identical(vars_chr, character(0))){
vars_chr <- setdiff(names(data_tb), c(match_var_nm_1L_chr, exclude_chr))
if (type_1L_chr == "self") {
if (identical(vars_chr, character(0))) {
vars_chr <- setdiff(names(data_tb), c(match_var_nm_1L_chr,
exclude_chr))
}
data_tb <- purrr::reduce(vars_chr,
.init = data_tb,
~ {
distinct_tb <- .x %>% dplyr::select(tidyselect::all_of(c(match_var_nm_1L_chr, .y))) %>%
make_imputed_distinct_cases(uid_1L_chr = match_var_nm_1L_chr,
method_1L_chr = method_1L_chr)
complete_tb <- .x %>%
dplyr::filter(!is.na(!!rlang::sym(.y)))
missing_tb <- .x %>%
dplyr::filter(is.na(!!rlang::sym(.y)))
imputed_tb <- missing_tb %>% dplyr::select(-tidyselect::all_of(.y)) %>%
dplyr::left_join(distinct_tb %>% dplyr::select(tidyselect::all_of(c(match_var_nm_1L_chr,.y))))
dplyr::bind_rows(complete_tb, imputed_tb)
}
)
# excuded_tb <-
data_tb <- purrr::reduce(vars_chr, .init = data_tb, ~{
distinct_tb <- .x %>% dplyr::select(tidyselect::all_of(c(match_var_nm_1L_chr,
.y))) %>%
make_imputed_distinct_cases(uid_1L_chr = match_var_nm_1L_chr,
method_1L_chr = method_1L_chr)
complete_tb <- .x %>% dplyr::filter(!is.na(!!rlang::sym(.y)))
missing_tb <- .x %>% dplyr::filter(is.na(!!rlang::sym(.y)))
imputed_tb <- missing_tb %>% dplyr::select(-tidyselect::all_of(.y)) %>%
dplyr::left_join(distinct_tb %>% dplyr::select(tidyselect::all_of(c(match_var_nm_1L_chr,
.y))))
dplyr::bind_rows(complete_tb, imputed_tb)
})
}
if(!identical(arrange_1L_chr, character(0)))
if (!identical(arrange_1L_chr, character(0)))
data_tb <- data_tb %>% dplyr::arrange(!!rlang::sym(arrange_1L_chr))
return(data_tb)
}
Expand Down
37 changes: 18 additions & 19 deletions data-raw/fns/make.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,27 +38,26 @@ make_correspondences <- function(dyad_ls, #manufacture method
}
return(correspondences_ls)
}
make_imputed_distinct_cases <- function(data_tb,
method_1L_chr = c("first","sample"),
uid_1L_chr = "UID_chr"){
make_imputed_distinct_cases <- function (data_tb, method_1L_chr = c("first", "sample"), uid_1L_chr = "UID_chr"){
method_1L_chr <- match.arg(method_1L_chr)
distinct_tb <- data_tb %>%
dplyr::filter(!is.na(!!rlang::sym(uid_1L_chr))) %>% dplyr::distinct()
most_complete_tb <- distinct_tb %>% dplyr::filter(!!rlang::sym(uid_1L_chr) %in% distinct_tb[,uid_1L_chr][[1]][duplicated(distinct_tb[,uid_1L_chr][[1]])]) %>%
distinct_tb <- data_tb %>% dplyr::filter(!is.na(!!rlang::sym(uid_1L_chr))) %>%
dplyr::distinct()
most_complete_tb <- distinct_tb %>% dplyr::filter(!!rlang::sym(uid_1L_chr) %in%
distinct_tb[, uid_1L_chr][[1]][duplicated(distinct_tb[,
uid_1L_chr][[1]])]) %>%
dplyr::group_by(!!rlang::sym(uid_1L_chr)) %>%
dplyr::summarise(dplyr::across(dplyr::everything(),
~
if(method_1L_chr=="first"){
.x[which(!is.na(.x))[1]]
}else{
ifelse(identical(which(!is.na(.x)), integer(0)), .x[1],.x[which(!is.na(.x)) %>% sample(1)])
}

#
)) %>%
dplyr::ungroup()
distinct_tb <- distinct_tb %>% dplyr::filter(!(!!rlang::sym(uid_1L_chr) %in% most_complete_tb[,uid_1L_chr][[1]])) %>%
dplyr::bind_rows(most_complete_tb)
dplyr::summarise(dplyr::across(dplyr::everything(), ~if (method_1L_chr == "first") {
.x[which(!is.na(.x))[1]]
}
else {
if(identical(which(!is.na(.x)), integer(0))){
.x[1]
}else{
.x[which(!is.na(.x)) %>% sample(1)]
}
})) %>% dplyr::ungroup()
distinct_tb <- distinct_tb %>% dplyr::filter(!(!!rlang::sym(uid_1L_chr) %in%
most_complete_tb[, uid_1L_chr][[1]])) %>% dplyr::bind_rows(most_complete_tb)
return(distinct_tb)
}
make_keep_lgl <- function(ds_tb,
Expand Down
Binary file modified man/figures/logo.png
View file
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.

0 comments on commit cb95404

Please sign in to comment.