check_qms_policy(): add function from RScript

[mrustl]

Add functions from RScript check_qms_policy.R (under SVN r5648):

check_qms_policy <- function(project_dir = "//servername/projekte$/GROUNDWATER/PROJECTS",
                             template_dir =  file.path("//servername/projekte$",
                                                       "R&D Templates/Templates_document-current",
                                                       "_FolderStructure_template",
                                                       "Project_folder_template"),
                             dbg = TRUE) {

temp_dirs <- list.dirs(path = template_dir,full.names = FALSE)

dirs_to_ignore <- temp_dirs != "" & !grepl(pattern = "projektspezifisch|cut",x = temp_dirs)

temp_dirs <- temp_dirs[dirs_to_ignore]

projects <- list.dirs(project_dir,recursive = FALSE)

for (project in projects) {
  for (temp_dir in temp_dirs) {

  check_dir <- file.path(project,temp_dir)

  department <- strsplit(project,split = "/")[[1]][5]

  project_name <- basename(project)

  check_dir_exists <- dir.exists(check_dir)

  tmp <- data.frame(department = department,
                    project_name = project_name,
                    dir_name = temp_dir,
                    dir_exists = ifelse(test = check_dir_exists,
                                        TRUE,
                                        FALSE))

  if (dbg) { print(sprintf("%s_%s: Checking %s = %s",
                          department,
                          project_name,
                          temp_dir,
                          check_dir_exists))
  }

  if (project == projects[1] & temp_dir == temp_dirs[1]) {
    res <- tmp
  } else {
    res <- rbind(res, tmp)
  }

  }
}
return(res)
}

if (FALSE) {

library(dplyr)
library(tidyr)
library(formattable)
library(DT)

grw <- check_qms_policy()

suw <- check_qms_policy(project_dir = "//servername/projekte$/SUW_Department/Projects")

wwt <- check_qms_policy(project_dir = "//servername/projekte$/WWT_Department/Projects")

kwb <- rbind(grw, suw) %>% rbind(wwt)
kwb <- kwb %>%
       mutate(department = ifelse(department == "GROUNDWATER",
                                  "GRW",
                                   ifelse(department == "SUW_Department",
                                          "SUW",
                                          ifelse(department == "WWT_Department",
                                                 "WWT",
                                                 "NOT_DEFINED")))) %>%
  mutate(dep_proj_name = sprintf("%s_%s",
                                 department,
                                 project_name))

kwb_summary <- kwb %>%
               group_by(dep_proj_name) %>%
               summarise(qms_dirs_total = sum(dir_exists)) %>%
               mutate(qms_dirs_percent = formattable::percent(qms_dirs_total/16)) %>%
               dplyr::arrange(desc(qms_dirs_percent))

kwb_summary %>%
formattable::formattable(list(qms_dirs_percent = color_bar("lightgreen"))) %>%
as.datatable()

file_formatter <- formattable::formatter("span",
                            style = x ~ style(color = ifelse(x == TRUE,
                                                             "green",
                                                             "red")))

#file_formatter(c(TRUE, FALSE, FALSE))

kwb[,c(-1,-2)] %>%
  formattable::formattable(list(dir_exists = file_formatter))

kwb_summary_pivot <- kwb[,c(-1,-2)] %>%
                     tidyr::spread(key = dep_proj_name,
                     value = dir_exists)

names(kwb_summary_pivot) <- gsub("GRW_|SUW_|WWT_","",names(kwb_summary_pivot))

formattable::formattable(kwb_summary_pivot,
                         list(area(col = 2:ncol(kwb_summary_pivot)) ~ file_formatter)) %>%
as.datatable()

}