Skip to content

Commit 22c48f9

Browse files
Copilotfelix-andreas
Copilot
and
felix-andreas
committed
Add three complex formatter test cases to misc.R.test
Co-authored-by: felix-andreas <[email protected]>
1 parent ccc0b9d commit 22c48f9

File tree

4 files changed

+449
-0
lines changed

4 files changed

+449
-0
lines changed

‎crates/roughly/tests/format/misc.R.test‎

Lines changed: 218 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -36,3 +36,221 @@ fred <- FALSE
3636
plugh <- NULL
3737
xyzzy <- Inf
3838
thud <- NaN
39+
40+
#==== complex_data_manipulation
41+
#---- nested_data_pipeline
42+
# Complex data manipulation with nested function calls and pipeline operators
43+
library(dplyr)
44+
library(tidyr)
45+
46+
result <- raw_data %>%
47+
filter(
48+
!is.na(value) &
49+
year >= 2020 &
50+
category %in% c("A", "B", "C")
51+
) %>%
52+
group_by(
53+
region,
54+
category,
55+
quarter = paste0("Q", ceiling(month(date) / 3))
56+
) %>%
57+
summarise(
58+
mean_value = mean(value, na.rm = TRUE),
59+
median_value = median(value, na.rm = TRUE),
60+
count = n(),
61+
.groups = "drop"
62+
) %>%
63+
pivot_wider(
64+
names_from = quarter,
65+
values_from = c(mean_value, median_value, count),
66+
names_sep = "_"
67+
) %>%
68+
mutate(
69+
total_mean = rowMeans(
70+
select(., starts_with("mean_value")),
71+
na.rm = TRUE
72+
),
73+
variance_ratio = case_when(
74+
total_mean > 100 ~ "high",
75+
total_mean > 50 ~ "medium",
76+
TRUE ~ "low"
77+
)
78+
) %>%
79+
arrange(desc(total_mean))
80+
81+
#==== statistical_modeling
82+
#---- complex_regression_analysis
83+
# Advanced statistical modeling with complex nested expressions
84+
library(lme4)
85+
library(broom.mixed)
86+
87+
# Complex mixed-effects model with nested grouping
88+
model <- lmer(
89+
response ~
90+
poly(time, 3) * treatment +
91+
I(log(baseline_measure + 1)) +
92+
scale(covariate1) +
93+
I(covariate2^2) +
94+
interaction_term +
95+
(1 + time | subject_id) +
96+
(1 | site_id/clinic_id),
97+
data = analysis_data,
98+
weights = 1 / sqrt(variance_weights),
99+
control = lmerControl(
100+
optimizer = "bobyqa",
101+
optCtrl = list(maxfun = 100000),
102+
check.conv.singular = .makeCC(
103+
action = "warning",
104+
tol = 1e-4
105+
)
106+
)
107+
)
108+
109+
# Complex post-hoc analysis with nested comparisons
110+
contrasts_result <- emmeans(
111+
model,
112+
pairwise ~ treatment | time,
113+
at = list(
114+
time = c(0, 30, 60, 90),
115+
baseline_measure = mean(analysis_data$baseline_measure, na.rm = TRUE)
116+
),
117+
adjust = "tukey"
118+
) %>%
119+
map_dfr(
120+
~ .x %>%
121+
as_tibble() %>%
122+
mutate(
123+
effect_size = estimate / sqrt(
124+
sum(residuals(model)^2) / df.residual(model)
125+
),
126+
significant = ifelse(
127+
p.value < 0.05,
128+
ifelse(p.value < 0.01, "**", "*"),
129+
"ns"
130+
)
131+
),
132+
.id = "comparison_type"
133+
)
134+
135+
#==== complex_control_flow
136+
#---- nested_error_handling_validation
137+
# Complex control flow with nested conditionals and error handling
138+
process_data_batch <- function(data_list, config = list()) {
139+
tryCatch({
140+
# Validate inputs with nested conditions
141+
if (is.null(data_list) || length(data_list) == 0) {
142+
stop("Input data_list cannot be NULL or empty")
143+
}
144+
145+
for (i in seq_along(data_list)) {
146+
current_data <- data_list[[i]]
147+
148+
# Nested validation with complex conditions
149+
if (!is.data.frame(current_data)) {
150+
warning(paste("Element", i, "is not a data frame, skipping"))
151+
next
152+
}
153+
154+
required_cols <- c("id", "timestamp", "value")
155+
missing_cols <- setdiff(required_cols, names(current_data))
156+
157+
if (length(missing_cols) > 0) {
158+
if (config$strict_mode %||% FALSE) {
159+
stop(paste(
160+
"Missing required columns in element", i, ":",
161+
paste(missing_cols, collapse = ", ")
162+
))
163+
} else {
164+
warning(paste(
165+
"Missing columns in element", i, ", filling with defaults:",
166+
paste(missing_cols, collapse = ", ")
167+
))
168+
169+
# Complex default value assignment
170+
for (col in missing_cols) {
171+
current_data[[col]] <- switch(col,
172+
"id" = paste0("auto_", seq_len(nrow(current_data))),
173+
"timestamp" = rep(Sys.time(), nrow(current_data)),
174+
"value" = rep(NA_real_, nrow(current_data)),
175+
rep(NA, nrow(current_data))
176+
)
177+
}
178+
}
179+
}
180+
181+
# Complex data transformation with nested operations
182+
processed <- current_data %>%
183+
filter(!is.na(value)) %>%
184+
mutate(
185+
normalized_value = case_when(
186+
is.finite(value) && value >= 0 ~
187+
(value - min(value, na.rm = TRUE)) /
188+
(max(value, na.rm = TRUE) - min(value, na.rm = TRUE)),
189+
is.finite(value) && value < 0 ~
190+
pmax(-1, pmin(0, value / abs(min(value, na.rm = TRUE)))),
191+
TRUE ~ NA_real_
192+
),
193+
quality_flag = ifelse(
194+
abs(scale(value)[, 1]) > 3,
195+
"outlier",
196+
ifelse(
197+
is.na(value) || !is.finite(value),
198+
"invalid",
199+
"valid"
200+
)
201+
)
202+
) %>%
203+
arrange(timestamp, id)
204+
205+
data_list[[i]] <- processed
206+
}
207+
208+
# Final aggregation with complex grouping
209+
final_result <- bind_rows(data_list, .id = "batch_id") %>%
210+
group_by(batch_id) %>%
211+
summarise(
212+
total_records = n(),
213+
valid_records = sum(quality_flag == "valid", na.rm = TRUE),
214+
mean_value = mean(normalized_value, na.rm = TRUE),
215+
outlier_rate = mean(quality_flag == "outlier", na.rm = TRUE),
216+
completeness = mean(!is.na(normalized_value)),
217+
.groups = "drop"
218+
) %>%
219+
mutate(
220+
quality_score = (
221+
0.4 * completeness +
222+
0.3 * (1 - outlier_rate) +
223+
0.3 * pmin(1, valid_records / total_records)
224+
),
225+
grade = case_when(
226+
quality_score >= 0.9 ~ "A",
227+
quality_score >= 0.8 ~ "B",
228+
quality_score >= 0.7 ~ "C",
229+
quality_score >= 0.6 ~ "D",
230+
TRUE ~ "F"
231+
)
232+
)
233+
234+
return(final_result)
235+
236+
}, error = function(e) {
237+
if (config$debug_mode %||% FALSE) {
238+
cat("Debug info - Error occurred at:",
239+
format(Sys.time(), "%Y-%m-%d %H:%M:%S"), "\n")
240+
print(str(data_list))
241+
}
242+
243+
stop(paste("Error in process_data_batch:", e$message))
244+
245+
}, warning = function(w) {
246+
if (config$verbose %||% TRUE) {
247+
message("Warning in process_data_batch: ", w$message)
248+
}
249+
invokeRestart("muffleWarning")
250+
251+
}, finally = {
252+
if (config$cleanup %||% TRUE) {
253+
gc() # Force garbage collection
254+
}
255+
})
256+
}

‎crates/roughly/tests/snapshots/test_format__complex_control_flow__nested_error_handling_validation.snap‎

Lines changed: 134 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,134 @@
1+
---
2+
source: crates/roughly/tests/test_format.rs
3+
expression: code
4+
---
5+
# Complex control flow with nested conditionals and error handling
6+
process_data_batch <- function(data_list, config = list()) {
7+
tryCatch(
8+
{
9+
# Validate inputs with nested conditions
10+
if (is.null(data_list) || length(data_list) == 0) {
11+
stop("Input data_list cannot be NULL or empty")
12+
}
13+
14+
for (i in seq_along(data_list)) {
15+
current_data <- data_list[[i]]
16+
17+
# Nested validation with complex conditions
18+
if (!is.data.frame(current_data)) {
19+
warning(paste("Element", i, "is not a data frame, skipping"))
20+
next
21+
}
22+
23+
required_cols <- c("id", "timestamp", "value")
24+
missing_cols <- setdiff(required_cols, names(current_data))
25+
26+
if (length(missing_cols) > 0) {
27+
if (config$strict_mode %||% FALSE) {
28+
stop(paste(
29+
"Missing required columns in element",
30+
i,
31+
":",
32+
paste(missing_cols, collapse = ", ")
33+
))
34+
} else {
35+
warning(paste(
36+
"Missing columns in element",
37+
i,
38+
", filling with defaults:",
39+
paste(missing_cols, collapse = ", ")
40+
))
41+
42+
# Complex default value assignment
43+
for (col in missing_cols) {
44+
current_data[[col]] <- switch(
45+
col,
46+
"id" = paste0("auto_", seq_len(nrow(current_data))),
47+
"timestamp" = rep(Sys.time(), nrow(current_data)),
48+
"value" = rep(NA_real_, nrow(current_data)),
49+
rep(NA, nrow(current_data))
50+
)
51+
}
52+
}
53+
}
54+
55+
# Complex data transformation with nested operations
56+
processed <- current_data %>%
57+
filter(!is.na(value)) %>%
58+
mutate(
59+
normalized_value = case_when(
60+
is.finite(value) && value >= 0 ~
61+
(value - min(value, na.rm = TRUE)) /
62+
(max(value, na.rm = TRUE) - min(value, na.rm = TRUE)),
63+
is.finite(value) && value < 0 ~
64+
pmax(-1, pmin(0, value / abs(min(value, na.rm = TRUE)))),
65+
TRUE ~ NA_real_
66+
),
67+
quality_flag = ifelse(
68+
abs(scale(value)[, 1]) > 3,
69+
"outlier",
70+
ifelse(
71+
is.na(value) || !is.finite(value),
72+
"invalid",
73+
"valid"
74+
)
75+
)
76+
) %>%
77+
arrange(timestamp, id)
78+
79+
data_list[[i]] <- processed
80+
}
81+
82+
# Final aggregation with complex grouping
83+
final_result <- bind_rows(data_list, .id = "batch_id") %>%
84+
group_by(batch_id) %>%
85+
summarise(
86+
total_records = n(),
87+
valid_records = sum(quality_flag == "valid", na.rm = TRUE),
88+
mean_value = mean(normalized_value, na.rm = TRUE),
89+
outlier_rate = mean(quality_flag == "outlier", na.rm = TRUE),
90+
completeness = mean(!is.na(normalized_value)),
91+
.groups = "drop"
92+
) %>%
93+
mutate(
94+
quality_score = (
95+
0.4 * completeness +
96+
0.3 * (1 - outlier_rate) +
97+
0.3 * pmin(1, valid_records / total_records)
98+
),
99+
grade = case_when(
100+
quality_score >= 0.9 ~ "A",
101+
quality_score >= 0.8 ~ "B",
102+
quality_score >= 0.7 ~ "C",
103+
quality_score >= 0.6 ~ "D",
104+
TRUE ~ "F"
105+
)
106+
)
107+
108+
return(final_result)
109+
},
110+
error = function(e) {
111+
if (config$debug_mode %||% FALSE) {
112+
cat(
113+
"Debug info - Error occurred at:",
114+
format(Sys.time(), "%Y-%m-%d %H:%M:%S"),
115+
"\n"
116+
)
117+
print(str(data_list))
118+
}
119+
120+
stop(paste("Error in process_data_batch:", e$message))
121+
},
122+
warning = function(w) {
123+
if (config$verbose %||% TRUE) {
124+
message("Warning in process_data_batch: ", w$message)
125+
}
126+
invokeRestart("muffleWarning")
127+
},
128+
finally = {
129+
if (config$cleanup %||% TRUE) {
130+
gc() # Force garbage collection
131+
}
132+
}
133+
)
134+
}

‎crates/roughly/tests/snapshots/test_format__complex_data_manipulation__nested_data_pipeline.snap‎

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
---
2+
source: crates/roughly/tests/test_format.rs
3+
expression: code
4+
---
5+
# Complex data manipulation with nested function calls and pipeline operators
6+
library(dplyr)
7+
library(tidyr)
8+
9+
result <- raw_data %>%
10+
filter(
11+
!is.na(value) &
12+
year >= 2020 &
13+
category %in% c("A", "B", "C")
14+
) %>%
15+
group_by(
16+
region,
17+
category,
18+
quarter = paste0("Q", ceiling(month(date) / 3))
19+
) %>%
20+
summarise(
21+
mean_value = mean(value, na.rm = TRUE),
22+
median_value = median(value, na.rm = TRUE),
23+
count = n(),
24+
.groups = "drop"
25+
) %>%
26+
pivot_wider(
27+
names_from = quarter,
28+
values_from = c(mean_value, median_value, count),
29+
names_sep = "_"
30+
) %>%
31+
mutate(
32+
total_mean = rowMeans(
33+
select(., starts_with("mean_value")),
34+
na.rm = TRUE
35+
),
36+
variance_ratio = case_when(
37+
total_mean > 100 ~ "high",
38+
total_mean > 50 ~ "medium",
39+
TRUE ~ "low"
40+
)
41+
) %>%
42+
arrange(desc(total_mean))

0 commit comments

Comments
 (0)