library(tidyverse)
library(imager)
library(data.table)
library(fs)
library(ggplot2)
library(ggridges)
library(htmltools)
library(jpeg)Farbanalyse von alten chinesischen Gemaelden
1 Analysewerkzeug
2 Werke
meta<-fread('chinese_paintings_data.csv')
meta<-meta[,!'LINKS']
meta[,FILE:=paste0('chinese_paintings/',FILE,'.jpg')]
#meta[,all(file.exists(FILE))]
dim(meta)[1] 3006 3head(meta) TITLE PERIOD
<char> <int>
1: The Gathering at the Orchid Pavilion 1580
2: A Fisherman Walking in the Snow 1580
3: Landscape: tea sipping under willows 1640
4: A Daoist fairy standing on waves 1640
5: Mountebanks with birds and a chained ape 1640
6: Landscape: a river, mountains and mist; houses on the shore 1640
FILE
<char>
1: chinese_paintings/0001_1580.jpg
2: chinese_paintings/0002_1580.jpg
3: chinese_paintings/0003_1640.jpg
4: chinese_paintings/0004_1640.jpg
5: chinese_paintings/0005_1640.jpg
6: chinese_paintings/0006_1640.jpgAlle Bilder als Gesamtheit von 3006 Kopien, heruntergeladen von der https://ids.si.edu Website. Die Informationen umfassen：
- TITLE Titel
- PERIOD Periode
- LINKS URL des Bildes
- FILE Dokumente
Ein Blick auf die Daten zeigt, dass viele der Gemaelde doppelte Titel haben：
meta[,.N,TITLE][order(-N)] ##Viele der Werke werden umbenannt. TITLE N
<char> <int>
1: Landscape 63
2: Peonies 8
3: Winter Landscape 8
4: Birds and Flowers 7
5: Mountain Landscape 7
---
1574: Ancient Quarry 1
1575: Maiden in a Bamboo Grove 1
1576: Fragment of the Lotus Sutra 1
1577: Banana Leaf, Small Birds, and Cherries 1
1578: Autumn Mountains, Myriad Miles 1Die obige Tabelle zeigt, dass es 63 Gemaelde mit dem Titel „Landscape“ und 8 Gemaelde mit dem Titel „Peonies“ gibt. Schauen wir uns die 8 „Peonies“ wie folgt an：
meta[TITLE=='Peonies'][order(PERIOD)]->lizi
lizi TITLE PERIOD FILE
<char> <int> <char>
1: Peonies 1400 chinese_paintings/1786_1400.jpg
2: Peonies 1500 chinese_paintings/1579_1500.jpg
3: Peonies 1600 chinese_paintings/1194_1600.jpg
4: Peonies 1640 chinese_paintings/0244_1640.jpg
5: Peonies 1670 chinese_paintings/2529_1670.jpg
6: Peonies 1690 chinese_paintings/2005_1690.jpg
7: Peonies 1900 chinese_paintings/1979_1900.jpg
8: Peonies 1910 chinese_paintings/1385_1910.jpglapply(lizi[,FILE],\(x) {
tags$img(src=x)
}
)->lizis
tags$div(lizis,class="gallery")
Wie aus der obigen Abbildung ersichtlich ist, haben die Originaldaten denselben Titel (alle „Peonies“) und 8 Paare von Gemaelden unterschiedlichen Datums, und zwar viele sind Duplikate, mit nur 4 Paaren nach der Deduplizierung.
3 Kunstwerk Datamining
Wir verwenden das R-Paket jpeg, um jpeg-formatierte Bilder in R einzulesen und sie dann in Daten mit den Spalten R, G und B umzuwandeln. um das Kunstwerk mit Daten zu versehen.
img2Data<-function(file)
{
img <- readJPEG(file)
img_data <- as.data.frame(matrix(img, ncol = 3))
colnames(img_data) <- c("R", "G", "B")
img_data<-as.data.table(img_data)
}Verwenden wir die Aenderungsfunktion, um die 8 Paare von Werken mit dem Namen „Peonies“ zu ermitteln, und nachdem wir die Duplikate entfernt haben, bleiben mehrere verschiedene eindeutige Paare übrig:
lapply(lizi$FILE,img2Data) |> unique() |> length()[1] 4Das Ergebnis wird als 4 Paare angezeigt, was dem Ergebnis unserer visuellen Beurteilung in der Abbildung oben entspricht.
Nun sind alle 3006 Werkpaare digitalisiert, und die Daten werden nach dem Entfernen von Duplikaten gespeichert:
lapply(setNames(,meta$FILE),img2Data)->resu
!duplicated(resu)->kept
resu[kept]->dats
#unique(resu)->dats
length(resu)[1] 3006length(dats)[1] 1701#save(dats,file='unique_jpegs.RData')Die Anzahl der nach dem Entfernen der Duplikate verbleibenden Eintraege ist：1701。
4 Visualisierung der Verwendung von Farbe in Kunstwerken
In dem vorangegangenen Schritt der Visualisierung der Kunstwerke wurde jedes Kunstwerk in drei Datenspalten - R, G und B - aufgeteilt.
4.1 Ein zufaelliges Paar von Werken
Nachfolgend ist ein willkuerlich ausgewaehltes Paar von Werken mit ihrer urspruenglichen und der RGB-Verteilung wie folgt dargestellt:
#one.name<-"chinese_paintings/1143_1600.jpg"
(sample(names(dats),1)->one.name)[1] "chinese_paintings/0539_1300.jpg"Das Originalwerk lautet wie folgt：
knitr::include_graphics(one.name,dpi=100)
RGB-Verteilung：
dats[[one.name]]->one
ond<-melt(one,measure.vars=names(one))
ggplot(ond,aes(x=value,y=variable,colour=variable,fill = after_scale(alpha(colour, 0.3))))+
geom_density_ridges(linewidth=1.2)+
theme_bw()+
scale_colour_manual(values=c(R='red',G='green',B='blue'))+
labs(x='',y='')+
theme(legend.position='none')
4.2 Die durchschnittliche Intensität von Rot, Grün und Blau mit Hilfe von Boxplots vergleichen.
filenames <- list.files('chinese_paintings/')
images <- list()
for(i in seq_along(filenames)){
set.seed(12345)
filename <- filenames[i]
image <- load.image(paste0('chinese_paintings/', filename))
image <- as.data.frame(image) %>%
slice_sample(n = 100)
images[[filename]] <- image
#print(paste0(i, '/', length(filenames)))
}
keep <- !duplicated(images)
images_unique <- images[keep]
length(images_unique)[1] 1701results <- tibble()
i <- 0
for(name in names(images_unique)){
img <- load.image(paste0('chinese_paintings/', name))
img_df <- as.data.frame(img)
results <- img_df %>%
group_by(cc) %>%
summarise(means = mean(value)) %>%
mutate(file = name) %>%
bind_rows(results)
i <- i + 1
#print(paste0(i, '/', length(images_unique)))
}
write_delim(results, 'chinese_paintings_data_cc_means.csv')
results %>%
mutate(cc = factor(cc, labels = c('Rot', 'Gruen', 'Blau'))) %>%
ggplot(aes(x = cc, y = means, fill = cc)) +
geom_boxplot() +
scale_fill_manual(values = c('red', 'green', 'blue')) +
theme_minimal() +
labs(y = 'Mittlere Farbintensitaet', x = '') +
guides(fill = FALSE)
Die Verteilung der durchschnittlichen Farbintensitaet zeigt: Chinesische Gemaelde enthalten im Durschnitt eine hohe Rotintensitaet und vergleichsweise geringe Gruen- und Blauintensitaet. Das bedeutet nicht, dass die Gemaelde auch rot erscheinen. Das Gemaelde mit der hoechsten Rotintensitaet.
results %>%
filter(means == max(means) & cc == 1)# A tibble: 1 × 3
cc means file
<int> <dbl> <chr>
1 1 0.893 2423_1720.jpgDie Wahrnehmung von Rot entsteht, wenn die Rotintensitaet relativ hoch ist, verglichen mit der Gruen- und Blauintensitaet.
results %>%
group_by(file) %>%
summarise(
red = means[cc == 1],
green = means[cc == 2],
blue = means[cc == 3]
) %>%
mutate(relative_red = red / (green + blue + 1e-5)) %>%
arrange(-relative_red)# A tibble: 1,701 × 5
file red green blue relative_red
<chr> <dbl> <dbl> <dbl> <dbl>
1 0131_1640.jpg 0.280 0.145 0.0986 1.15
2 0750_1700.jpg 0.469 0.269 0.153 1.11
3 0482_1300.jpg 0.249 0.134 0.0940 1.09
4 0753_1700.jpg 0.349 0.212 0.109 1.09
5 0008_1640.jpg 0.410 0.240 0.148 1.06
6 0111_1640.jpg 0.331 0.192 0.121 1.05
7 0452_1300.jpg 0.206 0.118 0.0792 1.04
8 1195_1600.jpg 0.432 0.254 0.161 1.04
9 1072_1600.jpg 0.388 0.235 0.139 1.04
10 0219_1640.jpg 0.290 0.170 0.111 1.03
# ℹ 1,691 more rows4.3 Hauptfarben aller Werke
Der Medianwert des RGB-Wertes wird fuer jedes Werk ermittelt, und dann wird der Medianwert des RGB-Wertes für alle Werke aufgetragen：
sapply(dats,\(x){
RGB.median<-apply(x,2,median)
rgb(RGB.median[1],RGB.median[2],RGB.median[3])
})->allms
scales::show_col(allms, labels=F)