If we save the data of Roger de Piles’ scores for artists to a csv file we can load them into R:
## Load the tab separated values for the table of artist scores scores<-read.csv("./scores.csv", colClasses=c("character", "integer", "integer", "integer", "integer")) ## Replace NA values with zero nas<-which(is.na(scores), arr.ind=TRUE) scores[nas[1], nas[2]]<-0 ## Create the total score scores<-cbind(scores, Total=apply(scores[2:5], 1, sum))
This allows us to find the lowest and highest scores:
## Min, max of each score scoreMinMax<-function(scores, column){ lowest<-min(scores[column]) cat(column, "\nMin (", lowest, "): ", sep="") cat(scores$Painter[scores[column] == lowest], sep=", ") highest<-max(scores[column]) cat("\nMax (", highest, "): ", sep="") cat(scores$Painter[scores[column] == highest], sep=", ") cat("\n") }
> scoreMinMax(scores, "Composition") Composition Min (0): Guido Reni, Gianfrancesco Penni Max (18): Guercino, Rubens > > scoreMinMax(scores, "Drawing") Drawing Min (6): Giovanni Bellini, Lucas van Leyden, Caravaggio, Palma il Vecchio, Rembrandt Max (18): Raphael > > scoreMinMax(scores, "Colour") Colour Min (0): Pietro Testa Max (18): Giorgione, Titian > > scoreMinMax(scores, "Expression") Expression Min (0): Jacopo Bassano, Giovanni Bellini, Caravaggio, Palma il Vecchio, Gianfrancesco Penni Max (18): Raphael > > scoreMinMax(scores, "Total") Total Min (23): Gianfrancesco Penni Max (65): Raphael, Rubens >
Cluster the artists:
## Clustering Utilities clustersNames<-function(clusters, names){ clusterCount<-length(clusters$size) clusters.works<-lapply(1:clusterCount, function(cluster){ names[clusters$cluster == cluster]}) } printClustersNames<-function(clustersNames){ clusterCount<-length(clustersNames) for(cluster in 1:clusterCount){ cat("Cluster", cluster, ":", paste(unlist(clustersNames[cluster]), collapse=", "), "\n\n") } } ## Cluster based on the numeric scores. 8 = 2x2x2 (Low/High) clusters<-kmeans(scores[2:5], 8) names<-clustersNames(clusters, scores$Painter) printClustersNames(names)
Cluster 1 : Correggio, Rembrandt, Van Dyck Cluster 2 : Andrea del Sarto, Federico Barocci, Daniele da Volterra, Guercino, Lucas Jordaens, Giovanni Lanfranco, Otho Venius, Perin del Vaga, Primaticcio, Francesco Salviati, Taddeo Zuccari Cluster 3 : Charles Le Brun, Il Domenichino, Giulio Romano, Leonardo da Vinci, Eustache Le Sueur Cluster 4 : I Carracci, Raphael, Rubens, Vanius Cluster 5 : Guido Reni, Gianfrancesco Penni Cluster 6 : Jacopo Bassano, Giovanni Bellini, Caravaggio, Murillo, Palma il Vecchio Cluster 7 : Sebastian Bourdon, Cavalier D'Arpino, Albrecht Dürer, Lucas van Leyden, Michelangelo, Il Parmigianino, Pietro Testa, Federico Zuccari Cluster 8 : Abraham van Diepenbeeck, Giorgione, Giovanni da Udine, Holbein, Jacob Jordaens, Palma il Giovane, Sebastiano del Piombo, Teniers, Tintoretto, Titian, Veronese
And graph the scores:
## Stacked bar chart ## Allow room for names at bottom and legend at right ## 7 is from trial and error par(xpd=T, mar=par()$mar+c(7,0,0,7)) barplot(t(as.matrix(scores[2:5])), names.arg=scores$Painter, main="Roger de Piles' Ratings", col=rainbow(4), las=2, border=NA) ## Position legend in right margin ## 60 is from trial and error legend(60, 60, names(scores[2:5]), fill=rainbow(5), cex=0.75)