Skip to content

Commit e46e04e

Browse files
removed generics dpcy and added new fns
1 parent 4314595 commit e46e04e

23 files changed

Lines changed: 525 additions & 54 deletions

.Rbuildignore

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -55,3 +55,4 @@
5555
^Meta$
5656
^data-raw/FUNCTIONS\.R$
5757
^data-raw/WIP\.R$
58+
^data-raw/fns/bind\.R$

CITATION.cff

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,12 @@
11
cff-version: 1.2.0
22
message: "Matthew P Hamilton (2021). ready4: Implement Open Source Computational Models of Youth Mental Health
3-
Systems. Version 0.0.0.9098. Zenodo. https://doi.org/10.5281/zenodo.5606250"
3+
Systems. Version 0.0.0.9101. Zenodo. https://doi.org/10.5281/zenodo.5606250"
44
authors:
55
- family-names: "Hamilton"
66
given-names: "Matthew P"
77
title: "ready4: Implement Open Source Computational Models of Youth Mental Health
88
Systems"
9-
version: 0.0.0.9098
9+
version: 0.0.0.9101
1010
doi: 10.5281/zenodo.5606250
11-
date-released: 2022-08-03
11+
date-released: 2022-09-08
1212
url: "https://ready4-dev.github.io/ready4/"

DESCRIPTION

Lines changed: 0 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -27,8 +27,6 @@ Collate:
2727
'C4_Ready4Module.R'
2828
'C4_Ready4Private.R'
2929
'C4_Ready4Public.R'
30-
'add.R'
31-
'bind.R'
3230
'fn_add.R'
3331
'fn_bind.R'
3432
'fn_get.R'
@@ -39,11 +37,9 @@ Collate:
3937
'fn_transform.R'
4038
'fn_update.R'
4139
'fn_write.R'
42-
'get.R'
4340
'grp_generics.R'
4441
'imp_fns.R'
4542
'imp_mthds.R'
46-
'make.R'
4743
'mthd_authorSlot.R'
4844
'mthd_characterizeSlot.R'
4945
'mthd_depictSlot.R'
@@ -60,13 +56,7 @@ Collate:
6056
'mthd_renewSlot.R'
6157
'mthd_shareSlot.R'
6258
'pkg_ready4.R'
63-
'print.R'
6459
'ready4-package.R'
65-
'remove.R'
66-
'rowbind.R'
67-
'transform.R'
68-
'update.R'
69-
'write.R'
7060
Imports:
7161
assertthat,
7262
bib2df,

NAMESPACE

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ export(authorData)
1414
export(authorFunctions)
1515
export(authorReport)
1616
export(authorSlot)
17+
export(bind_tables_from_loc_files)
1718
export(characterize)
1819
export(characterizeSlot)
1920
export(depict)
@@ -27,6 +28,7 @@ export(get_badge_urls)
2728
export(get_badges_lup)
2829
export(get_cls_extensions)
2930
export(get_datasets_tb)
31+
export(get_digits_from_text)
3032
export(get_dv_fls_urls)
3133
export(get_examples)
3234
export(get_fl_id_from_dv_ls)
@@ -42,6 +44,7 @@ export(get_mthd_titles)
4244
export(get_r4_obj_slots)
4345
export(get_rds_from_dv)
4446
export(get_source_code_urls)
47+
export(get_table_from_loc_file)
4548
export(ingest)
4649
export(ingestSlot)
4750
export(investigate)
@@ -81,6 +84,7 @@ export(rowbind_all_tbs_in_r4_obj)
8184
export(rowbind_tbs_in_r4_obj)
8285
export(share)
8386
export(shareSlot)
87+
export(transform_chr_to_num)
8488
export(transform_cls_type_ls)
8589
export(update_pt_fn_args_ls)
8690
export(update_tb_r3)
@@ -94,6 +98,8 @@ export(write_fls_to_repo)
9498
export(write_from_tmp)
9599
export(write_new_dirs)
96100
export(write_new_files)
101+
export(write_obj_with_prompt)
102+
export(write_prj_outp_dirs)
97103
export(write_tb_to_csv)
98104
export(write_to_delete_dirs)
99105
export(write_to_delete_fls)
@@ -134,6 +140,7 @@ importFrom(dataverse,get_dataverse)
134140
importFrom(dataverse,get_file)
135141
importFrom(dataverse,publish_dataset)
136142
importFrom(dataverse,update_dataset_file)
143+
importFrom(dplyr,across)
137144
importFrom(dplyr,arrange)
138145
importFrom(dplyr,bind_rows)
139146
importFrom(dplyr,case_when)
@@ -143,6 +150,7 @@ importFrom(dplyr,inner_join)
143150
importFrom(dplyr,left_join)
144151
importFrom(dplyr,mutate)
145152
importFrom(dplyr,mutate_if)
153+
importFrom(dplyr,n)
146154
importFrom(dplyr,pull)
147155
importFrom(dplyr,rename)
148156
importFrom(dplyr,select)
@@ -183,6 +191,9 @@ importFrom(purrr,pmap_int)
183191
importFrom(purrr,reduce)
184192
importFrom(purrr,walk)
185193
importFrom(purrr,walk2)
194+
importFrom(readr,read_csv)
195+
importFrom(readxl,read_excel)
196+
importFrom(readxl,read_xlsx)
186197
importFrom(rlang,exec)
187198
importFrom(rlang,sym)
188199
importFrom(rvest,html_attr)
@@ -209,4 +220,5 @@ importFrom(tibble,as_tibble)
209220
importFrom(tibble,is_tibble)
210221
importFrom(tibble,tibble)
211222
importFrom(tools,Rd_db)
223+
importFrom(tools,file_ext)
212224
importFrom(utils,write.csv)

R/fn_bind.R

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
#' Bind tables from local files
2+
#' @description bind_tables_from_loc_files() is a Bind function that binds two objects together to create a composite object. Specifically, this function implements an algorithm to bind tables from local files. The function returns Table (an output object of multiple potential types).
3+
#' @param paths_chr Paths (a character vector)
4+
#' @param force_numeric_1L_lgl Force numeric (a logical vector of length one), Default: F
5+
#' @param force_tb_1L_lgl Force tibble (a logical vector of length one), Default: F
6+
#' @param heading_rows_1L_int Heading rows (an integer vector of length one), Default: 1
7+
#' @return Table (an output object of multiple potential types)
8+
#' @rdname bind_tables_from_loc_files
9+
#' @export
10+
#' @importFrom purrr map reduce
11+
#' @importFrom dplyr bind_rows
12+
#' @keywords internal
13+
bind_tables_from_loc_files <- function (paths_chr, force_numeric_1L_lgl = F, force_tb_1L_lgl = F,
14+
heading_rows_1L_int = 1L)
15+
{
16+
table_xx <- purrr::map(paths_chr, ~get_table_from_loc_file(.x,
17+
force_numeric_1L_lgl = force_numeric_1L_lgl, force_tb_1L_lgl = force_tb_1L_lgl,
18+
heading_rows_1L_int = heading_rows_1L_int)) %>% purrr::reduce(~dplyr::bind_rows(.x,
19+
.y))
20+
return(table_xx)
21+
}

R/fn_get.R

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -94,6 +94,20 @@ get_datasets_tb <- function (gh_repo_1L_chr = "ready4-dev/ready4", gh_tag_1L_chr
9494
endsWith("datasets_tb.RDS")]))
9595
return(datasets_tb)
9696
}
97+
#' Get digits from text
98+
#' @description get_digits_from_text() is a Get function that retrieves a pre-existing data object from memory, local file system or online repository. Specifically, this function implements an algorithm to get digits from text. Function argument text_1L_chr specifies the where to look for the required object. The function returns Digits (a character vector).
99+
#' @param text_1L_chr Text (a character vector of length one)
100+
#' @return Digits (a character vector)
101+
#' @rdname get_digits_from_text
102+
#' @export
103+
#' @keywords internal
104+
get_digits_from_text <- function (text_1L_chr)
105+
{
106+
fn_attribution_1L_chr <- "This function is based on: http://stla.github.io/stlapblog/posts/Numextract.html"
107+
digits_chr <- unlist(regmatches(text_1L_chr, gregexpr("[[:digit:]]+\\.*[[:digit:]]*",
108+
text_1L_chr)))
109+
return(digits_chr)
110+
}
97111
#' Get dataverse files urls
98112
#' @description get_dv_fls_urls() is a Get function that retrieves a pre-existing data object from memory, local file system or online repository. Specifically, this function implements an algorithm to get dataverse files urls. Function argument file_nms_chr specifies the where to look for the required object. The function returns Urls (a character vector).
99113
#' @param file_nms_chr File names (a character vector)
@@ -497,3 +511,36 @@ get_source_code_urls <- function (pkg_nm_1L_chr = "ready4", pkg_url_1L_chr = "ht
497511
urls_chr <- urls_chr[idxs_int]
498512
return(urls_chr)
499513
}
514+
#' Get table from local file
515+
#' @description get_table_from_loc_file() is a Get function that retrieves a pre-existing data object from memory, local file system or online repository. Specifically, this function implements an algorithm to get table from local file. Function argument path_1L_chr specifies the where to look for the required object. The function returns Table (an output object of multiple potential types).
516+
#' @param path_1L_chr Path (a character vector of length one)
517+
#' @param force_numeric_1L_lgl Force numeric (a logical vector of length one), Default: F
518+
#' @param force_tb_1L_lgl Force tibble (a logical vector of length one), Default: F
519+
#' @param heading_rows_1L_int Heading rows (an integer vector of length one), Default: 1
520+
#' @return Table (an output object of multiple potential types)
521+
#' @rdname get_table_from_loc_file
522+
#' @export
523+
#' @importFrom tools file_ext
524+
#' @importFrom readr read_csv
525+
#' @importFrom readxl read_excel read_xlsx
526+
#' @importFrom rlang exec
527+
#' @importFrom tibble as_tibble
528+
#' @importFrom dplyr slice n mutate across
529+
#' @keywords internal
530+
get_table_from_loc_file <- function (path_1L_chr, force_numeric_1L_lgl = F, force_tb_1L_lgl = F,
531+
heading_rows_1L_int = 1L)
532+
{
533+
file_type_1L_chr <- path_1L_chr %>% tools::file_ext()
534+
fn <- switch(file_type_1L_chr, csv = readr::read_csv, xls = readxl::read_excel,
535+
xlsx = readxl::read_xlsx, RDS = readRDS())
536+
table_xx <- rlang::exec(fn, path_1L_chr)
537+
if (force_tb_1L_lgl)
538+
table_xx <- tibble::as_tibble(table_xx)
539+
if (heading_rows_1L_int > 1L)
540+
table_xx <- table_xx %>% dplyr::slice(heading_rows_1L_int:dplyr::n())
541+
if (force_numeric_1L_lgl) {
542+
table_xx <- table_xx %>% dplyr::mutate(dplyr::across(where(is.character),
543+
~transform_chr_to_num(.x)))
544+
}
545+
return(table_xx)
546+
}

R/fn_transform.R

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,22 @@
1+
#' Transform character vector to numeric
2+
#' @description transform_chr_to_num() is a Transform function that edits an object in such a way that core object attributes - e.g. shape, dimensions, elements, type - are altered. Specifically, this function implements an algorithm to transform character vector to numeric. Function argument digits_chr specifies the object to be updated. The function returns Digits (an output object of multiple potential types).
3+
#' @param digits_chr Digits (a character vector)
4+
#' @return Digits (an output object of multiple potential types)
5+
#' @rdname transform_chr_to_num
6+
#' @export
7+
#' @keywords internal
8+
transform_chr_to_num <- function (digits_chr)
9+
{
10+
fn_attribution_1L_chr <- "This function is based on: https://stackoverflow.com/questions/24129124/how-to-determine-if-a-character-vector-is-a-valid-numeric-or-integer-vector"
11+
tfd_digits_chr <- suppressWarnings(as.character(digits_chr[!is.na(digits_chr)]))
12+
if (!identical(tfd_digits_chr, character(0)) & suppressWarnings(all(!is.na(as.numeric(tfd_digits_chr))))) {
13+
digits_xx <- as.numeric(as.character(digits_chr))
14+
}
15+
else {
16+
digits_xx <- digits_chr
17+
}
18+
return(digits_xx)
19+
}
120
#' Transform class type list
221
#' @description transform_cls_type_ls() is a Transform function that edits an object in such a way that core object attributes - e.g. shape, dimensions, elements, type - are altered. Specifically, this function implements an algorithm to transform class type list. Function argument cls_type_ls specifies the object to be updated. The function returns Tfmd class type (a list).
322
#' @param cls_type_ls Class type (a list)

R/fn_write.R

Lines changed: 83 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -263,6 +263,7 @@ write_fls_to_dv <- function (file_paths_chr, descriptions_chr = NULL, ds_url_1L_
263263
#' @description write_fls_to_repo() is a Write function that writes a file to a specified local directory. Specifically, this function implements an algorithm to write files to repository. The function returns Identities (an integer vector).
264264
#' @param paths_chr Paths (a character vector)
265265
#' @param descriptions_chr Descriptions (a character vector)
266+
#' @param consent_1L_chr Consent (a character vector of length one), Default: ''
266267
#' @param ds_url_1L_chr Dataset url (a character vector of length one), Default: character(0)
267268
#' @param ds_ls Dataset (a list), Default: NULL
268269
#' @param key_1L_chr Key (a character vector of length one), Default: Sys.getenv("DATAVERSE_KEY")
@@ -277,23 +278,32 @@ write_fls_to_dv <- function (file_paths_chr, descriptions_chr = NULL, ds_url_1L_
277278
#' @importFrom piggyback pb_list pb_new_release pb_upload
278279
#' @importFrom purrr walk
279280
#' @keywords internal
280-
write_fls_to_repo <- function (paths_chr, descriptions_chr, ds_url_1L_chr = character(0),
281+
write_fls_to_repo <- function (paths_chr, descriptions_chr, consent_1L_chr = "", ds_url_1L_chr = character(0),
281282
ds_ls = NULL, key_1L_chr = Sys.getenv("DATAVERSE_KEY"), server_1L_chr = Sys.getenv("DATAVERSE_SERVER"),
282283
piggyback_desc_1L_chr = "Documentation", piggyback_tag_1L_chr = "Documentation_0.0",
283284
piggyback_to_1L_chr = character(0), prerelease_1L_lgl = T)
284285
{
285286
if (!identical(piggyback_to_1L_chr, character(0))) {
286-
releases_df <- piggyback::pb_list(repo = piggyback_to_1L_chr)
287-
if (!piggyback_tag_1L_chr %in% releases_df$tag)
288-
piggyback::pb_new_release(piggyback_to_1L_chr, tag = piggyback_tag_1L_chr,
289-
body = piggyback_desc_1L_chr, prerelease = prerelease_1L_lgl)
290-
purrr::walk(paths_chr, ~{
291-
if (file.exists(.x)) {
292-
piggyback::pb_upload(.x, repo = piggyback_to_1L_chr,
293-
tag = piggyback_tag_1L_chr)
294-
}
295-
})
296-
ids_int <- NULL
287+
if (!consent_1L_chr %in% c("Y", "N")) {
288+
consent_1L_chr <- make_prompt(prompt_1L_chr = paste0("Do you confirm ('Y') that you want to write the file ",
289+
ifelse(length(paths_chr) > 1, "s", ""), " to release ",
290+
piggyback_tag_1L_chr, " in ", piggyback_to_1L_chr),
291+
options_chr = c("Y", "N"), force_from_opts_1L_chr = T)
292+
}
293+
if (consent_1L_chr %in% c("Y")) {
294+
releases_df <- piggyback::pb_list(repo = piggyback_to_1L_chr)
295+
if (!piggyback_tag_1L_chr %in% releases_df$tag)
296+
piggyback::pb_new_release(piggyback_to_1L_chr,
297+
tag = piggyback_tag_1L_chr, body = piggyback_desc_1L_chr,
298+
prerelease = prerelease_1L_lgl)
299+
purrr::walk(paths_chr, ~{
300+
if (file.exists(.x)) {
301+
piggyback::pb_upload(.x, repo = piggyback_to_1L_chr,
302+
tag = piggyback_tag_1L_chr)
303+
}
304+
})
305+
ids_int <- NULL
306+
}
297307
}
298308
else {
299309
if (!identical(character(0), ds_url_1L_chr))
@@ -449,6 +459,67 @@ write_new_files <- function (paths_chr, custom_write_ls = NULL, fl_nm_1L_chr = N
449459
}
450460
}
451461
}
462+
#' Write object with prompt
463+
#' @description write_obj_with_prompt() is a Write function that writes a file to a specified local directory. Specifically, this function implements an algorithm to write object with prompt. The function is called for its side effects and does not return a value. WARNING: This function writes R scripts to your local environment. Make sure to only use if you want this behaviour
464+
#' @param object_xx Object (an output object of multiple potential types)
465+
#' @param obj_nm_1L_chr Object name (a character vector of length one)
466+
#' @param outp_dir_1L_chr Output directory (a character vector of length one)
467+
#' @param consent_1L_chr Consent (a character vector of length one), Default: ''
468+
#' @return NULL
469+
#' @rdname write_obj_with_prompt
470+
#' @export
471+
#' @importFrom rlang exec
472+
#' @keywords internal
473+
write_obj_with_prompt <- function (object_xx, obj_nm_1L_chr, outp_dir_1L_chr, consent_1L_chr = "")
474+
{
475+
path_1L_chr <- paste0(outp_dir_1L_chr, "/", obj_nm_1L_chr,
476+
".RDS")
477+
custom_write_ls = list(fn = saveRDS, args_ls = list(object = object_xx,
478+
file = path_1L_chr))
479+
if (!consent_1L_chr %in% c("Y", "N")) {
480+
write_new_files(path_1L_chr, custom_write_ls = custom_write_ls)
481+
}
482+
else {
483+
if (consent_1L_chr == "Y")
484+
rlang::exec(custom_write_ls$fn, !!!custom_write_ls$args_ls)
485+
}
486+
}
487+
#' Write project output directories
488+
#' @description write_prj_outp_dirs() is a Write function that writes a file to a specified local directory. Specifically, this function implements an algorithm to write project output directories. The function returns New paths (a list).
489+
#' @param prj_dirs_chr Project directories (a character vector)
490+
#' @param output_data_dir_1L_chr Output data directory (a character vector of length one)
491+
#' @param consent_1L_chr Consent (a character vector of length one), Default: ''
492+
#' @param paths_ls Paths (a list), Default: NULL
493+
#' @return New paths (a list)
494+
#' @rdname write_prj_outp_dirs
495+
#' @export
496+
#' @importFrom purrr walk keep
497+
#' @importFrom stats setNames
498+
#' @keywords internal
499+
write_prj_outp_dirs <- function (prj_dirs_chr, output_data_dir_1L_chr, consent_1L_chr = "",
500+
paths_ls = NULL)
501+
{
502+
paths_chr <- paste0(paste0(output_data_dir_1L_chr, "/"),
503+
prj_dirs_chr)
504+
if (!consent_1L_chr %in% c("Y", "N")) {
505+
write_new_dirs(paths_chr)
506+
}
507+
else {
508+
if (consent_1L_chr %in% c("Y")) {
509+
new_paths_ls <- paths_chr %>% purrr::walk(~{
510+
dir.create(.x)
511+
})
512+
}
513+
else {
514+
message("Write request cancelled - no new directories created")
515+
}
516+
}
517+
new_paths_ls <- as.list(paths_chr) %>% stats::setNames(prj_dirs_chr) %>%
518+
purrr::keep(dir.exists)
519+
if (!is.null(paths_ls))
520+
new_paths_ls <- append(new_paths_ls, paths_ls)
521+
return(new_paths_ls)
522+
}
452523
#' Write tibble to comma separated variables file
453524
#' @description write_tb_to_csv() is a Write function that writes a file to a specified local directory. Specifically, this function implements an algorithm to write tibble to comma separated variables file. The function is called for its side effects and does not return a value. WARNING: This function writes R scripts to your local environment. Make sure to only use if you want this behaviour
454525
#' @param tbs_r4 Tibbles (a ready4 S4)

_pkgdown.yml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ home:
1010
href: https://github.com/ready4-dev/ready4/releases/download/Documentation_0.0/ready4_User.pdf
1111
- text: Manual - Developer (PDF)
1212
href: https://github.com/ready4-dev/ready4/releases/download/Documentation_0.0/ready4_Developer.pdf
13-
- text: readyforwhatsnext
13+
- text: Framework
1414
href: https://www.ready4-dev.com/
1515
development:
1616
mode: auto

data-raw/DATASET.R

Lines changed: 22 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,28 @@ x <- ready4fun::make_pkg_desc_ls(pkg_title_1L_chr = "Implement Open Source Compu
4646
## Do you confirm ('Y') that you want to delete these files: [Y|N]
4747
## After doing so, all other such prompts should be answered in the affirmative.
4848
x <- write_self_srvc_pkg(x)
49-
# ADD DOI OVERRIDE FOR RELEASES
49+
#
50+
#library(ready4)
51+
share.ready4fun_manifest <- function(x, # Move to ready4fun
52+
gh_prerelease_1L_lgl = T,
53+
gh_repo_desc_1L_chr = "Supplementary Files",
54+
gh_tag_1L_chr = "Documentation_0.0"){
55+
fns_dmt_tb <- x$subsequent_ls$fns_dmt_tb
56+
gh_repo_1L_chr <- x$subsequent_ls$piggyback_to_1L_chr
57+
58+
fns_dmt_tb <- fns_dmt_tb %>% dplyr::mutate(file_nm_chr = basename(file_nm_chr))
59+
ready4::write_env_objs_to_dv(env_objects_ls = list(fns_dmt_tb = fns_dmt_tb),
60+
descriptions_chr = NULL,
61+
ds_url_1L_chr = character(0),
62+
piggyback_desc_1L_chr = gh_repo_desc_1L_chr,
63+
piggyback_tag_1L_chr = gh_tag_1L_chr,
64+
piggyback_to_1L_chr = gh_repo_1L_chr,
65+
prerelease_1L_lgl = gh_prerelease_1L_lgl)
66+
}
67+
share.ready4fun_manifest(x)
68+
69+
70+
# ADD DOI OVERRIDE FOR RELEASES
5071
#
5172
# write_extensions() # Required only if extensions have changed since last build
5273
# write_badges() # Only run if the ready4fun badges table has been updated.

0 commit comments

Comments
 (0)