Skip to content

Commit a653451

Browse files
strengejackestrengejacke
committed
code readability
1 parent 7bd1744 commit a653451

1 file changed

Lines changed: 119 additions & 135 deletions

File tree

‎R/plot.check_model.R‎

Lines changed: 119 additions & 135 deletions
Original file line numberDiff line numberDiff line change
@@ -96,199 +96,183 @@ plot.see_check_model <- function(
9696
colors <- unname(colors)
9797

9898
# 3. Build plot panels -------------------------------------------------------
99+
100+
# Define common arguments for plot functions to ensure consistency
101+
common_args <- list(
102+
theme = theme,
103+
base_size = base_size,
104+
size_title = size_title,
105+
size_axis_title = size_axis_title,
106+
size_point = size_point,
107+
linewidth = linewidth
108+
)
109+
99110
# Each block below checks if the specific diagnostic test is requested in 'check'
100111
# and if the corresponding data exists in 'x'. If so, it generates the plot.
101112

102113
# Posterior Predictive Check
103114
if (.should_plot(x, check, "PP_CHECK", "pp_check")) {
104115
x$NORM <- NULL # Prevent duplicate normality plotting if PP_CHECK is used
105-
p$PP_CHECK <- plot.see_performance_pp_check(
106-
x$PP_CHECK,
107-
theme = theme,
108-
linewidth = linewidth,
109-
size_point = size_point,
110-
base_size = base_size,
111-
size_axis_title = size_axis_title,
112-
size_title = size_title,
113-
type = type,
114-
check_model = TRUE,
115-
adjust_legend = TRUE,
116-
colors = colors[1:2]
116+
fun_args <- c(
117+
list(x$PP_CHECK),
118+
common_args,
119+
list(
120+
type = type,
121+
check_model = TRUE,
122+
adjust_legend = TRUE,
123+
colors = colors[1:2]
124+
)
117125
)
126+
p$PP_CHECK <- do.call(plot.see_performance_pp_check, fun_args)
118127
}
119128

120129
# Non-Constant Error Variance (Linearity/Homoscedasticity)
121130
if (.should_plot(x, check, "NCV", c("ncv", "linearity"))) {
122-
p$NCV <- .plot_diag_linearity(
123-
x$NCV,
124-
size_point = size_point,
125-
linewidth = linewidth,
126-
alpha_level = alpha_level,
127-
theme = theme,
128-
base_size = base_size,
129-
size_axis_title = size_axis_title,
130-
size_title = size_title,
131-
colors = colors,
132-
alpha_dot = alpha_dot,
133-
show_dots = show_dots,
134-
show_ci = show_ci,
135-
maximum_dots = max_dots
131+
fun_args <- c(
132+
list(x$NCV),
133+
common_args,
134+
list(
135+
alpha_level = alpha_level,
136+
colors = colors,
137+
alpha_dot = alpha_dot,
138+
show_dots = show_dots,
139+
show_ci = show_ci,
140+
maximum_dots = max_dots
141+
)
136142
)
143+
p$NCV <- do.call(.plot_diag_linearity, fun_args)
137144
}
138145

139146
# Binned Residuals
140147
if (.should_plot(x, check, "BINNED_RESID", "binned_residuals")) {
141148
x$HOMOGENEITY <- NULL # Prevent conflict with standard homogeneity plot
142-
p$BINNED_RESID <- plot.see_binned_residuals(
143-
x$BINNED_RESID,
144-
theme = theme,
145-
base_size = base_size,
146-
size_axis_title = size_axis_title,
147-
size_title = size_title,
148-
colors = colors[c(2, 3, 1)],
149-
adjust_legend = TRUE,
150-
check_model = TRUE,
151-
show_dots = show_dots
149+
fun_args <- c(
150+
list(x$BINNED_RESID),
151+
common_args,
152+
list(
153+
colors = colors[c(2, 3, 1)],
154+
adjust_legend = TRUE,
155+
check_model = TRUE,
156+
show_dots = show_dots
157+
)
152158
)
159+
p$BINNED_RESID <- do.call(plot.see_binned_residuals, fun_args)
153160
}
154161

155162
# Overdispersion
156163
if (.should_plot(x, check, "OVERDISPERSION", "overdispersion")) {
157-
p$OVERDISPERSION <- .plot_diag_overdispersion(
158-
x$OVERDISPERSION,
159-
theme = theme,
160-
base_size = base_size,
161-
size_axis_title = size_axis_title,
162-
size_title = size_title,
163-
colors = colors[c(1, 2)],
164-
linewidth = linewidth,
165-
type = overdisp_type
164+
fun_args <- c(
165+
list(x$OVERDISPERSION),
166+
common_args,
167+
list(colors = colors[c(1, 2)], type = overdisp_type)
166168
)
169+
p$OVERDISPERSION <- do.call(.plot_diag_overdispersion, fun_args)
167170
}
168171

169172
# Homogeneity of Variance
170173
if (.should_plot(x, check, "HOMOGENEITY", "homogeneity")) {
171-
p$HOMOGENEITY <- .plot_diag_homogeneity(
172-
x$HOMOGENEITY,
173-
size_point = size_point,
174-
linewidth = linewidth,
175-
alpha_level = alpha_level,
176-
theme = theme,
177-
base_size = base_size,
178-
size_axis_title = size_axis_title,
179-
size_title = size_title,
180-
colors = colors,
181-
alpha_dot = alpha_dot,
182-
show_dots = show_dots,
183-
show_ci = show_ci,
184-
maximum_dots = max_dots
174+
fun_args <- c(
175+
list(x$HOMOGENEITY),
176+
common_args,
177+
list(
178+
alpha_level = alpha_level,
179+
colors = colors,
180+
alpha_dot = alpha_dot,
181+
show_dots = show_dots,
182+
show_ci = show_ci,
183+
maximum_dots = max_dots
184+
)
185185
)
186+
p$HOMOGENEITY <- do.call(.plot_diag_homogeneity, fun_args)
186187
}
187188

188189
# Influential Observations (Outliers)
189190
if (.should_plot(x, check, "INFLUENTIAL", c("outliers", "influential"))) {
190-
p$OUTLIERS <- .plot_diag_outliers_dots(
191-
x$INFLUENTIAL,
192-
show_labels = show_labels,
193-
size_text = size_text,
194-
linewidth = linewidth,
195-
size_point = size_point,
196-
theme = theme,
197-
size_axis_title = size_axis_title,
198-
size_title = size_title,
199-
base_size = base_size,
200-
colors = colors,
201-
alpha_dot = alpha_dot,
202-
show_dots = show_dots,
203-
maximum_dots = max_dots
191+
fun_args <- c(
192+
list(x$INFLUENTIAL),
193+
common_args,
194+
list(
195+
show_labels = show_labels,
196+
size_text = size_text,
197+
colors = colors,
198+
alpha_dot = alpha_dot,
199+
show_dots = show_dots,
200+
maximum_dots = max_dots
201+
)
204202
)
203+
p$OUTLIERS <- do.call(.plot_diag_outliers_dots, fun_args)
205204
}
206205

207206
# Variance Inflation Factor (Multicollinearity)
208207
if (.should_plot(x, check, "VIF", "vif")) {
209-
p$VIF <- .plot_diag_vif(
210-
x$VIF,
211-
size_point = 1.5 * size_point,
212-
linewidth = linewidth,
213-
theme = theme,
214-
base_size = base_size,
215-
size_axis_title = size_axis_title,
216-
size_title = size_title,
217-
colors = colors,
218-
ci_data = attributes(x$VIF)$CI,
219-
is_check_model = TRUE
208+
fun_args <- c(
209+
list(x$VIF),
210+
common_args,
211+
list(
212+
colors = colors,
213+
ci_data = attributes(x$VIF)$CI,
214+
is_check_model = TRUE
215+
)
220216
)
217+
fun_args$size_point <- 1.5 * fun_args$size_point
218+
p$VIF <- do.call(.plot_diag_vif, fun_args)
221219
}
222220

223221
# Quantile-Quantile (QQ) Plot for Residuals
224222
if (.should_plot(x, check, "QQ", "qq")) {
225-
# Check if object is from simulated residuals (e.g., DHARMa)
226-
if (inherits(x$QQ, "performance_simres")) {
227-
p$QQ <- plot(
228-
x$QQ,
229-
linewidth = linewidth,
230-
size_point = 0.9 * size_point,
231-
alpha = alpha_level,
223+
fun_args <- c(
224+
list(x$QQ),
225+
common_args,
226+
list(
232227
alpha_dot = alpha_dot,
233228
colors = colors,
234-
detrend = detrend,
235-
theme = theme,
236-
base_size = base_size,
237-
size_axis_title = size_axis_title,
238-
size_title = size_title
229+
detrend = detrend
239230
)
231+
)
232+
# Check if object is from simulated residuals (e.g., DHARMa)
233+
if (inherits(x$QQ, "performance_simres")) {
234+
fun_args$size_point <- 0.9 * fun_args$size_point
235+
fun_args$alpha <- alpha_level
236+
p$QQ <- do.call(plot, fun_args)
240237
} else {
241-
p$QQ <- .plot_diag_qq(
242-
x$QQ,
243-
size_point = size_point,
244-
linewidth = linewidth,
245-
size_axis_title = size_axis_title,
246-
size_title = size_title,
247-
alpha_level = alpha_level,
248-
detrend = detrend,
249-
theme = theme,
250-
base_size = base_size,
251-
colors = colors,
252-
alpha_dot = alpha_dot,
253-
show_dots = TRUE, # qq-plots w/o dots makes no sense
254-
model_info = model_info,
255-
model_class = model_class,
256-
maximum_dots = max_dots
238+
fun_args <- c(
239+
fun_args,
240+
list(
241+
alpha_level = alpha_level,
242+
show_dots = TRUE, # qq-plots w/o dots makes no sense
243+
model_info = model_info,
244+
model_class = model_class,
245+
maximum_dots = max_dots
246+
)
257247
)
248+
p$QQ <- do.call(.plot_diag_qq, fun_args)
258249
}
259250
}
260251

261252
# Normality of Residuals
262253
if (.should_plot(x, check, "NORM", "normality")) {
263-
p$NORM <- .plot_diag_norm(
264-
x$NORM,
265-
linewidth = linewidth,
266-
alpha_level = alpha_level,
267-
theme = theme,
268-
base_size = base_size,
269-
size_axis_title = size_axis_title,
270-
size_title = size_title,
271-
colors = colors
254+
fun_args <- c(
255+
list(x$NORM),
256+
common_args,
257+
list(alpha_level = alpha_level, colors = colors)
272258
)
259+
p$NORM <- do.call(.plot_diag_norm, fun_args)
273260
}
274261

275262
# Random Effects QQ Plot
276263
if (.should_plot(x, check, "REQQ", "reqq")) {
277-
ps <- .plot_diag_reqq(
278-
x$REQQ,
279-
size_point,
280-
linewidth,
281-
size_axis_title = size_axis_title,
282-
size_title = size_title,
283-
alpha_level = alpha_level,
284-
theme = theme,
285-
base_size = base_size,
286-
colors = colors,
287-
alpha_dot = alpha_dot,
288-
show_dots = TRUE, # qq-plots w/o dots makes no sense
289-
maximum_dots = max_dots
264+
fun_args <- c(
265+
list(x$REQQ),
266+
common_args,
267+
list(
268+
alpha_level = alpha_level,
269+
colors = colors,
270+
alpha_dot = alpha_dot,
271+
show_dots = TRUE, # qq-plots w/o dots makes no sense
272+
maximum_dots = max_dots
273+
)
290274
)
291-
275+
ps <- do.call(.plot_diag_reqq, fun_args)
292276
# Append all random effects plots to the main list
293277
for (i in seq_along(ps)) {
294278
p[[length(p) + 1]] <- ps[[i]]

0 commit comments

Comments
 (0)