created animint2pages()

.Rbuildignore

@@ -1,3 +1,4 @@
+readme_website.md
 .github
 ^.*\.Rproj$
 ^\.Rproj\.user$

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: animint2
 Title: Animated Interactive Grammar of Graphics
-Version: 2023.6.11
+Version: 2023.10.27
 URL: https://animint.github.io/animint2/
 BugReports: https://github.com/animint/animint2/issues
 Authors@R: c(
@@ -76,6 +76,7 @@ Imports:
     methods
 Suggests:
     servr,
+    gert, gitcreds, gh,
     sp,
     gistr (>= 0.2),
     shiny,
@@ -272,9 +273,11 @@ Collate:
     'z_gist.R'
     'z_helperFunctions.R'
     'z_knitr.R'
+    'z_pages.R'
     'z_print.R'
     'z_scales.R'
     'z_theme_animint.R'
     'z_transformShape.R'
 RoxygenNote: 7.2.3
 Config/Needs/website: tidyverse/tidytemplate
+VignetteBuilder: knitr

NAMESPACE

@@ -215,6 +215,7 @@ export(alpha)
 export(animint)
 export(animint2dir)
 export(animint2gist)
+export(animint2pages)
 export(animintOutput)
 export(annotate)
 export(annotation_custom)
@@ -489,6 +490,7 @@ export(theme_void)
 export(toRGB)
 export(transform_position)
 export(unit)
+export(update_gallery)
 export(update_geom_defaults)
 export(update_labels)
 export(update_stat_defaults)

NEWS.md

@@ -1,3 +1,12 @@
+# Changes in 2023.10.27
+
+- New function `animint2pages(viz,"new_github_repo")` for
+  publishing/sharing animints, replacement for animint2gist, which
+  stopped working recently.
+- New option `animint(source="http://path.to/source.R")` which should
+  be the URL of data viz source code, used to display a link at the
+  below the rendered viz.
+
 # Changes in 2023.6.11
 
 - Remove maptools dependency.
@@ -92,4 +101,4 @@
 
 # Changes in 2017.08.24
 
-- DSL: clickSelects/showSelected are now specified as parameters rather than aesthetics.
+- DSL: clickSelects/showSelected are now specified as parameters rather than aesthetics.

R/z_animint.R

@@ -285,6 +285,10 @@ animint2dir <- function(plot.list, out.dir = NULL,
   if(!is.null(plot.list$out.dir)){
     plot.list$out.dir <- NULL
   }
+  if(is.character(plot.list[["source"]])){
+    meta$source <- plot.list[["source"]]
+    plot.list$source <- NULL
+  }
 
   ## Extract essential info from ggplots, reality checks.
   for(list.name in names(plot.list)){
@@ -631,8 +635,8 @@ animint2dir <- function(plot.list, out.dir = NULL,
     file.copy(style.file, file.path(out.dir, "styles.css"), overwrite=TRUE)
   }
   file.copy(to.copy, out.dir, overwrite=TRUE, recursive=TRUE)
-  export.names <-
-    c("geoms", "time", "duration", "selectors", "plots", "title")
+  export.names <- c(
+    "geoms", "time", "duration", "selectors", "plots", "title", "source")
   export.data <- list()
   for(export.name in export.names){
     if(export.name %in% ls(meta)){

R/z_pages.R

@@ -0,0 +1,223 @@
+#' Publish a list of ggplots as interactive visualizations on a GitHub repository
+#'
+#' This function takes a named list of ggplots, generates interactive animations,
+#' and pushes the generated files to a specified GitHub repository. You can
+#' choose to keep the repository private or public.
+#' Before using this function set your appropriate git 'user.username' and 'user.email'
+#'
+#' @param plot.list A named list of ggplots and option lists.
+#' @param github_repo The name of the GitHub repository to which the files will be pushed.
+#' @param commit_message A string specifying the commit message for the pushed files.
+#' @param private A logical flag indicating whether the GitHub repository should be private or not.
+#' @param required_opts Character vector of plot.list element names which are checked (stop with an error if not present). Use required_opts=NULL to skip check.
+#' @param ... Additional options passed onto \code{animint2dir}.
+#'
+#' @return The function returns the initialized GitHub repository object.
+#'
+#' @examples
+#' \dontrun{
+#' library(animint2)
+#' p1 <- ggplot(mtcars, aes(x = mpg, y = wt)) +
+#'   geom_point()
+#' p2 <- ggplot(mtcars, aes(x = hp, y = wt)) +
+#'   geom_point()
+#' viz <- list(plot1 = p1, plot2 = p2)
+#' animint2pages(
+#'   viz,
+#'   github_repo = "my_animint2_plots",
+#'   commit_message = "New animint",
+#'   private = TRUE)
+#' }
+#'
+#' @export
+animint2pages <- function(plot.list, github_repo, commit_message = "Commit from animint2pages", private = FALSE, required_opts = c("title","source"), ...) {
+
+  for(opt in required_opts){
+    if(!opt %in% names(plot.list)){
+      stop(sprintf("plot.list does not contain option named %s, which is required by animint2pages", opt))
+    }
+  }
+
+  # Check for required packages
+  for(pkg in c("gert", "gh")){
+    if (!requireNamespace(pkg)) {
+      stop(sprintf("Please run `install.packages('%s')` before using this function", pkg))
+    }
+  }
+
+  # Generate plot files
+  res <- animint2dir(plot.list, open.browser = FALSE, ...)
+
+  # Select non-ignored files to post
+  all_files <- Sys.glob(file.path(res$out.dir, "*"))
+  file_info <- file.info(all_files)
+  to_post <- all_files[!(file_info$size == 0 | grepl("~$", all_files))]
+
+  tmp_dir <- tempfile()
+
+  tryCatch({
+    creds <- gitcreds::gitcreds_get()
+  }, error = function(e) stop("A GitHub token is required to create and push to a new repository. \nTo create a GitHub token, follow these steps:\n1. Go to https://github.com/settings/tokens/new?scopes=repo&description=animint2pages\n2. Confirm your password if prompted.\n3. Ensure that the 'repo' scope is checked.\n4. Click 'Generate token' at the bottom of the page.\n5. Copy the generated token.\nAfter creating the token, you can set it up in your R environment by running: \nSys.setenv(GITHUB_PAT=\"yourGithubPAT\") \ngert::git_config_global_set(\"user.name\", \"yourUserName\") \ngert::git_config_global_set(\"user.email\", \"yourEmail\") \n"))
+
+  # Raise error if github_repo contains '/'
+  if (grepl("/", github_repo)) {
+    stop("The github_repo argument should not contain '/'.")
+  }
+
+  # Check for existing repository
+  whoami <- suppressMessages(gh::gh_whoami())
+  owner <- whoami$login
+
+  if (!check_no_github_repo(owner, github_repo)) {
+    create <- gh::gh("POST /user/repos", name = github_repo, private = private)
+    origin_url <- create$clone_url
+    repo <- gert::git_init(path = tmp_dir)
+    gert::git_remote_add(name = "origin", url = origin_url, repo = repo)
+  } else {
+    origin_url <- paste0("https://github.com/", owner, "/", github_repo, ".git")
+    repo <- gert::git_clone(origin_url, tmp_dir)
+  }
+
+  viz_url <- paste0("https://", whoami$login, ".github.io/", github_repo)
+  if (length(git2r::commits(repo)) == 0) {
+    initial_commit(tmp_dir, repo, viz_url)
+  }
+
+  # Handle gh-pages branch
+  manage_gh_pages(repo, to_post, tmp_dir, commit_message)
+  message(
+    "Visualization will be available at ", viz_url,
+    "\nDeployment via GitHub Pages may take a few minutes..."
+  )
+
+  repo
+}
+
+initial_commit <- function(tmp_dir, repo, viz_url) {
+  readme_file_path <- file.path(tmp_dir, "README.md")
+  header <- "## New animint visualization\n"
+  url_hyperlink <- sprintf("[%s](%s)\n", viz_url, viz_url)
+  full_content <- paste0(header, url_hyperlink)
+  writeLines(full_content, readme_file_path)
+
+  gert::git_add("README.md", repo = repo)
+  gert::git_commit("Initial commit", repo = repo)
+  df_or_vec <- gert::git_branch(repo)
+  # check if it is a data frame or an atomic vector
+  if (is.data.frame(df_or_vec)) {
+    all_branches <- df_or_vec[["name"]]
+    current_master <- all_branches[df_or_vec$active]
+  } else {
+    all_branches <- df_or_vec
+    current_master <- df_or_vec
+  }
+  # do not attempt to rename a branch to "main" when a branch with that name already exists
+  if (current_master != "main" && !"main" %in% all_branches) {
+    gert::git_branch_move(branch = current_master, new_branch = "main", repo = repo)
+  }
+  gert::git_push(repo = repo, remote = "origin", set_upstream = TRUE)
+}
+
+manage_gh_pages <- function(repo, to_post, tmp_dir, commit_message) {
+  branches <- gert::git_branch_list(local = TRUE, repo = repo)
+
+  if (!"gh-pages" %in% branches$name) {
+    gert::git_branch_create(repo = repo, branch = "gh-pages")
+  }
+
+  gert::git_branch_checkout("gh-pages", repo = repo)
+  file.copy(to_post, tmp_dir, recursive = TRUE)
+  gert::git_add(files = ".", repo = repo)
+  gert::git_commit(message = commit_message, repo = repo)
+  gert::git_push(remote = "origin", set_upstream = TRUE, repo = repo, force = TRUE)
+}
+
+check_no_github_repo <- function(owner, repo) {
+  tryCatch(
+    {
+      gh::gh("/repos/{owner}/{repo}", owner = owner, repo = repo)
+      TRUE
+    },
+    "http_error_404" = function(err) FALSE
+  )
+}
+
+get_pages_info <- function(viz_user_repo){
+  viz_dir <- tempfile()
+  origin_url <- paste0("https://github.com/", viz_user_repo, ".git")
+  gert::git_clone(origin_url, viz_dir)
+  gert::git_branch_checkout("gh-pages", repo=viz_dir)
+  Capture.PNG <- file.path(viz_dir, "Capture.PNG")
+  if(!file.exists(Capture.PNG)){
+    stop(sprintf("gh-pages branch of %s should contain file named Capture.PNG (screenshot of data viz)", viz_user_repo))
+  }
+  plot.json <- file.path(viz_dir, "plot.json")
+  jlist <- RJSONIO::fromJSON(plot.json)
+  commit.row <- gert::git_log(max=1, repo=viz_dir)
+  repo.row <- data.table(
+    viz_user_repo, Capture.PNG, commit.POSIXct=commit.row$time)
+  to.check <- c(
+    source="URL of data viz source code",
+    title="string describing the data viz")
+  for(attr.name in names(to.check)){
+    attr.value <- jlist[[attr.name]]
+    if(
+      is.character(attr.value)
+      && length(attr.value)==1
+      && !is.na(attr.value)
+      && nchar(attr.value)>0
+    ){
+      set(repo.row, j=attr.name, value=attr.value)
+    }else{
+      stop(sprintf("plot.json file in gh-pages branch of %s should have element named %s which should be %s", viz_user_repo, attr.name, to.check[[attr.name]]))
+    }
+  }
+  repo.row
+}
+
+##' A gallery is a collection of animints that have been published to
+##' github pages. First repos.txt is read, then we clone each repo
+##' which is not already present in meta.csv, and parse meta-data
+##' (title, source, Capture.PNG) from the gh-pages branch, and
+##' write/commit the data, re-render index.Rmd in gallery, and push
+##' gallery to origin.
+##' @title Update gallery
+##' @param gallery_path path to local github repo with gh-pages active.
+##' @return named list of data tables (meta and error).
+##' @author Toby Dylan Hocking
+##' @export
+update_gallery <- function(gallery_path="~/R/gallery"){
+  repos.txt <- file.path(gallery_path, "repos.txt")
+  repos.dt <- fread(repos.txt,header=FALSE,col.names="viz_user_repo")
+  meta.csv <- file.path(gallery_path, "meta.csv")
+  old.meta <- fread(meta.csv)
+  todo.meta <- repos.dt[!old.meta, on="viz_user_repo"]
+  meta.dt.list <- list(old.meta)
+  error.dt.list <- list()
+  add.POSIXct <- Sys.time()
+  for(viz_user_repo in todo.meta[["viz_user_repo"]]){
+    tryCatch({
+      meta.row <- data.table(add.POSIXct, get_repo_row(viz_user_repo))
+      meta.dt.list[[viz_user_repo]] <- meta.row
+      Capture.PNG <- meta.row[["Capture.PNG"]]
+      repo.png <- file.path(
+        gallery_path, "repos", paste0(viz_user_repo, ".png"))
+      user.dir <- dirname(repo.png)
+      dir.create(user.dir, showWarnings = FALSE, recursive = TRUE)
+      file.copy(Capture.PNG, repo.png, overwrite = TRUE)
+    }, error=function(e){
+      error.dt.list[[viz_user_repo]] <<- data.table(
+        add.POSIXct, viz_user_repo, error=e$message)
+    })
+  }
+  (meta.dt <- rbindlist(meta.dt.list))
+  (error.dt <- rbindlist(error.dt.list))
+  fwrite(meta.dt, meta.csv)
+  fwrite(error.dt, file.path(gallery_path, "error.csv"))
+  rmarkdown::render(file.path(gallery_path, "index.Rmd"))
+  to_add <- c("*.csv", file.path("repos","*","*.png"), "index.html")
+  gert::git_add(to_add, repo=gallery_path)
+  gert::git_commit(paste("update", add.POSIXct), repo=gallery_path)
+  gert::git_push("origin", repo=gallery_path)
+  list(meta=meta.dt, error=error.dt)
+}

inst/htmljs/animint.js

@@ -2258,7 +2258,12 @@ var animint = function (to_select, json_file) {
     // Widgets at bottom of page
     ////////////////////////////////////////////
     element.append("br");
-
+    if(response.hasOwnProperty("source")){
+      element.append("a")
+	.attr("id","a_source_href")
+	.attr("href", response.source)
+	.text("source");
+    }
     // loading table.
     var show_hide_table = element.append("button")
       .text("Show download status table");