ggimg_image_ggplot2.R

rm(list = ls())
#install.packages("ggimg")
library(ggimg)

## Warning: 程辑包'ggimg'是用R版本4.1.3 来建造的

library(ggplot2)
library(dplyr)

## Warning: 程辑包'dplyr'是用R版本4.1.3 来建造的

## 
## 载入程辑包：'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

posters <- mutate(posters,
                  path = file.path(system.file("extdata", package="ggimg"), img)
)
posters

## # A tibble: 50 x 12
##     year title   img   rating_count  gross genre rating runtime stars metacritic
##    <dbl> <chr>   <chr>        <dbl>  <dbl> <chr> <chr>    <dbl> <dbl>      <dbl>
##  1  2018 Incred~ 2018~       226170 6.09e8 Anim~ PG         118   7.6         NA
##  2  2019 The Li~ 2019~       168828 5.40e8 Anim~ PG         118   6.9         55
##  3  2016 Findin~ 2016~       224980 4.86e8 Anim~ PG          97   7.3         NA
##  4  2004 Shrek 2 2004~       398797 4.36e8 Anim~ PG          93   7.2         NA
##  5  2019 Toy St~ 2019~       159927 4.33e8 Anim~ G          100   7.8         NA
##  6  2010 Toy St~ 2010~       719003 4.15e8 Anim~ G          103   8.3         NA
##  7  2013 Frozen  2013~       545450 4.01e8 Anim~ PG         102   7.5         NA
##  8  2003 Findin~ 2003~       903078 3.81e8 Anim~ G          100   8.1         NA
##  9  2016 The Se~ 2016~       173603 3.68e8 Anim~ PG          87   6.5         NA
## 10  2013 Despic~ 2013~       355343 3.68e8 Anim~ PG          98   7.3         NA
## # ... with 40 more rows, and 2 more variables: description <chr>, path <chr>

View(posters)
ggplot(posters) +
  geom_rect_img(aes(
    xmin = year - 0.5,
    xmax = year + 0.5,
    ymin = stars - 0.5,
    ymax = stars + 0.5,
    img = path
  )) +
  theme_minimal()

############################
ggplot(posters) +
  geom_point_img(aes(
    x = year,
    y = stars,
    img = path
  ), size = 1) +
  theme_minimal()

##############################Further Customization
library(jpeg)

posters$img_array <- lapply(
  posters$path, function(path) readJPEG(path)
)
width <- 6L  # border width in pixels
posters$img_array <- lapply(
  posters$img_array, function(img) {
    # set all RGB channels on the border of the
    # image to 0 to produce a black border
    img[seq(width), , ] <- 0
    img[, seq(width), ] <- 0
    img[nrow(img) - seq(width) + 1L, , ] <- 0
    img[, ncol(img) - seq(width) + 1L, ] <- 0
    img
  }
)
posters

## # A tibble: 50 x 13
##     year title   img   rating_count  gross genre rating runtime stars metacritic
##    <dbl> <chr>   <chr>        <dbl>  <dbl> <chr> <chr>    <dbl> <dbl>      <dbl>
##  1  2018 Incred~ 2018~       226170 6.09e8 Anim~ PG         118   7.6         NA
##  2  2019 The Li~ 2019~       168828 5.40e8 Anim~ PG         118   6.9         55
##  3  2016 Findin~ 2016~       224980 4.86e8 Anim~ PG          97   7.3         NA
##  4  2004 Shrek 2 2004~       398797 4.36e8 Anim~ PG          93   7.2         NA
##  5  2019 Toy St~ 2019~       159927 4.33e8 Anim~ G          100   7.8         NA
##  6  2010 Toy St~ 2010~       719003 4.15e8 Anim~ G          103   8.3         NA
##  7  2013 Frozen  2013~       545450 4.01e8 Anim~ PG         102   7.5         NA
##  8  2003 Findin~ 2003~       903078 3.81e8 Anim~ G          100   8.1         NA
##  9  2016 The Se~ 2016~       173603 3.68e8 Anim~ PG          87   6.5         NA
## 10  2013 Despic~ 2013~       355343 3.68e8 Anim~ PG          98   7.3         NA
## # ... with 40 more rows, and 3 more variables: description <chr>, path <chr>,
## #   img_array <list>

ggplot(posters) +
  geom_point_img(aes(
    x = year,
    y = stars,
    img = img_array
  ), size = 1) +
  theme_minimal()

############https://github.com/statsmaths/ggimg