## useful functions
get_file_size <- function(path) {
  temp <- file.info(path)$size
  return(temp)
}

imageEntropy<-function(histogram){
  nonzeroCounts<-histogram$counts[histogram$counts > 0]
  probs<-nonzeroCounts / sum(nonzeroCounts)
  -sum(probs * log2(probs))
}

imageToIntensity<-function(image, method="perceptual"){
  if(method == "mean"){
    (image[,,1] + image[,,2] + image[,,3]) / 3
  } else if(method == "perceptual") {
    (image[,,1] * .3) + (image[,,2] * .59) + (image[,,3] * .11)
  } else {
    simpleError(paste("Unknown imageToIntensity method:", method))
  }
}

#based on https://rdrr.io/rforge/CulturalAnalytics/man/imageEntropy.html
get_png_entropy <- function(path) {
  img <- readPNG(path)
  histogram<-hist(imageToIntensity(img), breaks=0:255/255, plot=FALSE)
  entropy<-imageEntropy(histogram)
  return(entropy)
}

Complexity measures

Compute some measures of complexity for each image:

#image paths
base_path <- here("stimulus_selection","fractals")
image_path <- here(base_path,"images")

d <- data.frame(
  file_name =  list.files(path = image_path),
  path = image_path
) %>%
  mutate(
    rel_path = paste0("images/",file_name),
    full_path = here(image_path,file_name),
    git_path = paste0("https://raw.githubusercontent.com/mzettersten/mb5-stimulus/master/stimulus_selection/fractals/images/",file_name))

d <- d %>%
  mutate(file_size = lapply(full_path, function(path) get_file_size(path))) %>%
  mutate(
    image_html = paste('<img src="',git_path,'" style="width:50px" class="center"></image>',sep="")
  ) %>%
  mutate(file_size = as.numeric(file_size)) %>%
  mutate(compression_complexity = as.numeric(lapply(full_path, function(path) img_complexity(path)))) %>%
  mutate(entropy = as.numeric(lapply(full_path, function(path) get_png_entropy(path))))

Plot

Plot the various fractals based on a couple of complexity metrics

ggplot(d, aes(x=compression_complexity,y=entropy,image=full_path)) +
  #geom_point(stat="identity")+
  geom_image(size=.06)+
  xlab("Compression Complexity")+
  ylab("Image Entropy")+
  theme_cowplot()

Table

Table to sort fractals by various complexity metrics

d %>%
  select(-path, -full_path,-git_path) %>%
  DT::datatable(escape=F)
sessionInfo()
## R version 4.1.1 (2021-08-10)
## Platform: x86_64-apple-darwin17.0 (64-bit)
## Running under: macOS Catalina 10.15.7
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] DT_0.19            cowplot_1.1.1      knitr_1.34         imagefluency_0.2.3
##  [5] png_0.1-7          here_1.0.1         forcats_0.5.1      stringr_1.4.0     
##  [9] dplyr_1.0.9        purrr_0.3.4        readr_2.0.1        tidyr_1.2.0       
## [13] tibble_3.1.7       tidyverse_1.3.1    ggimage_0.2.9      ggplot2_3.3.5     
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.7         lubridate_1.7.10   assertthat_0.2.1   rprojroot_2.0.2   
##  [5] digest_0.6.28      utf8_1.2.2         R6_2.5.1           cellranger_1.1.0  
##  [9] backports_1.2.1    reprex_2.0.1       evaluate_0.14      highr_0.9         
## [13] httr_1.4.2         pillar_1.7.0       ggfun_0.0.4        yulab.utils_0.0.4 
## [17] rlang_1.0.2        readxl_1.3.1       rstudioapi_0.13    jquerylib_0.1.4   
## [21] R.oo_1.25.0        R.utils_2.12.0     magick_2.7.3       rmarkdown_2.11    
## [25] labeling_0.4.2     htmlwidgets_1.5.4  munsell_0.5.0      broom_0.8.0       
## [29] compiler_4.1.1     modelr_0.1.8       xfun_0.26          pkgconfig_2.0.3   
## [33] gridGraphics_0.5-1 htmltools_0.5.2    tidyselect_1.1.2   fansi_0.5.0       
## [37] crayon_1.4.1       tzdb_0.1.2         dbplyr_2.1.1       withr_2.4.2       
## [41] R.methodsS3_1.8.2  grid_4.1.1         jsonlite_1.7.2     gtable_0.3.0      
## [45] lifecycle_1.0.1    DBI_1.1.1          magrittr_2.0.1     scales_1.2.0      
## [49] cli_3.3.0          stringi_1.7.4      fs_1.5.0           xml2_1.3.2        
## [53] bslib_0.3.0        ellipsis_0.3.2     generics_0.1.2     vctrs_0.4.1       
## [57] tools_4.1.1        ggplotify_0.1.0    glue_1.6.2         crosstalk_1.1.1   
## [61] hms_1.1.0          fastmap_1.1.0      yaml_2.2.1         colorspace_2.0-2  
## [65] rvest_1.0.1        haven_2.4.3        sass_0.4.0