Metric weights 293

NAMESPACE

@@ -115,6 +115,7 @@ export(assessment_error_throw)
 export(get_assessments)
 export(metric_score)
 export(pkg_assess)
+export(pkg_cran)
 export(pkg_metric)
 export(pkg_ref)
 export(pkg_score)

R/pkg_ref_cache.R

@@ -122,7 +122,7 @@ available_pkg_ref_fields <- function(x) {
 #' @family package reference cache
 #'
 #' @rdname riskmetric_metadata_caching
-#' @keyworks internal
+#' @keywords internal
 #' @noRd
 pkg_ref_cache <- function(x, name, ..., .class = as.character(name)) {
   UseMethod("pkg_ref_cache", structure(list(), class = .class))

R/pkg_ref_class.R

@@ -174,6 +174,7 @@ pkg_source <- function(x) {
 #' @rdname pkg_ref
 #'
 #' @param repos URL of CRAN repository to pull package metadata.
+#' @export
 pkg_cran <- function(x, repos = getOption("repos", "https://cran.rstudio.com")) {
   ap <- memoise_available_packages(repos = repos)
   info <- ap[ap[,"Package"] == x,,drop = FALSE]

R/pkg_score.R

@@ -65,18 +65,26 @@ pkg_score.tbl_df <- function(x, ..., error_handler = score_error_default) {
 }
 
 
-
 #' @export
 pkg_score.list_of_pkg_metric <- function(x, ...,
     error_handler = score_error_default) {
 
-  lapply(x, function(xi) {
+  metrics <- lapply(x, function(xi) {
     s <- metric_score(xi, error_handler = error_handler)
     metric_score_s3_fun <- firstS3method("metric_score", class(xi))
     attr(s, "label") <- attr(metric_score_s3_fun, "label")
     class(s) <- c("pkg_score", class(s))
     s
   })
+
+  ignore_cols <- c("package", "version", "pkg_ref")
+  metrics[["pkg_score"]] <- summarize_scores(metrics[!names(metrics) %in% ignore_cols], ...)
+
+  # reorder columns so that metadata columns come first
+  pkg_cols <- intersect(names(metrics), c("package", "version", "pkg_ref", "pkg_score"))
+  metrics <- metrics[c(pkg_cols, setdiff(names(metrics), pkg_cols))]
+
+  return(metrics)
 }
 
 

R/summarize_scores.R

@@ -34,12 +34,12 @@ summarize_scores.data.frame <- function(data, weights = NULL) {
     weights <- add_default_weights(data)
 
   # perform checks and standardize weights
-  weights <- standardize_weights(data, weights)
+  #weights <- standardize_weights(data, weights)
 
   # calculate 'quality' and subtract from 1 to get 'risk'
-  qual <- colSums(apply(data[names(weights)], 1L, `*`, weights), na.rm = TRUE)
+  qual <- rowSums(data * t(apply(data, 1, standardize_weights, weights=weights)), na.rm = T)
   risk <- 1 - qual
-
+  attr(risk,"label") <- "Summarized risk score from 0 (low) to 1 (high)."
   risk
 }
 
@@ -50,7 +50,9 @@ summarize_scores.list <- function(data, weights = NULL) {
 
   # perform checks and standardize weights
   weights <- standardize_weights(data, weights)
-  1 - sum(as.numeric(data[names(weights)]) * weights, na.rm = TRUE)
+  risk <- 1 - sum(as.numeric(data[names(weights)]) * weights, na.rm = TRUE)
+  attr(risk,"label") <- "Summarized risk score from 0 (low) to 1 (high)."
+  return(risk)
 }
 
 # Set the default weight of each metric to 1.
@@ -83,8 +85,10 @@ standardize_weights <- function(data, weights) {
   check_weights(weights)
 
   # re-weight for fields that are in the dataset
+  weights[is.na(data)] <- 0
   weights <- weights[which(names(weights) %in% names(data))]
 
   # standardize weights from 0 to 1
   weights <- weights / sum(weights, na.rm = TRUE)
+  return(weights)
 }

vignettes/riskmetric.Rmd

@@ -307,8 +307,7 @@ scores across `tibble` columns using `summarize_scores`.
 ```{r, warning = FALSE}
 package_tbl %>%
   pkg_assess() %>%
-  pkg_score() %>%
-  summarize_scores()
+  pkg_score()
 ```
 
 # How you can help...