Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Vectorize functions #3

Merged
merged 4 commits into from
Jan 22, 2024
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
@@ -19,3 +19,6 @@
^data-raw$
^docs$
^dev$
^resmush\.Rcheck$
^resmush.*\.tar\.gz$
^resmush.*\.tgz$
13 changes: 11 additions & 2 deletions CITATION.cff
Original file line number Diff line number Diff line change
@@ -7,9 +7,9 @@ cff-version: 1.2.0
message: 'To cite package "resmush" in publications use:'
type: software
license: MIT
title: 'resmush: What the Package Does (One Line, Title Case)'
title: 'resmush: Optimize and Compress Image Files with ''reSmush.it'''
version: 0.0.0.9000
abstract: What the package does (one paragraph).
abstract: Compress local and online images using the 'reSmush.it' API service <https://resmush.it/>.
authors:
- family-names: Hernangómez
given-names: Diego
@@ -22,6 +22,12 @@ contact:
given-names: Diego
email: diego.hernangomezherrero@gmail.com
orcid: https://orcid.org/0000-0001-8457-4658
keywords:
- compress-images
- optimize-images
- r
- r-package
- resmushit
references:
- type: software
title: 'R: A Language and Environment for Statistical Computing'
@@ -58,6 +64,9 @@ references:
email: jeroen@berkeley.edu
orcid: https://orcid.org/0000-0002-4035-0289
year: '2024'
identifiers:
- type: url
value: https://curl.se/libcurl/
- type: software
title: httr
abstract: 'httr: Tools for Working with URLs and HTTP'
5 changes: 3 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,10 +1,11 @@
Package: resmush
Title: What the Package Does (One Line, Title Case)
Title: Optimize and Compress Image Files with 'reSmush.it'
Version: 0.0.0.9000
Authors@R:
person("Diego", "Hernangómez", , "diego.hernangomezherrero@gmail.com", role = c("aut", "cre", "cph"),
comment = c(ORCID = "0000-0001-8457-4658"))
Description: What the package does (one paragraph).
Description: Compress local and online images using the 'reSmush.it' API
service <https://resmush.it/>.
License: MIT + file LICENSE
URL: https://dieghernan.github.io/resmush/,
https://github.com/dieghernan/resmush
75 changes: 63 additions & 12 deletions R/resmush_file.R
Original file line number Diff line number Diff line change
@@ -6,26 +6,30 @@
#' **Note that** the default parameters of the function `outfile = file`
#' **overwrites** the local file. See **Examples**.
#'
#' @param file Path to a local file. **reSmush** can optimize the
#' @param file Path or paths to local files. **reSmush** can optimize the
#' following image files:
#' * `png`
#' * `jpg`
#' * `gif`
#' * `bmp`
#' * `tif`
#' @param outfile Path where the optimized file would be store in your disk.
#' By default, it would override the file specified in `file`.
#' @param outfile Path or paths where the optimized files would be store in
#' your disk. By default, it would override the file specified in `file`. It
#' should be of the same length than `file` parameter.
#' @param qlty Only affects `jpg` files. Integer between 0 and 100 indicating
#' the optimization level. For optimal results use vales above 90.
#' @param verbose Logical. If `TRUE` displays a summary of the results.
#' @param exif_preserve Logical. Should be the
#' [Exif](https://en.wikipedia.org/wiki/Exif) information removed as well?
#' @param exif_preserve Logical. Should the
#' [Exif](https://en.wikipedia.org/wiki/Exif) information (if any) deleted?
#' Default is to remove (i.e. `exif_preserve = FALSE`).
#' @return
#' Writes on disk the optimized file if the API call is successful.
#' In any case, a (invisibly) data frame with a summary of the process is
#' returned as well.
#'
#' If any value of the vector `outfile` is duplicated, `resmush_file()` would
#' rename the output with a suffix `_1. _2`, etc.
#'
#' @seealso
#' [reSmush.it API](https://resmush.it/api) docs.
#'
@@ -37,25 +41,72 @@
#' \donttest{
#' png_file <- system.file("extimg/example.png", package = "resmush")
#'
#' # For example, write to a temp file
#' # For the example, write to a temp file
#' tmp_png <- tempfile(fileext = ".png")
#'
#' # Silently returns a data frame
#' png_res <- resmush_file(png_file, outfile = tmp_png)
#' png_res[, -c(1:2)]
#' resmush_file(png_file, outfile = tmp_png)
#'
#' # Use with jpg and parameters
#' # Several paths
#' jpg_file <- system.file("extimg/example.jpg", package = "resmush")
#'
#' # For example, writes to a temp file
#' tmp_jpg <- tempfile(fileext = ".jpg")
#'
#'
#' summary <- resmush_file(c(png_file, jpg_file), outfile = c(
#' tmp_png,
#' tmp_jpg
#' ))
#'
#' # Returns an (invisible) data frame with a summary of the process
#' summary
#'
#'
#' # With parameters
#'
#' # Silently returns a data frame
#' resmush_file(jpg_file, outfile = tmp_jpg, verbose = TRUE)
#' resmush_file(jpg_file, outfile = tmp_jpg, verbose = TRUE, qlty = 10)
#' }
#'
resmush_file <- function(file, outfile = file, qlty = 92, verbose = FALSE,
exif_preserve = FALSE) {
# High level function for vectors

# Check lengths
l1 <- length(file)
l2 <- length(outfile)

if (l1 != l2) {
cli::cli_abort(paste0(
"Lengths of {.arg file} and {.arg outfile}",
"should be the same ({l1} vs. {l2})"
))
}


# Once checked call single
iter <- seq_len(l1)

# Make unique paths
outfile <- make_unique_paths(outfile)

res_vector <- lapply(iter, function(x) {
df <- resmush_file_single(
file[x], outfile[x],
qlty, verbose, exif_preserve
)
df
})

# Bind and output
df_end <- do.call("rbind", res_vector)

return(invisible(df_end))
}


# Single call
resmush_file_single <- function(file, outfile = file, qlty = 92,
verbose = FALSE, exif_preserve = FALSE) {
# Master table with results
res <- data.frame(
src_img = file, dest_img = NA, src_size = NA,
70 changes: 59 additions & 11 deletions R/resmush_url.R
Original file line number Diff line number Diff line change
@@ -4,23 +4,28 @@
#' Optimize and download an online image using the
#' [reSmush.it API](https://resmush.it/).
#'
#' @param url url to a hosted file. **reSmush** can optimize the
#' following image files:
#' @param url url or a vector of urls pointing to hosted image files.
#' **reSmush** can optimize the following image files:
#' * `png`
#' * `jpg`
#' * `gif`
#' * `bmp`
#' * `tif`
#' @param outfile Path where the optimized file would be store in your disk. By
#' default, a temporary file (see [tempfile()]) with the same [basename()] than
#' the file provided in url would be created.
#' @param outfile Path or paths where the optimized files would be store in
#' your disk. By default, temporary files (see [tempfile()]) with the same
#' [basename()] than the file provided in `url` would be created. It should be
#' of the same length than `url` parameter.
#' @inheritParams resmush_file
#'
#' @return
#' Writes on disk the optimized file if the API call is successful.
#' In any case, a (invisibly) data frame with a summary of the process is
#' returned as well.
#'
#' If any value of the vector `outfile` is duplicated, `resmush_url()` would
#' rename the output with a suffix `_1. _2`, etc.
#'
#'
#' @seealso
#' [reSmush.it API](https://resmush.it/api) docs.
#'
@@ -36,20 +41,63 @@
#' base_url <- "https://raw.githubusercontent.com/dieghernan/resmush/main/inst/"
#'
#' png_url <- paste0(base_url, "/extimg/example.png")
#' resmush_url(png_url)
#'
#' # Silently returns a data frame
#' png_res <- resmush_url(png_url)
#' png_res
#'
#' # Use with jpg and parameters
#' # Several urls
#' jpg_url <- paste0(base_url, "/extimg/example.jpg")
#'
#' # Silently returns a data frame
#'
#' summary <- resmush_url(c(png_url, jpg_url))
#'
#' # Returns an (invisible) data frame with a summary of the process
#' summary
#'
#' # Use with jpg and parameters
#' resmush_url(jpg_url, verbose = TRUE)
#' resmush_url(jpg_url, verbose = TRUE, qlty = 10)
#' }
resmush_url <- function(url, outfile = file.path(tempdir(), basename(url)),
qlty = 92, verbose = FALSE, exif_preserve = FALSE) {
# High level function for vectors

# Check lengths
l1 <- length(url)
l2 <- length(outfile)

if (l1 != l2) {
cli::cli_abort(paste0(
"Lengths of {.arg url} and {.arg outfile}",
"should be the same ({l1} vs. {l2})"
))
}


# Once checked call single
iter <- seq_len(l1)

# Make unique paths
outfile <- make_unique_paths(outfile)

res_vector <- lapply(iter, function(x) {
df <- resmush_url_single(
url[x], outfile[x],
qlty, verbose, exif_preserve
)
df
})

# Bind and output
df_end <- do.call("rbind", res_vector)

return(invisible(df_end))
}



resmush_url_single <- function(url,
outfile = file.path(tempdir(), basename(url)),
qlty = 92, verbose = FALSE,
exif_preserve = FALSE) {
# Master table with results
res <- data.frame(
src_img = url, dest_img = NA, src_size = NA,
55 changes: 55 additions & 0 deletions R/utils.R
Original file line number Diff line number Diff line change
@@ -5,6 +5,61 @@ make_object_size <- function(x) {
x
}

# Handle names
make_unique_paths <- function(x, res) {
dir_file <- dirname(x)
base_names <- basename(x)

res <- character(length = length(base_names))
iter <- seq_len(length(base_names))


for (i in iter) {
this_file <- base_names[i]

if (!this_file %in% res) {
res[i] <- this_file
next
}
newname <- name_sans_ext(this_file)
ext <- my_file_ext(this_file)

for (j in seq(1, 100)) {
f <- paste0(newname, "_", j, ext)
if (!f %in% res) {
res[i] <- f
break
}
}
}

file.path(dir_file, res)
}

name_sans_ext <- function(x) {
sans_ext <- vapply(x, FUN = function(y) {
name_parts <- unlist(strsplit(y, ".", fixed = TRUE))

paste0(name_parts[-length(name_parts)], collapse = ".")
}, FUN.VALUE = character(1))

unname(sans_ext)
}



my_file_ext <- function(x) {
ext_only <- vapply(x, FUN = function(y) {
name_parts <- unlist(strsplit(y, ".", fixed = TRUE))

paste0(".", name_parts[length(name_parts)])
}, FUN.VALUE = character(1))

unname(ext_only)
}



# Utils for testing
load_inst_to_temp <- function(file) {
f <- system.file(paste0("extimg/", file), package = "resmush")
11 changes: 6 additions & 5 deletions codemeta.json
Original file line number Diff line number Diff line change
@@ -2,8 +2,8 @@
"@context": "https://doi.org/10.5063/schema/codemeta-2.0",
"@type": "SoftwareSourceCode",
"identifier": "resmush",
"description": "What the package does (one paragraph).",
"name": "resmush: What the Package Does (One Line, Title Case)",
"description": "Compress local and online images using the 'reSmush.it' API service <https://resmush.it/>.",
"name": "resmush: Optimize and Compress Image Files with 'reSmush.it'",
"relatedLink": "https://dieghernan.github.io/resmush/",
"codeRepository": "https://github.com/dieghernan/resmush",
"issueTracker": "https://github.com/dieghernan/resmush/issues",
@@ -14,7 +14,7 @@
"name": "R",
"url": "https://r-project.org"
},
"runtimePlatform": "R version 4.3.2 (2023-10-31 ucrt)",
"runtimePlatform": "R version 4.3.2 (2023-10-31)",
"author": [
{
"@type": "Person",
@@ -107,9 +107,10 @@
},
"SystemRequirements": null
},
"fileSize": "447.577KB",
"fileSize": "457.901KB",
"releaseNotes": "https://github.com/dieghernan/resmush/blob/master/NEWS.md",
"readme": "https://github.com/dieghernan/resmush/blob/main/README.md",
"contIntegration": ["https://github.com/dieghernan/resmush/actions/workflows/check-full.yaml", "https://app.codecov.io/gh/dieghernan/resmush"],
"developmentStatus": "https://www.repostatus.org/#wip"
"developmentStatus": "https://www.repostatus.org/#wip",
"keywords": ["compress-images", "optimize-images", "r", "r-package", "resmushit"]
}
6 changes: 3 additions & 3 deletions inst/schemaorg.json
Original file line number Diff line number Diff line change
@@ -12,14 +12,14 @@
"familyName": "Hernangómez",
"givenName": "Diego"
},
"description": "What the package does (one paragraph).",
"description": "Compress local and online images using the 'reSmush.it' API service <https://resmush.it/>.",
"license": "https://spdx.org/licenses/MIT",
"name": "resmush: What the Package Does (One Line, Title Case)",
"name": "resmush: Optimize and Compress Image Files with 'reSmush.it'",
"programmingLanguage": {
"type": "ComputerLanguage",
"name": "R",
"url": "https://r-project.org"
},
"runtimePlatform": "R version 4.3.2 (2023-10-31 ucrt)",
"runtimePlatform": "R version 4.3.2 (2023-10-31)",
"version": "0.0.0.9000"
}
Loading