## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 7, fig.height = 5 ) ## ----eval = FALSE------------------------------------------------------------- # # install.packages("remotes") # remotes::install_github("shawntz/charisma") ## ----eval = FALSE------------------------------------------------------------- # install.packages("charisma") # Coming soon! ## ----setup-------------------------------------------------------------------- library(charisma) ## ----------------------------------------------------------------------------- img_path <- system.file( "extdata", "Tangara_fastuosa_LACM60421.png", package = "charisma" ) ## ----eval = FALSE------------------------------------------------------------- # result <- charisma( # img_path, # threshold = 0.0, # interactive = FALSE, # plot = FALSE, # pavo = FALSE # ) ## ----eval = FALSE------------------------------------------------------------- # plot(result) ## ----eval = FALSE------------------------------------------------------------- # # Control preprocessing with bins and cutoff parameters # result <- charisma( # img_path, # bins = 4, # Bins per RGB channel (4^3 = 64 clusters) # cutoff = 20 # Euclidean distance threshold # ) ## ----------------------------------------------------------------------------- # Example: Classify a single RGB color color2label(c(255, 0, 0)) # Red color2label(c(0, 0, 255)) # Blue color2label(c(255, 255, 0)) # Yellow ## ----eval = FALSE------------------------------------------------------------- # result <- charisma( # img_path, # interactive = TRUE, # threshold = 0.0 # ) ## ----eval = FALSE------------------------------------------------------------- # # No threshold - keep all colors # result_0 <- charisma(img_path, threshold = 0.0) # # # 5% threshold - remove colors < 5% of image # result_5 <- charisma(img_path, threshold = 0.05) # # # 10% threshold - remove colors < 10% of image # result_10 <- charisma(img_path, threshold = 0.10) ## ----eval = FALSE------------------------------------------------------------- # # Save with automatic timestamping # out_dir <- file.path("~", "Documents", "charisma_outputs") # # result <- charisma( # img_path, # threshold = 0.05, # logdir = out_dir # ) ## ----eval = FALSE------------------------------------------------------------- # # Load saved object # obj <- system.file("extdata", "Tangara_fastuosa.RDS", package = "charisma") # obj <- readRDS(obj) # # # Re-analyze with different threshold # result2 <- charisma2( # obj, # new.threshold = 0.10 # ) # # # Revert to specific state # result3 <- charisma2( # obj, # which.state = "merge", # state.index = 2 # ) ## ----eval = FALSE------------------------------------------------------------- # # Get unique colors present # unique_colors <- unique(result$classification) # # # Get number of colors (k) # k <- length(unique_colors) # # # Get color proportions # color_props <- result$color_mask_LUT_filtered # # # Create presence/absence matrix # summary <- summarize(result) ## ----eval = FALSE------------------------------------------------------------- # # View default CLUT # View(charisma::clut) # # # Use custom CLUT # my_clut <- charisma::clut # Start with default # # # ... modify HSV ranges ... # result <- charisma(img_path, clut = my_clut) # # # Validate custom CLUT (ensures complete HSV coverage) # validation <- validate(clut = my_clut) ## ----eval = FALSE------------------------------------------------------------- # # Process multiple species # species_colors <- lapply(image_paths, function(img) { # result <- charisma(img, threshold = 0.05) # summarize(result) # }) # # # Combine into data frame # color_matrix <- do.call(rbind, species_colors) # # # Use with geiger, phytools, pavo, etc. # library(geiger) # library(phytools) # # # Fit evolutionary models # fit_er <- fitDiscrete( # phylogeny, # color_matrix[, "blue"], # model = "ER" # ) # # fit_ard <- fitDiscrete( # phylogeny, # color_matrix[, "blue"], # model = "ARD" # ) # # # Reconstruct ancestral states # ancestral <- ace( # color_matrix[, "blue"], # phylogeny, # type = "discrete" # )