Я нашел решение для этого в прошлом и все еще использую его, но я никогда не искал что-то еще. Я хотел бы поделиться этим и получить отзывы сообщества об этом, и если есть лучшее решение.
На самом деле моя следующая идея - реализовать инструмент выделения, похожий на editableCell . Я мог бы это сделать, но основным смыслом использования этого было бы использование копировальной пасты для вставки изображения в другое место, когда они расположены. К сожалению, изображение не копируется.
У меня есть список JPEG с определенным именем:
010003000Color3_0.jpg
010003000Color3_1.jpg
010003000Color3_2.jpg
Мне нужно получить информацию из этих имен, создать сетку из этих картинок в зависимости от содержащейся информации.
например. здесь у меня есть имя, соответствующее _.jpg
Вот полный код, я позволю вам пройти через него. Прочитайте комментарии, которые частично объясняют это.
# Setup -------------------------------------------------------------------
library(data.table)
library(dplyr)
library(tableHTML)
library(knitr)
wd <- "C:/Users/gravier/Downloads/Example_Yann_Html/Jpeg"
# Function ----------------------------------------------------------------
addimgbalise <- function(vect, pisize=200) {
# to add a html balise with a pixel size for the image
vect <- paste0("<img src='", vect,"' width=", pisize, "/>")
return(vect)
}
write.html.link <- function(data,
filename,
caption = filename,
wdfunction,
color.bg = "#00000",
color.line = "#b4bac4",
color.text = "#b4bac4",
font.size = "8px",
font.family = "Arial",
text.align = "center") {
# permit to write a html table with a local link to click
tabhtml <- tableHTML(data,
rownames = FALSE,
caption = caption,
theme="default") %>%
add_css_table(css = list('border', color.line)) %>%
add_css_table(css = list('text-align', text.align)) %>%
add_css_table(css = list('font-family', font.family)) %>%
add_css_table(css = list('font-size', font.size)) %>%
add_css_table(css = list('color', color.text))
write_tableHTML(tabhtml, file = paste0(wdfunction, "/", filename, ".html"))
# unfortunately write_tableHTML has been changed in the past and is not write the '<' '>' characters of the addimgbalise function, so we have to read again the html and exchange those characters again
temp <- suppressWarnings(readLines(paste0(wdfunction, "/", filename, ".html")))
temp <- gsub( ">", ">", temp)
temp <- gsub( "<", "<", temp)
temp <- c("<body bgcolor='", color.bg, "'>", temp)
writeLines(temp, paste0(wdfunction, "/", filename, ".html"))
}
# Parameters (where in function normally, but I detail the process --------
patternlist <- ".jpg"
regexjpeg <- "([0-9]*)(.*)_(.*)" # this the regex expression regarding the name of the files
regexposID <- "\\1" # position of the different variable I want to extract from the name
regexposWhat <- "\\2"
regexposField <- "\\3"
regexposZ <- "\\3"
formulaPV <- "row+Field~col+What" # then the dcast formula regarding how to arrange the pictures
pixelimg <- 150 # size in html but the picture are kept of real resolution so you can zoom
base64 <- F
listimg<- data.table(path = list.files(wd, full.names = T))
listimg[, ID := gsub(paste0(regexjpeg, patternlist), regexposID, basename(path))]
listimg[, What := gsub(paste0(regexjpeg, patternlist), regexposWhat, basename(path))]
listimg[, Field := as.numeric(gsub(paste0(regexjpeg,patternlist), regexposField, basename(path)))]
listimg[, Z := as.numeric(gsub(paste0(regexjpeg,patternlist), regexposZ, basename(path)))]
listimg[, row := LETTERS[as.numeric(substr(ID, 1, 3))]]
listimg[, col := as.numeric(substr(ID, 4, 6))]
if( base64 ) {
for(i in 1:nrow(listimg) ) {
listimg[i, code := paste0(addimgbalise(image_uri(path), pixelimg), "\n", row, col, "-", Field, "-", What)]
}
} else {
listimg[, code := paste0(addimgbalise(path, pixelimg), "\n", row, col, "-", Field, "-", What)]
}
listimg3 <- dcast(listimg, as.formula(formulaPV), value.var = "code")
listimg3 <- data.frame(listimg3)
listimg3[nrow(listimg3)+1,] <- colnames(listimg3)
write.html.link(data = listimg3, filename = "Picture_grid", caption = paste0("Picture_grid", " - ", formulaPV), wdfunction = dirname(wd))
# Some other example ------------------------------------------------------
formulaPV <- "row+Field+What~col" # then the dcast formula regarding how to arrange the pictures
listimg3 <- dcast(listimg, as.formula(formulaPV), value.var = "code")
listimg3 <- data.frame(listimg3)
listimg3[nrow(listimg3)+1,] <- colnames(listimg3)
write.html.link(data = listimg3, filename = "Picture_grid_other_formula", caption = paste0("Picture_grid", " - ", formulaPV), wdfunction = dirname(wd))
# base64
for(i in 1:nrow(listimg) ) {
listimg[i, code := paste0(addimgbalise(image_uri(path), pixelimg), "\n", row, col, "-", Field, "-", What)]
}
listimg3 <- dcast(listimg, as.formula(formulaPV), value.var = "code")
listimg3 <- data.frame(listimg3)
listimg3[nrow(listimg3)+1,] <- colnames(listimg3)
write.html.link(data = listimg3, filename = "Picture_grid_base64", caption = paste0("Picture_grid", " - ", formulaPV), wdfunction = dirname(wd))
Окончательный результат таков:
