R/ImaginR.R
In PLStenger/ImaginR: Delimit and Characterize Color Phenotype of the Pearl Oyster
Defines functions
Forest_cover
OutPutResult_microscopy
OneRow_microscopy
OutPutResult
OneRow
ColorPhenotype
PictureResults
print.myclass
hex2rgb
Documented in
ColorPhenotype
Forest_cover
hex2rgb
OneRow
OutPutResult
PictureResults
print.myclass
#' Give RGB color code from HEX color code
#'
#' Give a RGB color code matrix from HEX color code vector.
#'
#' @param color.vector HEX code in a vector
#' @return RGB code color
#' @examples
#' # RGB color code of "Alice Blue" color:
#' hex2rgb("#f0f8ff")
#' # RGB color code of "Red" color:
#' hex2rgb("#ff0000")
#' # RGB color code of "Green" color:
#' hex2rgb("#008000")
#'@export
hex2rgb <- function(color.vector) {
resultat <- matrix( NA, ncol=3, nrow=length(color.vector), dimnames=list( NULL, c( "R", "G", "B")))
resultat[,"R"] <- strtoi( substr(color.vector, 2, 3), 16L)
resultat[,"G"] <- strtoi( substr(color.vector, 4, 5), 16L)
resultat[,"B"] <- strtoi( substr(color.vector, 6, 7), 16L)
resultat
}
#' Usefull for others functions
#'
#' Function to print the results (usefull for the others functions)
#'
#' @param x the results
#' @param ... if necessary
#' @return the header of the results
#' @export
print.myclass <- function(x, ...){
cat(x$header,"\n\n")
cat("Hexadecimal code: ", sprintf("%s: %s", names(x$const), x$const), "\n\n")
cat("HSV code:\n")
print(x$data, ...)
}
#' Give HEX and HSV color code
#'
#' To get the mean of the HEX color code and the HSV color code of the picture
#' @param picture The picture uploaded by load.image()
#' @return results
#' the HEX and HSV color code
#' @details
#' \itemize{
#' \item{h : the hue of the hsv color code}
#' \item{s : the saturation of the hsv color code}
#' \item{v : the value of the hsv color code}
#' \item{hex : the hexadecimal color code}
#' }
#' @examples
#' fpath <- system.file('extdata/image.jpg',package='ImaginR')
#' picture <- load.image(fpath)
#' PictureResults(picture)
#' @export
PictureResults<-function(picture){
# picture <- load.image("p.jpg")
#picture.blurry <- isoblur(picture,5) # blur picture to averaging the neighboring pixels
#save.image(picture.blurry, "blur_picture.jpeg") # save the new picture
# picture <- readJPEG("blur_picture.jpeg") # read it
pictureDm <- dim(picture) # dimension it
# create a new data.frame with these datas
pictureRGB <- data.frame(
R = as.vector(picture[,,1]),
G = as.vector(picture[,,2]),
B = as.vector(picture[,,3])
)
# "rgb it" the get the HEX color code
pictureHEX <- rgb(pictureRGB[,"R"], pictureRGB[,"G"], pictureRGB[,"B"], maxColorValue=1)
# remove <- read.table("remove.txt", sep=",") # this table contain all white HEX color code
remove <- system.file("extdata", "remove.txt", package="ImaginR")
remove <-trimws(as.vector(t(remove))) #trimws to fix the bug with spaces and comas into the txt file
pictureHEX <- pictureHEX [! pictureHEX %in% remove] # remove the white color of the background of the picture
# hex2rgb : to give RGB color code from HEX color code
hex2rgb <- function(color.vector) {
resultat <- matrix( NA, ncol=3, nrow=length(color.vector), dimnames=list( NULL, c( "R", "G", "B")))
resultat[,"R"] <- strtoi( substr(color.vector, 2, 3), 16L)
resultat[,"G"] <- strtoi( substr(color.vector, 4, 5), 16L)
resultat[,"B"] <- strtoi( substr(color.vector, 6, 7), 16L)
resultat
}
RGB0 <- matrix(hex2rgb(pictureHEX), ncol=3, byrow=F) # creat a matrix with the new datas
colnames(RGB0) <- c("R", "G", "B") # give columns a name
mean.color <- as.data.frame(RGB0) # create new data.frame to averaging the colors
rm <- mean(mean.color$R) # averaging the red channel color
rmr <- round(rm, 0)
gm <- mean( mean.color$G) # averaging the green channel color
gmr <- round(gm, 0)
bm <- mean(mean.color$B) # averaging the blue channel color
bmr <- round(bm, 0)
color <- rgb(rmr, gmr, bmr, maxColorValue=255) # convert code 1
hsv <-rgb2hsv(col2rgb(color)) # convert code 2
# give a marvelous made
header <- "The average color of the picture"
results <- list(header = header,
const = list(color=color),
data = list(hsv = hsv))
class(results) <- "myclass"
return(results)
}
#' Give the color phenotype of the pearl oyster's
#'
#' Returns the color phenotype of the pearl oyster's inner shell (\emph{Pinctada margaritifera})
#' @param picture The picture uploaded by load.image()
#' @return The color phenotype of the pearl oyster's inner shell
#' @examples
#' fpath <- system.file('extdata/image.jpg',package='ImaginR')
#' picture <- load.image(fpath)
#' ColorPhenotype(picture)
#' @export
ColorPhenotype <- function(picture){
#picture <- load.image("p.jpg")
#picture.blurry <- isoblur(picture,5)
#save.image(picture.blurry, "blur_picture.jpeg")
#picture <- readJPEG("blur_picture.jpeg")
pictureDm <- dim(picture)
pictureRGB <- data.frame(
R = as.vector(picture[,,1]),
G = as.vector(picture[,,2]),
B = as.vector(picture[,,3])
)
pictureHEX <- rgb(pictureRGB[,"R"], pictureRGB[,"G"], pictureRGB[,"B"], maxColorValue=1)
remove <- system.file("extdata", "remove.txt", package="ImaginR")
remove <-trimws(as.vector(t(remove)))
pictureHEX <- pictureHEX [! pictureHEX %in% remove]
hex2rgb <- function(color.vector) {
resultat <- matrix( NA, ncol=3, nrow=length(color.vector), dimnames=list( NULL, c( "R", "G", "B")))
resultat[,"R"] <- strtoi( substr(color.vector, 2, 3), 16L)
resultat[,"G"] <- strtoi( substr(color.vector, 4, 5), 16L)
resultat[,"B"] <- strtoi( substr(color.vector, 6, 7), 16L)
resultat
}
RGB0 <- matrix(hex2rgb(pictureHEX), ncol=3, byrow=F)
colnames(RGB0) <- c("R", "G", "B")
mean.color <- as.data.frame(RGB0)
rm <- mean(mean.color$R)
rmr <- round(rm, 0)
gm <- mean( mean.color$G)
gmr <- round(gm, 0)
bm <- mean(mean.color$B)
bmr <- round(bm, 0)
color <- rgb(rmr, gmr, bmr, maxColorValue=255)
hsv <-rgb2hsv(col2rgb(color))
# Import the hsv data of 30 valves of 5 Pinctada margaritifera/color phenotype wich are come from Rikitea
# (Gambier's archipelago) and from a same reproduction.
# The brood were choseen for they coloration
# There are 10 valves by color phenotypes (red, yellow and green)
# To see some individuals, go to https://plstenger.github.io/
# res <- read.csv("res.csv", header=T, sep=';')
# res
# re-format the datas
# h <- res$h
# s <- res$s
# v <- res$v
# phe <- res$phenotype
# dat <- data.frame(phe, h, s, v)
# dat
# Subset the datas by phenotypes and extract the range by maximum + standard error and minimum + standard error:
# For red phenotype
# datR <- subset(dat, phe == "R")
# minR <- min(datR$h)
# maxR <- max(datR$h)
# sdR <- sd(datR$h)
# R1 <- maxR + (sdR/2) - 0.002499 # here I substract 0.002499 to avoid conflict with the largeless yellow phenotype's range
# R2 <- minR + (sdR/2)
# For yellow phenotype ("J" for Jaune in French)
# datJ <- subset(dat, phe == "J")
# minJ <- min(datJ$h)
# maxJ <- max(datJ$h)
# sdJ <- sd(datJ$h)
# J1 <- maxJ + (sdJ)
# J2 <- minJ - (sdJ/2)
# For green phenotype ("V" for Vert in French)
# datV <- subset(dat, phe == "V")
# minV <- min(datV$h)
# maxV <- max(datV$h)
# sdV <- sd(datV$h)
# V1 <- maxV + (sdV)
# V2 <- minV - (sdV)
R1 <- 0.1625770
R2 <- 0.0000000 # 0.02340927
J1 <- 0.2790814
J2 <- 0.1625774
V1 <- 0.5637775
V2 <- 0.3215928
# What's color phenotype is it ?
phenotype <- if ((hsv[1,] >= 0) & (hsv[1,] <= R1)){
"Red phenotype"
} else if ((hsv[1,] >= 1-R1) & (hsv[1,] <= 1)){
"Red phenotype"
} else if ((hsv[1,] >= J2) & (hsv[1,] <= J1)){
"Yellow phenotype"
} else if ((hsv[1,] >= V2) & (hsv[1,] <= V1)){
"Green phenotype"
}else {
"other phenotype"
}
return(phenotype)
}
#' Get phenotype, HEX and HSV color code for one picture
#'
#' Get results in one row
#' @param picture The picture uploaded by load.image()
#' @return The HEX and HSV color code and the color phenotype of the pearl oyster's inner shell for one image in one row
#' @details
#' In header:
#' \itemize{
#' \item{id : the name of your pictures}
#' \item{h : the hue of the hsv color code}
#' \item{s : the saturation of the hsv color code}
#' \item{v : the value of the hsv color code}
#' \item{hex : the hexadecimal color code}
#' \item{phenotype : returns the color phenotype of the pearl oyster's inner shell (\emph{Pinctada margaritifera})}
#' }
#' @examples
#' fpath <- system.file('extdata/image.jpg',package='ImaginR')
#' picture <- load.image(fpath)
#' OneRow(picture)
#' @export
OneRow <- function(picture){
pictureDm <- dim(picture) # dimension it
# create a new data.frame with these datas
pictureRGB <- data.frame(
R = as.vector(picture[,,1]),
G = as.vector(picture[,,2]),
B = as.vector(picture[,,3])
)
# "rgb it" the get the HEX color code
pictureHEX <- rgb(pictureRGB[,"R"], pictureRGB[,"G"], pictureRGB[,"B"], maxColorValue=1)
# remove <- read.table("remove.txt", sep=",") # this table contain all white HEX color code
remove <- system.file("extdata", "remove.txt", package="ImaginR")
remove <-trimws(as.vector(t(remove))) #trimws to fix the bug with spaces and comas into the txt file
pictureHEX <- pictureHEX [! pictureHEX %in% remove] # remove the white color of the background of the picture
# hex2rgb : to give RGB color code from HEX color code
hex2rgb <- function(color.vector) {
resultat <- matrix( NA, ncol=3, nrow=length(color.vector), dimnames=list( NULL, c( "R", "G", "B")))
resultat[,"R"] <- strtoi( substr(color.vector, 2, 3), 16L)
resultat[,"G"] <- strtoi( substr(color.vector, 4, 5), 16L)
resultat[,"B"] <- strtoi( substr(color.vector, 6, 7), 16L)
resultat
}
RGB0 <- matrix(hex2rgb(pictureHEX), ncol=3, byrow=F) # creat a matrix with the new datas
colnames(RGB0) <- c("R", "G", "B") # give columns a name
mean.color <- as.data.frame(RGB0) # create new data.frame to averaging the colors
rm <- mean(mean.color$R) # averaging the red channel color
rmr <- round(rm, 0)
gm <- mean( mean.color$G) # averaging the green channel color
gmr <- round(gm, 0)
bm <- mean(mean.color$B) # averaging the blue channel color
bmr <- round(bm, 0)
color <- rgb(rmr, gmr, bmr, maxColorValue=255) # convert code 1
hsv <-rgb2hsv(col2rgb(color)) # convert code 2
R1 <- 0.162577
R2 <- 0.0000000 # 0.02340927
J1 <- 0.2790814
J2 <- 0.1625774
V1 <- 0.5637775
V2 <- 0.3215928
# What's color phenotype is it ?
phenotype <- if ((hsv[1,] >= 0) & (hsv[1,] <= R1)){
"Red phenotype"
} else if ((hsv[1,] >= 1-R1) & (hsv[1,] <= 1)){
"Red phenotype"
} else if ((hsv[1,] >= J2) & (hsv[1,] <= J1)){
"Yellow phenotype"
} else if ((hsv[1,] >= V2) & (hsv[1,] <= V1)){
"Green phenotype"
}else {
"other phenotype"
}
# get results in one row
mhsv <- matrix(hsv[,1], dimnames = NULL)
OneRow <- c(c(mhsv), color, phenotype)
OneRow <- c(OneRow)
return(OneRow)
}
#' Get phenotype, HEX and HSV color code for all pictures
#'
#' Get results in a .txt file, .csv file and in R data.frame
#' This function does what all the others functions do in a very simple way. Just put your images in your working directory (don't forget to getwd() !), do library this package and paste this only code: "OutPutResult()". You will get the results into your consol and in a results.csv file in your working directory.
#' @param id The name of the pictures in your working directory
#' @return The HEX and HSV color code and the color phenotype of the pearl oyster's inner shell for all images in a results.csv file
#' @details
#' In results.csv:
#' \itemize{
#' \item{id : the name of your pictures}
#' \item{h : the hue of the hsv color code}
#' \item{s : the saturation of the hsv color code}
#' \item{v : the value of the hsv color code}
#' \item{hex : the hexadecimal color code}
#' \item{phenotype : returns the color phenotype of the pearl oyster's inner shell (\emph{Pinctada margaritifera})}
#' }
#' @export
OutPutResult <- function(id){
id <- list.files(pattern = ".jpg")
for(i in id){
sink("OutPutAnalysis.txt", append=TRUE)
picture <- load.image(i)
a <- OneRow(picture)
print(a)
sink()
sink()
sink()
}
id <- list.files(pattern = ".jpg")
res <- read.table("OutPutAnalysis.txt")
dat <- data.frame(id, res$V2, res$V3, res$V4, res$V5, res$V6)
colnames(dat) <- c("id", "h", "s", "v", "hex","phenotype")
write.table(dat, file = "results.csv", sep=";")
return(dat)
}
#' Get phenotype, HEX and HSV color code for one picture
#'
#' Get results in one row
#' @param picture The picture uploaded by load.image()
#' @return The HEX and HSV color code and the color phenotype of the pearl oyster's inner shell for one image in one row
#' @details
#' In header:
#' \itemize{
#' \item{id : the name of your pictures}
#' \item{h : the hue of the hsv color code}
#' \item{s : the saturation of the hsv color code}
#' \item{v : the value of the hsv color code}
#' \item{hex : the hexadecimal color code}
#' \item{phenotype : returns the color phenotype of the pearl oyster's inner shell (\emph{Pinctada margaritifera})}
#' }
#' @examples
#' fpath <- system.file('extdata/image.jpg',package='ImaginR')
#' picture <- load.image(fpath)
#' OneRow_microscopy(picture)
#' @export
OneRow_microscopy <- function(picture){
pictureDm <- dim(picture) # dimension it
# create a new data.frame with these datas
pictureRGB <- data.frame(
R = as.vector(picture[,,1]),
G = as.vector(picture[,,2]),
B = as.vector(picture[,,3])
)
# "rgb it" the get the HEX color code
pictureHEX <- rgb(pictureRGB[,"R"], pictureRGB[,"G"], pictureRGB[,"B"], maxColorValue=1)
# remove <- read.table("remove.txt", sep=",") # this table contain all white HEX color code
remove <- system.file("extdata", "remove_black.txt", package="ImaginR")
remove <-trimws(as.vector(t(remove))) #trimws to fix the bug with spaces and comas into the txt file
pictureHEX <- pictureHEX [! pictureHEX %in% remove] # remove the white color of the background of the picture
# hex2rgb : to give RGB color code from HEX color code
hex2rgb <- function(color.vector) {
resultat <- matrix( NA, ncol=3, nrow=length(color.vector), dimnames=list( NULL, c( "R", "G", "B")))
resultat[,"R"] <- strtoi( substr(color.vector, 2, 3), 16L)
resultat[,"G"] <- strtoi( substr(color.vector, 4, 5), 16L)
resultat[,"B"] <- strtoi( substr(color.vector, 6, 7), 16L)
resultat
}
RGB0 <- matrix(hex2rgb(pictureHEX), ncol=3, byrow=F) # creat a matrix with the new datas
colnames(RGB0) <- c("R", "G", "B") # give columns a name
mean.color <- as.data.frame(RGB0) # create new data.frame to averaging the colors
rm <- mean(mean.color$R) # averaging the red channel color
rmr <- round(rm, 0)
gm <- mean( mean.color$G) # averaging the green channel color
gmr <- round(gm, 0)
bm <- mean(mean.color$B) # averaging the blue channel color
bmr <- round(bm, 0)
color <- rgb(rmr, gmr, bmr, maxColorValue=255) # convert code 1
hsv <-rgb2hsv(col2rgb(color)) # convert code 2
O1 <- 0.1
O2 <- 0.0000000
EB1 <- 0.65
EB2 <- 0.54
LG1 <- 0.39
LG2 <- 0.35
LY1 <- 0.16
LY2 <- 0.14
FGC1 <- 0.139
FGC2 <- 0.11
# What's color phenotype is it ?
phenotype <- if ((hsv[1,] >= 0) & (hsv[1,] <= O1)){
"Orange"
} else if ((hsv[1,] >= 1-O1) & (hsv[1,] <= 1)){
"Orange-reddish"
} else if ((hsv[1,] >= EB2) & (hsv[1,] <= EB1)){
"Electric blue"
} else if ((hsv[1,] >= LG2) & (hsv[1,] <= LG1)){
"Light green"
} else if ((hsv[1,] >= LY2) & (hsv[1,] <= LY1)){
"Light yellow"
} else if ((hsv[1,] >= FGC2) & (hsv[1,] <= FGC1)){
"Fluo green"
}else {
"Other coloration"
}
# get results in one row
mhsv <- matrix(hsv[,1], dimnames = NULL)
OneRow_microscopy <- c(c(mhsv), color, phenotype)
OneRow_microscopy <- c(OneRow_microscopy)
return(OneRow_microscopy)
}
#' Get phenotype, HEX and HSV color code for all pictures
#'
#' Get results in a .txt file, .csv file and in R data.frame
#' This function does what all the others functions do in a very simple way. Just put your images in your working directory (don't forget to getwd() !), do library this package and paste this only code: "OutPutResult()". You will get the results into your consol and in a results.csv file in your working directory.
#' @param id The name of the pictures in your working directory
#' @return The HEX and HSV color code and the color phenotype of the pearl oyster's inner shell for all images in a results.csv file
#' @details
#' In results.csv:
#' \itemize{
#' \item{id : the name of your pictures}
#' \item{h : the hue of the hsv color code}
#' \item{s : the saturation of the hsv color code}
#' \item{v : the value of the hsv color code}
#' \item{hex : the hexadecimal color code}
#' \item{phenotype : returns the color phenotype of the pearl oyster's inner shell (\emph{Pinctada margaritifera})}
#' }
#' @export
OutPutResult_microscopy <- function(id){
id <- list.files(pattern = ".jpg")
for(i in id){
sink("OutPutAnalysis_microscopy.txt", append=TRUE)
picture <- load.image(i)
a <- OneRow_microscopy(picture)
print(a)
sink()
sink()
sink()
}
id <- list.files(pattern = ".jpg")
res <- read.table("OutPutAnalysis_microscopy.txt")
dat <- data.frame(id, res$V2, res$V3, res$V4, res$V5, res$V6)
colnames(dat) <- c("id", "h", "s", "v", "hex","phenotype")
write.table(dat, file = "results_microscopy.csv", sep=";")
return(dat)
}
#' Give the percent of forest covarage
#'
#' Give the percent of forest covarage by comparing two pictures : the first one (x) is the original (aerial) image and the second (y) is the same image but without the soil (only forest cover is keep)
#'
#' @param x path of the original image
#' @param y path of the same image but without the soil (only forest cover is keep)
#' @return Percentage of forest cover (0 to 100%)
#' @examples
#' Forest_cover("A1_DJI_0026_cleaned_empty_before.JPG", "A1_DJI_0026_cleaned_empty.JPG")
#' 26.82175
#'@export
Forest_cover <- function(x, y) {
picture <- load.image(y)
pictureDm <- dim(picture) # dimension it
# create a new data.frame with these datas
pictureRGB <- data.frame(
R = as.vector(picture[,,1]),
G = as.vector(picture[,,2]),
B = as.vector(picture[,,3])
)
# "rgb it" the get the HEX color code
pictureHEX <- rgb(pictureRGB[,"R"], pictureRGB[,"G"], pictureRGB[,"B"], maxColorValue=1)
# remove <- read.table("remove.txt", sep=",") # this table contain all white HEX color code
remove <- system.file("extdata", "remove.txt", package="ImaginR")
remove <- read.table(remove, sep=",")
remove <-trimws(as.vector(t(remove))) #trimws to fix the bug with spaces and comas into the txt file
pictureHEX <- pictureHEX [! pictureHEX %in% remove] # remove the white color of the background of the picture
picture_02 <- load.image(x)
pictureDm_02 <- dim(picture_02) # dimension it
# create a new data.frame with these datas
pictureRGB_02 <- data.frame(
R = as.vector(picture_02[,,1]),
G = as.vector(picture_02[,,2]),
B = as.vector(picture_02[,,3])
)
# "rgb it" the get the HEX color code
pictureHEX_02 <- rgb(pictureRGB_02[,"R"], pictureRGB_02[,"G"], pictureRGB_02[,"B"], maxColorValue=1)
# remove <- read.table("remove.txt", sep=",") # this table contain all white HEX color code
remove <- system.file("extdata", "remove.txt", package="ImaginR")
remove <- read.table(remove, sep=",")
remove <-trimws(as.vector(t(remove))) #trimws to fix the bug with spaces and comas into the txt file
pictureHEX_02 <- pictureHEX_02 [! pictureHEX_02 %in% remove] # remove the white color of the background of the picture
#print(head(remove))
print((length(pictureHEX)/length(pictureHEX_02))*100)
}
PLStenger/ImaginR documentation built on May 7, 2021, 11:07 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions Forest_cover OutPutResult_microscopy OneRow_microscopy OutPutResult OneRow ColorPhenotype PictureResults print.myclass hex2rgb
Documented in ColorPhenotype Forest_cover hex2rgb OneRow OutPutResult PictureResults print.myclass
#' Give RGB color code from HEX color code
#'
#' Give a RGB color code matrix from HEX color code vector.
#'
#' @param color.vector HEX code in a vector
#' @return RGB code color
#' @examples
#' # RGB color code of "Alice Blue" color:
#' hex2rgb("#f0f8ff")
#' # RGB color code of "Red" color:
#' hex2rgb("#ff0000")
#' # RGB color code of "Green" color:
#' hex2rgb("#008000")
#'@export
hex2rgb <- function(color.vector) {
resultat <- matrix( NA, ncol=3, nrow=length(color.vector), dimnames=list( NULL, c( "R", "G", "B")))
resultat[,"R"] <- strtoi( substr(color.vector, 2, 3), 16L)
resultat[,"G"] <- strtoi( substr(color.vector, 4, 5), 16L)
resultat[,"B"] <- strtoi( substr(color.vector, 6, 7), 16L)
resultat
}
#' Usefull for others functions
#'
#' Function to print the results (usefull for the others functions)
#'
#' @param x the results
#' @param ... if necessary
#' @return the header of the results
#' @export
print.myclass <- function(x, ...){
cat(x$header,"\n\n")
cat("Hexadecimal code: ", sprintf("%s: %s", names(x$const), x$const), "\n\n")
cat("HSV code:\n")
print(x$data, ...)
}
#' Give HEX and HSV color code
#'
#' To get the mean of the HEX color code and the HSV color code of the picture
#' @param picture The picture uploaded by load.image()
#' @return results
#' the HEX and HSV color code
#' @details
#' \itemize{
#' \item{h : the hue of the hsv color code}
#' \item{s : the saturation of the hsv color code}
#' \item{v : the value of the hsv color code}
#' \item{hex : the hexadecimal color code}
#' }
#' @examples
#' fpath <- system.file('extdata/image.jpg',package='ImaginR')
#' picture <- load.image(fpath)
#' PictureResults(picture)
#' @export
PictureResults<-function(picture){
# picture <- load.image("p.jpg")
#picture.blurry <- isoblur(picture,5) # blur picture to averaging the neighboring pixels
#save.image(picture.blurry, "blur_picture.jpeg") # save the new picture
# picture <- readJPEG("blur_picture.jpeg") # read it
pictureDm <- dim(picture) # dimension it
# create a new data.frame with these datas
pictureRGB <- data.frame(
R = as.vector(picture[,,1]),
G = as.vector(picture[,,2]),
B = as.vector(picture[,,3])
)
# "rgb it" the get the HEX color code
pictureHEX <- rgb(pictureRGB[,"R"], pictureRGB[,"G"], pictureRGB[,"B"], maxColorValue=1)
# remove <- read.table("remove.txt", sep=",") # this table contain all white HEX color code
remove <- system.file("extdata", "remove.txt", package="ImaginR")
remove <-trimws(as.vector(t(remove))) #trimws to fix the bug with spaces and comas into the txt file
pictureHEX <- pictureHEX [! pictureHEX %in% remove] # remove the white color of the background of the picture
# hex2rgb : to give RGB color code from HEX color code
hex2rgb <- function(color.vector) {
resultat <- matrix( NA, ncol=3, nrow=length(color.vector), dimnames=list( NULL, c( "R", "G", "B")))
resultat[,"R"] <- strtoi( substr(color.vector, 2, 3), 16L)
resultat[,"G"] <- strtoi( substr(color.vector, 4, 5), 16L)
resultat[,"B"] <- strtoi( substr(color.vector, 6, 7), 16L)
resultat
}
RGB0 <- matrix(hex2rgb(pictureHEX), ncol=3, byrow=F) # creat a matrix with the new datas
colnames(RGB0) <- c("R", "G", "B") # give columns a name
mean.color <- as.data.frame(RGB0) # create new data.frame to averaging the colors
rm <- mean(mean.color$R) # averaging the red channel color
rmr <- round(rm, 0)
gm <- mean( mean.color$G) # averaging the green channel color
gmr <- round(gm, 0)
bm <- mean(mean.color$B) # averaging the blue channel color
bmr <- round(bm, 0)
color <- rgb(rmr, gmr, bmr, maxColorValue=255) # convert code 1
hsv <-rgb2hsv(col2rgb(color)) # convert code 2
# give a marvelous made
header <- "The average color of the picture"
results <- list(header = header,
const = list(color=color),
data = list(hsv = hsv))
class(results) <- "myclass"
return(results)
}
#' Give the color phenotype of the pearl oyster's
#'
#' Returns the color phenotype of the pearl oyster's inner shell (\emph{Pinctada margaritifera})
#' @param picture The picture uploaded by load.image()
#' @return The color phenotype of the pearl oyster's inner shell
#' @examples
#' fpath <- system.file('extdata/image.jpg',package='ImaginR')
#' picture <- load.image(fpath)
#' ColorPhenotype(picture)
#' @export
ColorPhenotype <- function(picture){
#picture <- load.image("p.jpg")
#picture.blurry <- isoblur(picture,5)
#save.image(picture.blurry, "blur_picture.jpeg")
#picture <- readJPEG("blur_picture.jpeg")
pictureDm <- dim(picture)
pictureRGB <- data.frame(
R = as.vector(picture[,,1]),
G = as.vector(picture[,,2]),
B = as.vector(picture[,,3])
)
pictureHEX <- rgb(pictureRGB[,"R"], pictureRGB[,"G"], pictureRGB[,"B"], maxColorValue=1)
remove <- system.file("extdata", "remove.txt", package="ImaginR")
remove <-trimws(as.vector(t(remove)))
pictureHEX <- pictureHEX [! pictureHEX %in% remove]
hex2rgb <- function(color.vector) {
resultat <- matrix( NA, ncol=3, nrow=length(color.vector), dimnames=list( NULL, c( "R", "G", "B")))
resultat[,"R"] <- strtoi( substr(color.vector, 2, 3), 16L)
resultat[,"G"] <- strtoi( substr(color.vector, 4, 5), 16L)
resultat[,"B"] <- strtoi( substr(color.vector, 6, 7), 16L)
resultat
}
RGB0 <- matrix(hex2rgb(pictureHEX), ncol=3, byrow=F)
colnames(RGB0) <- c("R", "G", "B")
mean.color <- as.data.frame(RGB0)
rm <- mean(mean.color$R)
rmr <- round(rm, 0)
gm <- mean( mean.color$G)
gmr <- round(gm, 0)
bm <- mean(mean.color$B)
bmr <- round(bm, 0)
color <- rgb(rmr, gmr, bmr, maxColorValue=255)
hsv <-rgb2hsv(col2rgb(color))
# Import the hsv data of 30 valves of 5 Pinctada margaritifera/color phenotype wich are come from Rikitea
# (Gambier's archipelago) and from a same reproduction.
# The brood were choseen for they coloration
# There are 10 valves by color phenotypes (red, yellow and green)
# To see some individuals, go to https://plstenger.github.io/
# res <- read.csv("res.csv", header=T, sep=';')
# res
# re-format the datas
# h <- res$h
# s <- res$s
# v <- res$v
# phe <- res$phenotype
# dat <- data.frame(phe, h, s, v)
# dat
# Subset the datas by phenotypes and extract the range by maximum + standard error and minimum + standard error:
# For red phenotype
# datR <- subset(dat, phe == "R")
# minR <- min(datR$h)
# maxR <- max(datR$h)
# sdR <- sd(datR$h)
# R1 <- maxR + (sdR/2) - 0.002499 # here I substract 0.002499 to avoid conflict with the largeless yellow phenotype's range
# R2 <- minR + (sdR/2)
# For yellow phenotype ("J" for Jaune in French)
# datJ <- subset(dat, phe == "J")
# minJ <- min(datJ$h)
# maxJ <- max(datJ$h)
# sdJ <- sd(datJ$h)
# J1 <- maxJ + (sdJ)
# J2 <- minJ - (sdJ/2)
# For green phenotype ("V" for Vert in French)
# datV <- subset(dat, phe == "V")
# minV <- min(datV$h)
# maxV <- max(datV$h)
# sdV <- sd(datV$h)
# V1 <- maxV + (sdV)
# V2 <- minV - (sdV)
R1 <- 0.1625770
R2 <- 0.0000000 # 0.02340927
J1 <- 0.2790814
J2 <- 0.1625774
V1 <- 0.5637775
V2 <- 0.3215928
# What's color phenotype is it ?
phenotype <- if ((hsv[1,] >= 0) & (hsv[1,] <= R1)){
"Red phenotype"
} else if ((hsv[1,] >= 1-R1) & (hsv[1,] <= 1)){
"Red phenotype"
} else if ((hsv[1,] >= J2) & (hsv[1,] <= J1)){
"Yellow phenotype"
} else if ((hsv[1,] >= V2) & (hsv[1,] <= V1)){
"Green phenotype"
}else {
"other phenotype"
}
return(phenotype)
}
#' Get phenotype, HEX and HSV color code for one picture
#'
#' Get results in one row
#' @param picture The picture uploaded by load.image()
#' @return The HEX and HSV color code and the color phenotype of the pearl oyster's inner shell for one image in one row
#' @details
#' In header:
#' \itemize{
#' \item{id : the name of your pictures}
#' \item{h : the hue of the hsv color code}
#' \item{s : the saturation of the hsv color code}
#' \item{v : the value of the hsv color code}
#' \item{hex : the hexadecimal color code}
#' \item{phenotype : returns the color phenotype of the pearl oyster's inner shell (\emph{Pinctada margaritifera})}
#' }
#' @examples
#' fpath <- system.file('extdata/image.jpg',package='ImaginR')
#' picture <- load.image(fpath)
#' OneRow(picture)
#' @export
OneRow <- function(picture){
pictureDm <- dim(picture) # dimension it
# create a new data.frame with these datas
pictureRGB <- data.frame(
R = as.vector(picture[,,1]),
G = as.vector(picture[,,2]),
B = as.vector(picture[,,3])
)
# "rgb it" the get the HEX color code
pictureHEX <- rgb(pictureRGB[,"R"], pictureRGB[,"G"], pictureRGB[,"B"], maxColorValue=1)
# remove <- read.table("remove.txt", sep=",") # this table contain all white HEX color code
remove <- system.file("extdata", "remove.txt", package="ImaginR")
remove <-trimws(as.vector(t(remove))) #trimws to fix the bug with spaces and comas into the txt file
pictureHEX <- pictureHEX [! pictureHEX %in% remove] # remove the white color of the background of the picture
# hex2rgb : to give RGB color code from HEX color code
hex2rgb <- function(color.vector) {
resultat <- matrix( NA, ncol=3, nrow=length(color.vector), dimnames=list( NULL, c( "R", "G", "B")))
resultat[,"R"] <- strtoi( substr(color.vector, 2, 3), 16L)
resultat[,"G"] <- strtoi( substr(color.vector, 4, 5), 16L)
resultat[,"B"] <- strtoi( substr(color.vector, 6, 7), 16L)
resultat
}
RGB0 <- matrix(hex2rgb(pictureHEX), ncol=3, byrow=F) # creat a matrix with the new datas
colnames(RGB0) <- c("R", "G", "B") # give columns a name
mean.color <- as.data.frame(RGB0) # create new data.frame to averaging the colors
rm <- mean(mean.color$R) # averaging the red channel color
rmr <- round(rm, 0)
gm <- mean( mean.color$G) # averaging the green channel color
gmr <- round(gm, 0)
bm <- mean(mean.color$B) # averaging the blue channel color
bmr <- round(bm, 0)
color <- rgb(rmr, gmr, bmr, maxColorValue=255) # convert code 1
hsv <-rgb2hsv(col2rgb(color)) # convert code 2
R1 <- 0.162577
R2 <- 0.0000000 # 0.02340927
J1 <- 0.2790814
J2 <- 0.1625774
V1 <- 0.5637775
V2 <- 0.3215928
# What's color phenotype is it ?
phenotype <- if ((hsv[1,] >= 0) & (hsv[1,] <= R1)){
"Red phenotype"
} else if ((hsv[1,] >= 1-R1) & (hsv[1,] <= 1)){
"Red phenotype"
} else if ((hsv[1,] >= J2) & (hsv[1,] <= J1)){
"Yellow phenotype"
} else if ((hsv[1,] >= V2) & (hsv[1,] <= V1)){
"Green phenotype"
}else {
"other phenotype"
}
# get results in one row
mhsv <- matrix(hsv[,1], dimnames = NULL)
OneRow <- c(c(mhsv), color, phenotype)
OneRow <- c(OneRow)
return(OneRow)
}
#' Get phenotype, HEX and HSV color code for all pictures
#'
#' Get results in a .txt file, .csv file and in R data.frame
#' This function does what all the others functions do in a very simple way. Just put your images in your working directory (don't forget to getwd() !), do library this package and paste this only code: "OutPutResult()". You will get the results into your consol and in a results.csv file in your working directory.
#' @param id The name of the pictures in your working directory
#' @return The HEX and HSV color code and the color phenotype of the pearl oyster's inner shell for all images in a results.csv file
#' @details
#' In results.csv:
#' \itemize{
#' \item{id : the name of your pictures}
#' \item{h : the hue of the hsv color code}
#' \item{s : the saturation of the hsv color code}
#' \item{v : the value of the hsv color code}
#' \item{hex : the hexadecimal color code}
#' \item{phenotype : returns the color phenotype of the pearl oyster's inner shell (\emph{Pinctada margaritifera})}
#' }
#' @export
OutPutResult <- function(id){
id <- list.files(pattern = ".jpg")
for(i in id){
sink("OutPutAnalysis.txt", append=TRUE)
picture <- load.image(i)
a <- OneRow(picture)
print(a)
sink()
sink()
sink()
}
id <- list.files(pattern = ".jpg")
res <- read.table("OutPutAnalysis.txt")
dat <- data.frame(id, res$V2, res$V3, res$V4, res$V5, res$V6)
colnames(dat) <- c("id", "h", "s", "v", "hex","phenotype")
write.table(dat, file = "results.csv", sep=";")
return(dat)
}
#' Get phenotype, HEX and HSV color code for one picture
#'
#' Get results in one row
#' @param picture The picture uploaded by load.image()
#' @return The HEX and HSV color code and the color phenotype of the pearl oyster's inner shell for one image in one row
#' @details
#' In header:
#' \itemize{
#' \item{id : the name of your pictures}
#' \item{h : the hue of the hsv color code}
#' \item{s : the saturation of the hsv color code}
#' \item{v : the value of the hsv color code}
#' \item{hex : the hexadecimal color code}
#' \item{phenotype : returns the color phenotype of the pearl oyster's inner shell (\emph{Pinctada margaritifera})}
#' }
#' @examples
#' fpath <- system.file('extdata/image.jpg',package='ImaginR')
#' picture <- load.image(fpath)
#' OneRow_microscopy(picture)
#' @export
OneRow_microscopy <- function(picture){
pictureDm <- dim(picture) # dimension it
# create a new data.frame with these datas
pictureRGB <- data.frame(
R = as.vector(picture[,,1]),
G = as.vector(picture[,,2]),
B = as.vector(picture[,,3])
)
# "rgb it" the get the HEX color code
pictureHEX <- rgb(pictureRGB[,"R"], pictureRGB[,"G"], pictureRGB[,"B"], maxColorValue=1)
# remove <- read.table("remove.txt", sep=",") # this table contain all white HEX color code
remove <- system.file("extdata", "remove_black.txt", package="ImaginR")
remove <-trimws(as.vector(t(remove))) #trimws to fix the bug with spaces and comas into the txt file
pictureHEX <- pictureHEX [! pictureHEX %in% remove] # remove the white color of the background of the picture
# hex2rgb : to give RGB color code from HEX color code
hex2rgb <- function(color.vector) {
resultat <- matrix( NA, ncol=3, nrow=length(color.vector), dimnames=list( NULL, c( "R", "G", "B")))
resultat[,"R"] <- strtoi( substr(color.vector, 2, 3), 16L)
resultat[,"G"] <- strtoi( substr(color.vector, 4, 5), 16L)
resultat[,"B"] <- strtoi( substr(color.vector, 6, 7), 16L)
resultat
}
RGB0 <- matrix(hex2rgb(pictureHEX), ncol=3, byrow=F) # creat a matrix with the new datas
colnames(RGB0) <- c("R", "G", "B") # give columns a name
mean.color <- as.data.frame(RGB0) # create new data.frame to averaging the colors
rm <- mean(mean.color$R) # averaging the red channel color
rmr <- round(rm, 0)
gm <- mean( mean.color$G) # averaging the green channel color
gmr <- round(gm, 0)
bm <- mean(mean.color$B) # averaging the blue channel color
bmr <- round(bm, 0)
color <- rgb(rmr, gmr, bmr, maxColorValue=255) # convert code 1
hsv <-rgb2hsv(col2rgb(color)) # convert code 2
O1 <- 0.1
O2 <- 0.0000000
EB1 <- 0.65
EB2 <- 0.54
LG1 <- 0.39
LG2 <- 0.35
LY1 <- 0.16
LY2 <- 0.14
FGC1 <- 0.139
FGC2 <- 0.11
# What's color phenotype is it ?
phenotype <- if ((hsv[1,] >= 0) & (hsv[1,] <= O1)){
"Orange"
} else if ((hsv[1,] >= 1-O1) & (hsv[1,] <= 1)){
"Orange-reddish"
} else if ((hsv[1,] >= EB2) & (hsv[1,] <= EB1)){
"Electric blue"
} else if ((hsv[1,] >= LG2) & (hsv[1,] <= LG1)){
"Light green"
} else if ((hsv[1,] >= LY2) & (hsv[1,] <= LY1)){
"Light yellow"
} else if ((hsv[1,] >= FGC2) & (hsv[1,] <= FGC1)){
"Fluo green"
}else {
"Other coloration"
}
# get results in one row
mhsv <- matrix(hsv[,1], dimnames = NULL)
OneRow_microscopy <- c(c(mhsv), color, phenotype)
OneRow_microscopy <- c(OneRow_microscopy)
return(OneRow_microscopy)
}
#' Get phenotype, HEX and HSV color code for all pictures
#'
#' Get results in a .txt file, .csv file and in R data.frame
#' This function does what all the others functions do in a very simple way. Just put your images in your working directory (don't forget to getwd() !), do library this package and paste this only code: "OutPutResult()". You will get the results into your consol and in a results.csv file in your working directory.
#' @param id The name of the pictures in your working directory
#' @return The HEX and HSV color code and the color phenotype of the pearl oyster's inner shell for all images in a results.csv file
#' @details
#' In results.csv:
#' \itemize{
#' \item{id : the name of your pictures}
#' \item{h : the hue of the hsv color code}
#' \item{s : the saturation of the hsv color code}
#' \item{v : the value of the hsv color code}
#' \item{hex : the hexadecimal color code}
#' \item{phenotype : returns the color phenotype of the pearl oyster's inner shell (\emph{Pinctada margaritifera})}
#' }
#' @export
OutPutResult_microscopy <- function(id){
id <- list.files(pattern = ".jpg")
for(i in id){
sink("OutPutAnalysis_microscopy.txt", append=TRUE)
picture <- load.image(i)
a <- OneRow_microscopy(picture)
print(a)
sink()
sink()
sink()
}
id <- list.files(pattern = ".jpg")
res <- read.table("OutPutAnalysis_microscopy.txt")
dat <- data.frame(id, res$V2, res$V3, res$V4, res$V5, res$V6)
colnames(dat) <- c("id", "h", "s", "v", "hex","phenotype")
write.table(dat, file = "results_microscopy.csv", sep=";")
return(dat)
}
#' Give the percent of forest covarage
#'
#' Give the percent of forest covarage by comparing two pictures : the first one (x) is the original (aerial) image and the second (y) is the same image but without the soil (only forest cover is keep)
#'
#' @param x path of the original image
#' @param y path of the same image but without the soil (only forest cover is keep)
#' @return Percentage of forest cover (0 to 100%)
#' @examples
#' Forest_cover("A1_DJI_0026_cleaned_empty_before.JPG", "A1_DJI_0026_cleaned_empty.JPG")
#' 26.82175
#'@export
Forest_cover <- function(x, y) {
picture <- load.image(y)
pictureDm <- dim(picture) # dimension it
# create a new data.frame with these datas
pictureRGB <- data.frame(
R = as.vector(picture[,,1]),
G = as.vector(picture[,,2]),
B = as.vector(picture[,,3])
)
# "rgb it" the get the HEX color code
pictureHEX <- rgb(pictureRGB[,"R"], pictureRGB[,"G"], pictureRGB[,"B"], maxColorValue=1)
# remove <- read.table("remove.txt", sep=",") # this table contain all white HEX color code
remove <- system.file("extdata", "remove.txt", package="ImaginR")
remove <- read.table(remove, sep=",")
remove <-trimws(as.vector(t(remove))) #trimws to fix the bug with spaces and comas into the txt file
pictureHEX <- pictureHEX [! pictureHEX %in% remove] # remove the white color of the background of the picture
picture_02 <- load.image(x)
pictureDm_02 <- dim(picture_02) # dimension it
# create a new data.frame with these datas
pictureRGB_02 <- data.frame(
R = as.vector(picture_02[,,1]),
G = as.vector(picture_02[,,2]),
B = as.vector(picture_02[,,3])
)
# "rgb it" the get the HEX color code
pictureHEX_02 <- rgb(pictureRGB_02[,"R"], pictureRGB_02[,"G"], pictureRGB_02[,"B"], maxColorValue=1)
# remove <- read.table("remove.txt", sep=",") # this table contain all white HEX color code
remove <- system.file("extdata", "remove.txt", package="ImaginR")
remove <- read.table(remove, sep=",")
remove <-trimws(as.vector(t(remove))) #trimws to fix the bug with spaces and comas into the txt file
pictureHEX_02 <- pictureHEX_02 [! pictureHEX_02 %in% remove] # remove the white color of the background of the picture
#print(head(remove))
print((length(pictureHEX)/length(pictureHEX_02))*100)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.