Skip to content

Commit

Permalink
Merge branch 'main' into dev
Browse files Browse the repository at this point in the history
  • Loading branch information
@ecoisilva
ecoisilva committed Dec 11, 2024
2 parents 325d0ef + 3f37dbe commit 9777027
Show file tree
Hide file tree
Showing 10 changed files with 69 additions and 76 deletions.
1 change: 1 addition & 0 deletions .gitignore
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,3 +10,4 @@ docs
/dev/
movedesign.git
*_.new.png
/inst/golem-config.yml
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ Imports:
dplyr,
ellipse,
fontawesome,
gdtools,
ggiraph,
ggplot2,
ggpubr,
Expand All @@ -47,7 +48,6 @@ Imports:
shinyWidgets,
stats,
stringr,
gdtools,
terra,
tidyr,
utils,
Expand Down
1 change: 1 addition & 0 deletions R/fct_helpers.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1158,6 +1158,7 @@ simulate_gps <- function(data,
while (abs(err) > threshold && i < max_attempts) {

# Update the log-logistic function:

i <- i + 1
f <- update_f(x = newdata$frq_hrs, init)
y <- f$y
Expand Down
119 changes: 55 additions & 64 deletions R/mod_tab_ctsd.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2344,12 +2344,12 @@ mod_tab_ctsd_server <- function(id, rv) {
output$sdTable <- reactable::renderReactable({
req(rv$sd$tbl)

dt_sd <- rv$sd$tbl[, -1]

# need to add groups if rv$grouped
dt_sd <- dplyr::select(rv$sd$tbl, -seed)
if (!rv$grouped) dt_sd <- dplyr::select(dt_sd, -group)

nms <- list(
data = "Data:",
data = "Data",
group = "Group",
tauv = "\u03C4\u1D65",
dur = "Duration",
dti = "Interval",
Expand Down Expand Up @@ -2378,54 +2378,6 @@ mod_tab_ctsd_server <- function(id, rv) {
nms_ctsd,
nms_dist)

namedcolumns <- list(
data = reactable::colDef(
name = nms[["data"]]),
tauv = reactable::colDef(
minWidth = 80, name = nms[["tauv"]],
style = list(fontWeight = "bold")),
dur = reactable::colDef(
minWidth = 80, name = nms[["dur"]],
style = list(fontWeight = "bold")),
dti = reactable::colDef(
minWidth = 80, name = nms[["dti"]],
style = list(fontWeight = "bold")),
n = reactable::colDef(
name = nms[["n"]],
style = format_num,
format = reactable::colFormat(separators = TRUE,
digits = 0)),
N2 = reactable::colDef(
minWidth = 80, name = nms[["N2"]],
style = format_num,
format = reactable::colFormat(separators = TRUE,
digits = 1)),
ctsd = reactable::colDef(
minWidth = 120, name = nms[["ctsd"]]),
ctsd_err = reactable::colDef(
minWidth = 80, name = nms[["ctsd_err"]],
style = format_perc,
format = reactable::colFormat(percent = TRUE,
digits = 1)),
ctsd_err_min = reactable::colDef(
minWidth = 80, name = nms[["ctsd_err_min"]],
style = format_perc,
format = reactable::colFormat(percent = TRUE,
digits = 1)),
ctsd_err_max = reactable::colDef(
minWidth = 80, name = nms[["ctsd_err_max"]],
style = format_perc,
format = reactable::colFormat(percent = TRUE,
digits = 1)),
dist = reactable::colDef(
minWidth = 80, name = nms[["dist"]]),
dist_err = reactable::colDef(
minWidth = 80, name = nms[["dist_err"]],
style = format_perc,
format = reactable::colFormat(percent = TRUE,
digits = 1))
)

reactable::reactable(
data = dt_sd,
compact = TRUE,
Expand All @@ -2444,18 +2396,57 @@ mod_tab_ctsd_server <- function(id, rv) {
align = "center",
minWidth = 60),

columns = namedcolumns,
columnGroups = colgroups

) # end of reactable

}) # end of renderReactable // sdTable

# observe({
# rv$sd$tbl <- NULL
# }) %>% # end of observe,
# bindEvent(input$sdTable_clear)

columns = list(
data = reactable::colDef(
name = nms[["data"]]),
tauv = reactable::colDef(
minWidth = 80, name = nms[["tauv"]],
style = list(fontWeight = "bold")),
dur = reactable::colDef(
minWidth = 80, name = nms[["dur"]],
style = list(fontWeight = "bold")),
dti = reactable::colDef(
minWidth = 80, name = nms[["dti"]],
style = list(fontWeight = "bold")),
n = reactable::colDef(
name = nms[["n"]],
style = format_num,
format = reactable::colFormat(separators = TRUE,
digits = 0)),
N2 = reactable::colDef(
minWidth = 80, name = nms[["N2"]],
style = format_num,
format = reactable::colFormat(separators = TRUE,
digits = 1)),
ctsd = reactable::colDef(
minWidth = 120, name = nms[["ctsd"]]),
ctsd_err = reactable::colDef(
minWidth = 80, name = nms[["ctsd_err"]],
style = format_perc,
format = reactable::colFormat(percent = TRUE,
digits = 1)),
ctsd_err_min = reactable::colDef(
minWidth = 80, name = nms[["ctsd_err_min"]],
style = format_perc,
format = reactable::colFormat(percent = TRUE,
digits = 1)),
ctsd_err_max = reactable::colDef(
minWidth = 80, name = nms[["ctsd_err_max"]],
style = format_perc,
format = reactable::colFormat(percent = TRUE,
digits = 1)),
dist = reactable::colDef(
minWidth = 80, name = nms[["dist"]]),
dist_err = reactable::colDef(
minWidth = 80, name = nms[["dist_err"]],
style = format_perc,
format = reactable::colFormat(percent = TRUE,
digits = 1))),
columnGroups = colgroups)

}) %>% # end of renderReactable, "sdTable"
bindEvent(list(input$add_sd_table, rv$ctsdList))

# BLOCKS --------------------------------------------------------------
## Tracking device: ---------------------------------------------------
### Initial sampling design: ------------------------------------------
Expand Down
4 changes: 2 additions & 2 deletions R/mod_tab_data_select.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -798,7 +798,7 @@ mod_tab_data_select_server <- function(id, rv) {
msg_log(
style = "danger",
message = paste0(
"Verify ", msg_danger("range residency"), ","),
"Assuming ", msg_danger("range residency"), ","),
detail = paste("Assuming all selected individuals",
"are range resident."))
to_filter <- "^OU(?!f)|^OUF"
Expand All @@ -810,7 +810,6 @@ mod_tab_data_select_server <- function(id, rv) {
}

fit0 <- fit0[grep(to_filter, unlist(nm_mods), perl = TRUE)]
length(fit0)

if (length(fit0) == 0 && n_OUf == 0) {
msg_log(
Expand All @@ -826,6 +825,7 @@ mod_tab_data_select_server <- function(id, rv) {
rv$is_isotropic <- c("All" = TRUE)
if (rv$is_emulate) {

fit0[sapply(fit0, is.null)] <- NULL
meanfit0 <- tryCatch(
mean(x = fit0, sample = TRUE) %>%
suppressMessages() %>%
Expand Down
12 changes: 6 additions & 6 deletions R/mod_tab_data_upload.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -656,16 +656,16 @@ mod_tab_data_upload_server <- function(id, rv) {
}

parsedate::parse_date("1111-11-11") # loading function
tmp_dataset <- tryCatch(
out_dataset <- tryCatch(
ctmm::as.telemetry(out_dataset, timeformat = "auto"),
error = function(e) e) %>%
suppressMessages() %>%
suppressWarnings() %>%
quiet()

if (inherits(tmp_dataset, "error")) {
if (inherits(out_dataset, "error")) {
if (grepl("Could not identify location columns",
tmp_dataset)) {
out_dataset)) {

if (any(grepl("UTM", names(out_dataset)))) {
} else {
Expand Down Expand Up @@ -1118,7 +1118,7 @@ mod_tab_data_upload_server <- function(id, rv) {
msg_log(
style = "danger",
message = paste0(
"Verify ", msg_danger("range residency"), ","),
"Assuming ", msg_danger("range residency"), ","),
detail = paste("Assuming all selected individuals",
"are range resident."))
to_filter <- "^OU(?!f)|^OUF"
Expand All @@ -1130,7 +1130,6 @@ mod_tab_data_upload_server <- function(id, rv) {
}

fit0 <- fit0[grep(to_filter, unlist(nm_mods), perl = TRUE)]
length(fit0)

if (length(fit0) == 0 && n_OUf == 0) {
msg_log(
Expand All @@ -1146,8 +1145,9 @@ mod_tab_data_upload_server <- function(id, rv) {
rv$is_isotropic <- c("All" = TRUE)
if (rv$is_emulate) {

fit0[sapply(fit0, is.null)] <- NULL
meanfit0 <- tryCatch(
mean(x = fit0) %>%
mean(x = fit0, sample = TRUE) %>%
suppressMessages() %>%
suppressWarnings() %>%
quiet(),
Expand Down
2 changes: 1 addition & 1 deletion R/mod_tab_hrange.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1755,7 +1755,7 @@ mod_tab_hrange_server <- function(id, rv) {
req(rv$hr$tbl)

dt_hr <- dplyr::select(rv$hr$tbl, -seed)
if (!rv$grouped) dt_dev <- dplyr::select(dt_dev, -group)
if (!rv$grouped) dt_hr <- dplyr::select(dt_hr, -group)

nms <- list(
data = "Data",
Expand Down
2 changes: 1 addition & 1 deletion data-raw/fixrates.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -77,7 +77,7 @@ fixrates <- fixrates %>%
dti = 20 %#% "seconds",
common = "N", dti_scale = NA, dti_yn = "N") %>%
dplyr::add_row(dti_notes = "1 fix every 15 seconds",
dti = 20 %#% "seconds",
dti = 15 %#% "seconds",
common = "N", dti_scale = NA, dti_yn = "N") %>%
dplyr::add_row(dti_notes = "1 fix every 10 seconds",
dti = 10 %#% "seconds",
Expand Down
Binary file modified data/fixrates.rda
View file
Binary file not shown.
2 changes: 1 addition & 1 deletion inst/golem-config.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,4 +5,4 @@ default:
production:
app_prod: yes
dev:
golem_wd: C:/Users/simoes48/Desktop/R/04 Shiny/movedesign
golem_wd: !expr golem::pkg_path()

0 comments on commit 9777027

Please sign in to comment.