{"cells":[{"cell_type":"markdown","metadata":{"_cell_guid":"a2ef4347-3c2e-5b6c-11a8-6f8767806f46"},"source":"## Introduction ##\n\nExtention from Olga Chernytska's Minimum Distance Classifier by including a minimum sum of within clusters square metric to determine the number of clusters for each label\n"},{"cell_type":"code","execution_count":null,"metadata":{"_cell_guid":"47d2e746-4cab-7278-7160-252796db296f"},"outputs":[],"source":"#Loading Data (no changes)\ntrain <- read.csv(\"../input/train.csv\")\n\n"},{"cell_type":"markdown","metadata":{"_cell_guid":"5d13cc7d-18e8-bc0c-5f77-c4e4fcdd34e4"},"source":"no chan"},{"cell_type":"code","execution_count":null,"metadata":{"_cell_guid":"08768ae7-4a60-bbce-2142-041960b78866"},"outputs":[],"source":"set.seed(25)\nintest <- sample(1:42000,10000)\nX_train <- train[-intest,-1]\nY_train <- train[-intest,1]\nX_test <- train[intest,-1]\nY_test <- train[intest,1]\n\ntable(Y_train)\ntable(Y_test)"},{"cell_type":"markdown","metadata":{"_cell_guid":"a4403ca5-1294-630e-815a-02fa00146fa0"},"source":"## Decreasing Size of Train Set ##\n\n\n----------\nHold on. Let's think a little... To classify one observation we need to calculate 32,000 distances. Moreover, test set consists of 10,000 observations, which means 320,000,000 distances in total. I repeat: 320 millions of distances. Quite a lot for my old computer. \n\nI do not want to wait forever, so the most feasible decision is to decrease size of train set. One more look at  the plot above: most of pictures are very similar which means that most of 320 millions of distances will be similar as well. I am not going to spend my time recalculating distances to almost the same vectors, so I decided to choose 50 the most distinct digits in every class using rule of thumb. Train set decreases to 500 observations and number of distances to calculate - to just 5,000,000.\n\nOf course, it will lead to decrease in accuracy. But I value my time more.\n\nTo build a new train set I am going to: 1) use K-Mean clustering algorithm; 2) 500 class centers (10 digits * 50 clusters) are becoming observations in train set. I chose euclidean distance as distance metric and simple average of all observations in clusters as cluster centers, using rule of thumb too - great rule for controversial situations.\n\n\n"},{"cell_type":"code","execution_count":null,"metadata":{"_cell_guid":"d4af1c65-c789-8ff3-f5db-2abee76d37f2"},"outputs":[],"source":"raw_train_set <- train[-intest,]\nfinal_train_set <- NULL\n\nfor (i in 0:9)\n{\n    digit <- raw_train_set[raw_train_set$label==i,-1]\n    set.seed(222)\n    cluster <- kmeans(x = digit,centers = 50, iter.max = 20)\n    new_data <- cbind(rep(i,50),cluster$centers)\n    final_train_set<- rbind(final_train_set,new_data)\n}\nfinal_train_set<-as.data.frame(final_train_set)\n\nX_train <- final_train_set[,-1]\nY_train <- final_train_set[,1]\ntable (Y_train)\n\nrm(digit,cluster,new_data,i,raw_train_set,final_train_set)"},{"cell_type":"markdown","metadata":{"_cell_guid":"b6f8fc95-a939-6819-ba1c-99cdbc105520"},"source":"Look at this new train set. It seems these awesome 500 observations can correctly classify all unique instances."},{"cell_type":"code","execution_count":null,"metadata":{"_cell_guid":"c0fa8ae9-a70c-1431-d007-1a5020dfc506"},"outputs":[],"source":"data <- sample(1:500,100)\npar(mfrow=c(10,10),mar=c(0.1,0.1,0.1,0.1))\n\nfor (k in data)\n{\n    row <- NULL\n    for (n in 1:784)\n        row[n] <- X_train[k,n]\n    \n    matrix1 <- matrix(row,28,28,byrow=FALSE)\n    matrix2 <- matrix(rep(0,784),28,28)\n    \n    for (i in 1:28)\n        for (j in 1:28)\n            matrix2[i,28-j+1] <- matrix1[i,j]\n    \n    image(matrix2, axes=FALSE, col=topo.colors(12))\n}\n\nrm(i,n,j,k,row,matrix1,matrix2)"},{"cell_type":"markdown","metadata":{"_cell_guid":"ae5a9541-87a8-bf97-0439-f10bb1b71494"},"source":"## Predictions ##\n\n\n----------\nTime for predictions! First part of the script calculates distance matrix **distances**, which has 10,000 rows (10,000 observations in test set) and 500 columns (distances to all observations in train set). The second part finds mimimum distance in the row and ties it to observation in train set (both cluster number and digit type); output is a matrix **predictions**.\n\n(Actually, my script does not calculate euclidean distances, it calculates squared euclidean distances. As I don't need actual distances, I decided not to take square roots because it increases number of caclulations. I need just comparance of distances, and it is known that if x^2 > y^2, then x > y for all positive numbers.)"},{"cell_type":"code","execution_count":null,"metadata":{"_cell_guid":"ea09680f-7cb8-1911-9f7d-fbf5fb354493"},"outputs":[],"source":"#Calculating distances\ndistances <- NULL\nX_train <- as.matrix(X_train)\nX_test <- as.matrix(X_test)\nm <- dim(X_train)[1]\nn <- dim(X_test)[1]\n\nfor (j in 1:n)\n{\n    dist <- rowSums((X_train - t(replicate(m, X_test[j,])))^2)\n    distances<-cbind(distances,dist)\n}\ndistances <- (t(distances))\n\n#Predicting\nrows<-NULL\nfor (i in 1:n)\n    rows <- c(rows, which.min(distances[i,])[[1]])\n\npredictions <- data.frame(predicted = Y_train[rows], actual = Y_test, cluster = rows)\nrm(dist,j,m,n,i,rows)"},{"cell_type":"markdown","metadata":{"_cell_guid":"7bf897f3-9234-d9dd-1029-e12f1173d2c7"},"source":"## Model Valuation ##\n\n\n----------\nModel accuracy is 94.9% which is higher than from previous model - Logit resulted in 90.0% accuracy. Which means that I significantly improved my model performace. Which means it is time for celebration!\n\nJust for curious: I also varied number of clusters from 50 to 25 and 100, accuracy also varied. For example, 25 clusters (250 observation in train set) gave me 93.7% accuracy and 100 clusters (1000 observations in train set) - 95.6%. Well, that was expected."},{"cell_type":"code","execution_count":null,"metadata":{"_cell_guid":"d698fe3b-4604-57f8-f051-08772efd4a10"},"outputs":[],"source":"#function\naccuracy <- function (pred,actual)\n{\n    conf_matrix <- table(predictions = pred, actual = actual)\n    sum <- 0\n    for (j in 1:10)\n        for (i in 1:10)\n            if (j == i)\n                sum<-sum+conf_matrix[i,j]\n    return(list(conf_matrix,sum/length(pred)))\n}"},{"cell_type":"code","execution_count":null,"metadata":{"_cell_guid":"fce5c1b5-194d-7418-552f-3c35897e8876"},"outputs":[],"source":"accuracy(predictions$predicted,predictions$actual)"},{"cell_type":"markdown","metadata":{"_cell_guid":"896fe3b3-85d2-303c-3fa6-d12adb6788a3"},"source":"## Visualization ##\n\n\n----------\nOn the left (blue) part there are observations from test set, on the right (red) part - observations from train set situated respectively. This plot gives an understanding how algorithm works, when and why it makes mistakes.\n\nAbout mistakes. Some digits are so badly written that neither Superpowerful Algorithm nor Human will never recognize them. But for some other digits there are just not enough train set clusters to classify them correctly."},{"cell_type":"code","execution_count":null,"metadata":{"_cell_guid":"09505642-be19-bfec-fcf8-0fb2d016c53e"},"outputs":[],"source":"par(mfcol=c(14,14),mar=c(0.1,0.1,0.1,0.1))\n\ndata <- 101:198\nfor (k in data)\n{\n    row <- NULL\n    for (n in 1:784)\n        row[n] <- X_test[k,n]\n    \n    matrix1 <- matrix(row,28,28,byrow=FALSE)\n    matrix2 <- matrix(rep(0,784),28,28)\n    \n    for (i in 1:28)\n        for (j in 1:28)\n            matrix2[i,28-j+1] <- matrix1[i,j]\n    \n    image(matrix2, axes=FALSE, col=topo.colors(12))\n}\n\ndata <- predictions$cluster[101:198]\nfor (k in data)\n{\n    row <- NULL\n    for (n in 1:784)\n        row[n] <- X_train[k,n]\n    \n    matrix1 <- matrix(row,28,28,byrow=FALSE)\n    matrix2 <- matrix(rep(0,784),28,28)\n    \n    for (i in 1:28)\n        for (j in 1:28)\n            matrix2[i,28-j+1] <- matrix1[i,j]\n    \n    image(matrix2, axes=FALSE, col=heat.colors(12))\n}\n\nrm(i,n,j,k,row,matrix1,matrix2)"},{"cell_type":"markdown","metadata":{"_cell_guid":"11587533-5911-e123-16a3-2b52f4c78757"},"source":"## Conclusion ##\n\n\n----------\nLife teaches us: The best algorithm is not the most complicated. \n\n94.9% accuracy! And I am still think it is not the limit. Do you see some area for improvements in this algorithm? Do you have some other great ideas? Please, share:)"}],"metadata":{"_change_revision":0,"_is_fork":false,"kernelspec":{"display_name":"R","language":"R","name":"ir"},"language_info":{"codemirror_mode":"r","file_extension":".r","mimetype":"text/x-r-source","name":"R","pygments_lexer":"r","version":"3.3.2"}},"nbformat":4,"nbformat_minor":0}