4 new function download media

.Rbuildignore

@@ -2,3 +2,7 @@
 ^\.Rproj\.user$
 ^LICENSE\.md$
 ^\.github$
+^data_raw$
+^preprocessing$
+^CODE_OF_CONDUCT.md$
+^codemeta.json$

DESCRIPTION

@@ -1,19 +1,30 @@
 Package: fistools
 Title: Tools & data used for wildlife management & invasive species in Flanders
-Version: 0.0.0.9000
-Authors@R: 
-    person("Sander", "Devisscher", , "[email protected]", role = c("aut", "cre"),
-           comment = c(ORCID = "0000-0003-2015-5731"))
+Version: 0.0.1
+Authors@R: c(
+    person(given = "Sander", middle = "", family = "Devisscher", "[email protected]", 
+      role = c("aut", "cre"), comment = c(ORCID = "0000-0003-2015-5731")),
+    person(given = "Lynn", middle = "", family = "Pallemaerts", "[email protected]", 
+      role = "aut", comment = c(ORCID = "0000-0002-5034-5416")),
+    person(given = "Soria", middle = "", family = "Delva", "[email protected]", 
+      role = "aut", comment = c(ORCID = "0000-0002-7164-6031")),
+    person(given = "Emma", middle = "", family = "Cartuyvels", "[email protected]", 
+      role = "aut", comment = c(ORCID = "0000-0001-7856-6360"))
+           )
 Description: This package contains functions & data that are widely used within the wildlife management & invasive species research group (FIS) of the research institute forest and nature (INBO).
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
+LazyDataCompression: xz
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.1
 Imports: 
     dplyr (>= 1.1.4),
-    googledrive (>= 2.1.1),
+    httr (>= 1.4.7),
     magrittr (>= 2.0.3),
+    stringr (>= 1.5.1),
     rlang (>= 1.1.3),
+    progress (>= 1.2.3),
+    googledrive (>= 2.1.1),
     svDialogs (>= 1.1.0),
     utils (>= 4.3.2)

NAMESPACE

@@ -2,5 +2,7 @@
 
 export(check)
 export(colcompare)
+export(download_dep_media)
 export(download_gdrive_if_missing)
+export(download_seq_media)
 importFrom(magrittr,"%>%")

R/download_dep_media.R

@@ -0,0 +1,126 @@
+#' Download deployment media
+#'
+#' @author Lynn Pallemaerts
+#' @author Emma Cartuyvels
+#' @author Sander Devisscher
+#' @author Soria Delva
+#'
+#' @description
+#' This function allows the user to download all media related to a Agouti -
+#' dataset which matches the given parameters.
+#'
+#' @param dataset character string, path to the folder where a camptraptor datapackage has been unzipped.
+#' @param depID character string, ID of the deployment to download media from.
+#' @param favorite boolean, do you only want the pretty pictures?
+#' @param species character string, latin name of the species to download
+#' @param outputfolder character string, path where the function should download the media into
+#'
+#' @details
+#' If you are getting an Authorization Error (#403), this probably means your Agouti project has Restrict Images on. This needs to be turned off.
+#' If depID = "all" and favorite = TRUE, the function will download all favorited pictures in the whole dataset.
+#'
+#' @returns Downloads the specified media files into the outputfolder
+#'
+#' @examples
+#' \dontrun{
+#' drg <- fistools::drg_example
+#'
+#' # Situation 1: download whole deployment
+#' download_dep_media(dataset = drg,
+#'                     depID = "96413aa6-5f1f-4dfb-8fab-8f06decc179f")
+#'
+#' # Situation 2: download only wanted species
+#' download_dep_media(dataset = drg,
+#'                     depID = "96413aa6-5f1f-4dfb-8fab-8f06decc179f",
+#'                     species = "Dama dama")
+#'
+#' # Situation 3: download only favorited species media
+#' download_dep_media(dataset = drg,
+#'                     depID = "96413aa6-5f1f-4dfb-8fab-8f06decc179f",
+#'                     species = "Dama dama",
+#'                     favorite = TRUE)
+#'
+#' # Situation 4: download only favorited species media
+#' download_dep_media(dataset = drg,
+#'                     depID = "all",
+#'                     favorite = TRUE)
+
+#' }
+#'
+#' @export
+#' @importFrom magrittr %>%
+
+download_dep_media <- function(dataset,
+                               depID,
+                               species = NULL,   # ONLY LATIN NAMES FOR NOW
+                               favorite = FALSE,
+                               outputfolder = NULL) {
+
+  if (length(depID) > 1) {
+    stop("function can only download one deployment at the time. if you want to download different deployments, use a for-loop")
+  }
+
+  if (is.null(outputfolder))  {
+    if (dir.exists("../../Mijn afbeeldingen")) {
+      output_folder <- paste0("../../Mijn afbeeldingen/", depID)
+    } else {
+      stop("output folder is not specified and default does not exist. please specify an output folder !!!")
+    }
+  } else {
+    output_folder <- paste0(outputfolder, "/", depID)
+  }
+  if (!dir.exists(output_folder)) {
+    dir.create(output_folder)
+  }
+
+  med <- dataset$data$media
+
+  if (depID == "all" & favorite == TRUE) {
+    med <- med %>%
+      dplyr::filter(favourite == TRUE)
+
+    depID <- unique(med$deploymentID)
+  }
+
+  if (!is.null(species)) {
+    obs <- dataset$data$observations %>%
+      dplyr::filter(scientificName == species)
+    med <- med %>%
+      dplyr::filter(sequenceID %in% obs$sequenceID)
+  }
+  if (favorite == TRUE) {
+    med <- med %>%
+      dplyr::filter(favourite == TRUE)
+  }
+
+  med <- med %>%
+    dplyr::filter(deploymentID %in% depID)
+
+  if (nrow(med) > 100 & nrow(med) < 1000) {
+    warning("you are trying to download between 100 and 1000 images. this may take a while")
+  }
+  if (nrow(med) > 1000) {
+    continue <-  askYesNo("You are trying to download more than 1000 images. This might take a long time to complete. Are you sure you want to continue?")
+    if (continue == FALSE) {
+      stop()
+    }
+  }
+
+  print(paste0("you are downloading ", nrow(med), " images"))
+
+  pb <- progress::progress_bar$new(format = "  [:bar] :percent ETA: :eta",
+                                   total = nrow(med),
+                                   clear = FALSE,
+                                   width = 60)
+
+  for (i in 1:nrow(med)) {
+    pb$tick()
+    filename <- paste0(stringr::str_sub(med$fileName[i], end = -5),
+                       ".jpeg")
+    httr::GET(url = med$filePath[i],
+              httr::write_disk(path = paste0(output_folder,
+                                             "/",
+                                             filename),
+                               overwrite = TRUE))
+  }
+}

R/download_seq_media.R

@@ -0,0 +1,98 @@
+#' Download sequence media
+#'
+#' @author Lynn Pallemaerts
+#' @author Emma Cartuyvels
+#' @author Sander Devisscher
+#' @author Soria Delva
+#'
+#' @description
+#' This function allows the user to download all media related to a Agouti -
+#' sequence which matches the given parameters.
+#'
+#' @param dataset character string, path to the folder where a camptraptor datapackage has been unzipped.
+#' @param seqID character string, ID of the sequence to download media from
+#' @param favorite boolean, do you only want the pretty pictures?
+#' @param outputfolder character string, path where the function should download the media into
+#'
+#' @details
+#' If you are getting an Authorization Error (#403), this probably means your Agouti project has Restrict Images on. This needs to be turned off.
+#'
+#' @returns Downloads the specified media files into the outputfolder
+#'
+#' @examples
+#' \dontrun{
+#' drg <- fistools::drg_example
+#'
+#' # Situation 1: download whole sequence
+#' download_seq_media(dataset = drg,
+#'                     seqID = "f4c049d2-d42f-4cd3-a951-fd485ed0279a")
+#'
+#' # Situation 2: download only favorited species media within sequence
+#' download_seq_media(dataset = drg,
+#'                     seqID = "f4c049d2-d42f-4cd3-a951-fd485ed0279a",
+#'                     favorite = TRUE)
+#' }
+#'
+#' @export
+#' @importFrom magrittr %>%
+
+download_seq_media <- function(dataset,
+                               seqID,
+                               favorite = FALSE,
+                               outputfolder = NULL) {
+
+  if (length(seqID) > 1) {
+    stop("function can only download one sequence at the time. if you want to download different sequences, use a for-loop")
+  }
+
+  if (is.null(outputfolder))  {
+    if (dir.exists("../../Mijn afbeeldingen")) {
+      output_folder <- paste0("../../Mijn afbeeldingen/", seqID)
+    } else {
+      stop("output folder is not specified and default does not exist. please specify an output folder !!!")
+    }
+  } else {
+    output_folder <- paste0(outputfolder, "/", seqID)
+  }
+  if (!dir.exists(output_folder)) {
+    dir.create(output_folder)
+  }
+
+  med <- dataset$data$media
+
+  if (favorite == TRUE) {
+    med <- med %>%
+      dplyr::filter(favourite == TRUE)
+  }
+
+  med <- med %>%
+    dplyr::filter(sequenceID %in% seqID)
+
+  if (nrow(med) > 100 & nrow(med) < 1000) {
+    warning("you are trying to download between 100 and 1000 images. this may take a while")
+  }
+  if (nrow(med) > 1000) {
+    continue <-  askYesNo("You are trying to download more than 1000 images. This might take a long time to complete. Are you sure you want to continue?")
+    if (continue == FALSE) {
+      stop()
+    }
+  }
+
+  print(paste0("you are downloading ", nrow(med), " images"))
+
+  pb <- progress::progress_bar$new(format = "  [:bar] :percent ETA: :eta",
+                                   total = nrow(med),
+                                   clear = FALSE,
+                                   width = 60)
+
+  for (i in 1:nrow(med)) {
+    pb$tick()
+    filename <- paste0(stringr::str_sub(med$fileName[i], end = -5),
+                       ".jpeg")
+    httr::GET(url = med$filePath[i],
+              httr::write_disk(path = paste0(output_folder,
+                                             "/",
+                                             filename),
+                               overwrite = TRUE))
+  }
+}

R/drg_example.R

@@ -0,0 +1,12 @@
+#' drg_example
+#'
+#' Subset of Drongengoed Agouti export for testing of functions
+#'
+#' @format datapackage
+#' \describe{
+#'   \item{deployments}{Lijst van geselecteerde deployments}
+#'   \item{observations}{Observaties van de geselecteerde deployments}
+#'   \item{media}{Lijst van media-urls van de geselecteerde deployments}
+#'   }
+#' @source <https://www.agouti.eu>
+"drg_example"