Skip to content

Commit

Permalink
fix, lintr
Browse files Browse the repository at this point in the history
  • Loading branch information
strengejacke committed Jun 6, 2024
1 parent 4ae8856 commit 0114374
Show file tree
Hide file tree
Showing 5 changed files with 55 additions and 42 deletions.
4 changes: 3 additions & 1 deletion R/extract_parameters.R
Original file line number Diff line number Diff line change
Expand Up @@ -486,7 +486,9 @@
} else {
ci_df <- ci(model, ci = ci, method = ci_method, effects = "fixed")
}
if (length(ci) > 1) ci_df <- datawizard::reshape_ci(ci_df)
if (length(ci) > 1) {
ci_df <- datawizard::reshape_ci(ci_df)
}
ci_cols <- names(ci_df)[!names(ci_df) %in% c("CI", "Parameter")]
parameters <- merge(parameters, ci_df, by = "Parameter", sort = FALSE)
}
Expand Down
8 changes: 5 additions & 3 deletions R/methods_kmeans.R
Original file line number Diff line number Diff line change
Expand Up @@ -102,10 +102,12 @@ model_parameters.hkmeans <- model_parameters.kmeans

#' @export
print.parameters_clusters <- function(x, digits = 2, ...) {
title <- "# Clustering Solution"
if ("title" %in% attributes(x)) title <- attributes(x)$title
clusterHeading <- "# Clustering Solution"
if ("title" %in% attributes(x)) {
clusterHeading <- attributes(x)$title
}

insight::print_color(title, "blue")
insight::print_color(clusterHeading, "blue")

cat("\n\n")
insight::print_colour(.text_components_variance(x), "yellow")
Expand Down
79 changes: 44 additions & 35 deletions R/n_clusters_easystats.R
Original file line number Diff line number Diff line change
Expand Up @@ -26,9 +26,9 @@ n_clusters_elbow <- function(x,
names(out) <- c("n_Clusters", "WSS")

gradient <- c(0, diff(out$WSS))
optim <- out$n_Clusters[which.min(gradient)]
optimal <- out$n_Clusters[which.min(gradient)]

attr(out, "n") <- optim
attr(out, "n") <- optimal
attr(out, "gradient") <- gradient
attr(out, "duration") <- as.numeric(difftime(Sys.time(), t0, units = "secs"))
class(out) <- c("n_clusters_elbow", class(out))
Expand Down Expand Up @@ -75,9 +75,9 @@ n_clusters_gap <- function(x,
out <- rez[c("clusters", "gap", "SE.sim")]
names(out) <- c("n_Clusters", "Gap", "SE")

optim <- cluster::maxSE(f = out$Gap, SE.f = out$SE, method = gap_method)
optimal <- cluster::maxSE(f = out$Gap, SE.f = out$SE, method = gap_method)

attr(out, "n") <- optim
attr(out, "n") <- optimal
attr(out, "ymin") <- rez$ymin
attr(out, "ymax") <- rez$ymax
attr(out, "duration") <- as.numeric(difftime(Sys.time(), t0, units = "secs"))
Expand Down Expand Up @@ -118,9 +118,9 @@ n_clusters_silhouette <- function(x,
)
names(out) <- c("n_Clusters", "Silhouette")

optim <- which.max(out$Silhouette)
optimal <- which.max(out$Silhouette)

attr(out, "n") <- optim
attr(out, "n") <- optimal
attr(out, "duration") <- as.numeric(difftime(Sys.time(), t0, units = "secs"))
class(out) <- c("n_clusters_silhouette", class(out))
out
Expand Down Expand Up @@ -297,33 +297,36 @@ print.n_clusters_hclust <- function(x, ...) {

#' @export
visualisation_recipe.n_clusters_elbow <- function(x, ...) {
data <- as.data.frame(x)
data$Gradient <- datawizard::rescale(attributes(x)$gradient, c(min(data$WSS, max(data$WSS))))
input_df <- as.data.frame(x)
input_df$Gradient <- datawizard::rescale(
attributes(x)$gradient,
c(min(input_df$WSS, max(input_df$WSS)))
)
layers <- list()

# Layers -----------------------
layers[["l1"]] <- list(
geom = "line",
data = data,
data = input_df,
aes = list(x = "n_Clusters", y = "WSS", group = 1),
size = 1
)
layers[["l2"]] <- list(
geom = "point",
data = data,
data = input_df,
aes = list(x = "n_Clusters", y = "WSS")
)
layers[["l3"]] <- list(
geom = "line",
data = data,
data = input_df,
aes = list(x = "n_Clusters", y = "Gradient", group = 1),
size = 0.5,
color = "red",
linetype = "dashed"
)
layers[["l4"]] <- list(
geom = "vline",
data = data,
data = input_df,
xintercept = attributes(x)$n,
linetype = "dotted"
)
Expand All @@ -336,32 +339,32 @@ visualisation_recipe.n_clusters_elbow <- function(x, ...) {

# Out
class(layers) <- c("visualisation_recipe", "see_visualisation_recipe", class(layers))
attr(layers, "data") <- data
attr(layers, "data") <- input_df
layers
}


#' @export
visualisation_recipe.n_clusters_gap <- function(x, ...) {
data <- as.data.frame(x)
data$ymin <- attributes(x)$ymin
data$ymax <- attributes(x)$ymax
dataset <- as.data.frame(x)
dataset$ymin <- attributes(x)$ymin
dataset$ymax <- attributes(x)$ymax
layers <- list()

# Layers -----------------------
layers[["l1"]] <- list(
geom = "line",
data = data,
data = dataset,
aes = list(x = "n_Clusters", y = "Gap", group = 1)
)
layers[["l2"]] <- list(
geom = "pointrange",
data = data,
data = dataset,
aes = list(x = "n_Clusters", y = "Gap", ymin = "ymin", ymax = "ymax")
)
layers[["l4"]] <- list(
geom = "vline",
data = data,
data = dataset,
xintercept = attributes(x)$n,
linetype = "dotted"
)
Expand All @@ -374,30 +377,30 @@ visualisation_recipe.n_clusters_gap <- function(x, ...) {

# Out
class(layers) <- c("visualisation_recipe", "see_visualisation_recipe", class(layers))
attr(layers, "data") <- data
attr(layers, "data") <- dataset
layers
}


#' @export
visualisation_recipe.n_clusters_silhouette <- function(x, ...) {
data <- as.data.frame(x)
dataset <- as.data.frame(x)
layers <- list()

# Layers -----------------------
layers[["l1"]] <- list(
geom = "line",
data = data,
data = dataset,
aes = list(x = "n_Clusters", y = "Silhouette", group = 1)
)
layers[["l2"]] <- list(
geom = "point",
data = data,
data = dataset,
aes = list(x = "n_Clusters", y = "Silhouette")
)
layers[["l4"]] <- list(
geom = "vline",
data = data,
data = dataset,
xintercept = attributes(x)$n,
linetype = "dotted"
)
Expand All @@ -410,38 +413,41 @@ visualisation_recipe.n_clusters_silhouette <- function(x, ...) {

# Out
class(layers) <- c("visualisation_recipe", "see_visualisation_recipe", class(layers))
attr(layers, "data") <- data
attr(layers, "data") <- dataset
layers
}


#' @export
visualisation_recipe.n_clusters_dbscan <- function(x, ...) {
data <- as.data.frame(x)
dataset <- as.data.frame(x)

layers <- list()


# Layers -----------------------
if ("gradient" %in% names(attributes(x))) {
data$gradient <- datawizard::rescale(attributes(x)$gradient, c(min(data$eps), max(data$eps)))
dataset$gradient <- datawizard::rescale(
attributes(x)$gradient,
c(min(dataset$eps), max(dataset$eps))
)

layers[["l1"]] <- list(
geom = "line",
data = data,
data = dataset,
aes = list(x = "n_Obs", y = "eps"),
size = 1
)
layers[["l2"]] <- list(
geom = "line",
data = data,
data = dataset,
aes = list(x = "n_Obs", y = "gradient"),
color = "red",
linetype = "dashed"
)
layers[["l3"]] <- list(
geom = "hline",
data = data,
data = dataset,
yintercept = attributes(x)$eps,
linetype = "dotted"
)
Expand All @@ -452,24 +458,27 @@ visualisation_recipe.n_clusters_dbscan <- function(x, ...) {
title = "DBSCAN Method"
)
} else {
data$y <- datawizard::rescale(data$total_SS, c(min(data$n_Clusters), max(data$n_Clusters)))
dataset$y <- datawizard::rescale(
dataset$total_SS,
c(min(dataset$n_Clusters), max(dataset$n_Clusters))
)

layers[["l1"]] <- list(
geom = "line",
data = data,
data = dataset,
aes = list(x = "eps", y = "n_Clusters"),
size = 1
)
layers[["l2"]] <- list(
geom = "line",
data = data,
data = dataset,
aes = list(x = "eps", y = "y"),
color = "red",
linetype = "dashed"
)
layers[["l3"]] <- list(
geom = "vline",
data = data,
data = dataset,
xintercept = attributes(x)$eps,
linetype = "dotted"
)
Expand All @@ -483,7 +492,7 @@ visualisation_recipe.n_clusters_dbscan <- function(x, ...) {

# Out
class(layers) <- c("visualisation_recipe", "see_visualisation_recipe", class(layers))
attr(layers, "data") <- data
attr(layers, "data") <- dataset
layers
}

Expand Down
4 changes: 2 additions & 2 deletions R/print.parameters_model.R
Original file line number Diff line number Diff line change
Expand Up @@ -386,7 +386,7 @@ print.parameters_random <- function(x, digits = 2, ...) {
ci_width = "auto",
ci_brackets = TRUE,
format = "text",
group = NULL,
groups = NULL,
include_reference = FALSE,
...) {
format(
Expand All @@ -401,7 +401,7 @@ print.parameters_random <- function(x, digits = 2, ...) {
ci_brackets = ci_brackets,
zap_small = zap_small,
format = format,
group = group,
groups = groups,
include_reference = include_reference,
...
)
Expand Down
2 changes: 1 addition & 1 deletion R/standardize_posteriors.R
Original file line number Diff line number Diff line change
Expand Up @@ -72,7 +72,7 @@ standardise_posteriors <- standardize_posteriors
i <- match(deviations$Parameter, colnames(pars))
pars <- pars[, i]

if (method == "basic") {
if (method == "basic") { # nolint
col_dev_resp <- "Deviation_Response_Basic"
col_dev_pred <- "Deviation_Basic"
} else if (method == "posthoc") {
Expand Down

0 comments on commit 0114374

Please sign in to comment.