{"cells":[{"metadata":{"_uuid":"59729ed00afb9837c2f4d8e7cee3c6f339c00d62","_execution_state":"idle","trusted":true,"scrolled":true,"_kg_hide-output":true},"cell_type":"code","source":"library(tidyverse) # metapackage with lots of helpful functions\nlibrary(ggplot2)\nlibrary(dplyr)\nlibrary(caret)\nlibrary(readr)\nlibrary(stringr)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"157c8b4bead9fb0f2d0ad88f5b7c4f7c0226c73e"},"cell_type":"markdown","source":"**I decided to start by developing a linear model that would produce an output that I can test against the actual Pet Adoption Speeds.**\n\n**The second model I used was the k-nearest neighbor algorithm. This is the better performing model so far. **\n\n**Would love feedback/comments, I plan to use these first results to develop a better model. **"},{"metadata":{"trusted":true,"_uuid":"539181bdf89dc337ea789c619a7c5f539fc17702","scrolled":false,"_kg_hide-output":true},"cell_type":"code","source":"Train <- read_csv(\"../input/petfinder-adoption-prediction/train/train.csv\") %>% mutate(Word_Count=str_count(Description, \"\\\\w+\"))","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"fa638f518cfd329a20eda623a63a8f1fd00373d7"},"cell_type":"markdown","source":"**I'll need to break the Train data into a train and test dataset to developt the linear model.**"},{"metadata":{"trusted":true,"_uuid":"6a0331a5e0490d77754a6903f2f59bcfd5476e78","scrolled":false},"cell_type":"code","source":"set.seed(1)\ntest_index <- createDataPartition(Train$AdoptionSpeed, times = 1, p = 0.75, list = FALSE)\n\ntrain_set <- Train %>% slice(test_index)\ntest_set <- Train %>% slice(-test_index)\n\nfit <- lm(AdoptionSpeed~Type+Age+Breed1+Breed2+Gender+Color1+Color2+Color3+MaturitySize+FurLength+Vaccinated+Dewormed+Sterilized+Health+Quantity+Fee+State+VideoAmt+PhotoAmt+Word_Count, data = Train)\n\nP <- predict(fit, test_set)\nP2 <- round(P,0)\nRMSE <- sqrt(mean(P2-test_set$AdoptionSpeed)^2)\nRMSE","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"156e26ff71ff1c1c1dfb9a7fcc02c5da1321e3a8"},"cell_type":"markdown","source":"**The mean of the differences between my Adoption Speed predictions and the actual Adoption Speeds is:**"},{"metadata":{"trusted":true,"_uuid":"a0a82891619dbd69f74e408e447f619635e7cbfa","scrolled":true},"cell_type":"code","source":"mean(P2-test_set$AdoptionSpeed)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"fbf9582bb6ba74b29ef337fe289f1d132be83188"},"cell_type":"markdown","source":"**Lets also look at the Standard Deviation to understand a little bit more about the differences between predicted and actual Adoption Speed. We see that the SD is over 1 whole point away from the expected value. This means most of our predictions aren't perfect, but they are only about 1 point off of the actual Adoption Speed.  **"},{"metadata":{"trusted":true,"scrolled":true,"_uuid":"12454516a7e06d30387b5161b9be521ffb7e3409"},"cell_type":"code","source":"sd(P2-test_set$AdoptionSpeed)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"306d62556992c07d0157414a5c34f6b339a2b0c7"},"cell_type":"markdown","source":"**Next, lets looks at a histogram of the differences between predicted Adoption Speeds and actual Adoption Speeds. About 25% have been correctly predicted (the difference is zero), then we see that the next 53% of predictions land within at least 1 point of the actual value. My next step could be investigating the next 53% of predictions, or testing more models for better predictions.**"},{"metadata":{"trusted":true,"_uuid":"06fc9aaea442d5d09c34cb24ecc0ba6f1ab397fd"},"cell_type":"code","source":"points <- (P2-test_set$AdoptionSpeed)\npoints2 <- (P-test_set$AdoptionSpeed)\ndata.frame(points) %>% group_by(points) %>% summarise(total = n(), portion = total/3748)\ndata.frame(points) %>% ggplot(aes(points))+geom_histogram(binwidth = .25)\nplot(points2)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"5d3ba7256cbca561dcfdd50659f6f9af1e718376"},"cell_type":"markdown","source":"**Submission of Linear Model:**"},{"metadata":{"trusted":true,"_uuid":"ae01706b1f86b3d3c66db49d7af3d504d87d2e8c","scrolled":false},"cell_type":"code","source":"SampleSub <- read_csv(\"../input/petfinder-adoption-prediction/test/sample_submission.csv\") %>% select(PetID)\n\nTest <- read_csv(\"../input/petfinder-adoption-prediction/test/test.csv\") %>% mutate(Word_Count=str_count(Description, \"\\\\w+\")) \nTest2 <- Test %>% mutate(Prediction = predict(fit, Test)) %>% mutate(AdoptionSpeed = round(Prediction,0)) \nSubmission <- merge(SampleSub, Test2, by = \"PetID\") %>% select(PetID, AdoptionSpeed)\nwrite.csv(data.frame(Submission) , file = 'submission1.csv' , row.names = FALSE )","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"49bc02a31ff102aba4f9991ef0313500980d339c"},"cell_type":"markdown","source":"If we look at a basic correlation plot from the full Train dataset, we can see nothing has a strong correlation. However, it is interesting to see where a very low correlation does exist. Some of these we expect, such as Vaccinated, Dewormed, and Sterilized being negative correlations. However, it is interesting to see the PhotoAmt and VideoAmt having correlations with the amount of days it takes to adopt a pet. Seeing the animals must somehow detract the willingness to adopt. This tells us the key to better predicting the AdoptionSpeed potentially lies within the pictures."},{"metadata":{"_uuid":"8f70a8c6f5ff068c5f6708aa704722b6af841dd3"},"cell_type":"markdown","source":"****K Nearest Neighbor:**"},{"metadata":{"trusted":true,"scrolled":false,"_uuid":"ca789272be7c5896e303b49f5217b63c5081fc4a"},"cell_type":"code","source":"set.seed(2)\ntest_indexK <- createDataPartition(Train$AdoptionSpeed, times = 1, p = 0.75, list = FALSE)\n\ntrain_setK <- Train %>% slice(test_indexK)\ntest_setK <- Train %>% slice(-test_indexK)\n\n#To test predictions\ntest_setK2 <- test_setK %>% mutate(Row = 1:3748)\n\nxK <- train_setK %>% select(AdoptionSpeed,Type,Age,Breed1,Breed2,Gender,Color1,Color2,Color3,MaturitySize,FurLength,Vaccinated,Dewormed,Sterilized,Health,Quantity,Fee,State,VideoAmt,PhotoAmt,Word_Count)\nfitK <- knn3(AdoptionSpeed~., data = xK, k = 24)\n\nPK <- predict(fitK, test_setK, type = \"prob\")\n\nP2K <- PK%>% data.frame() %>% mutate(Row = 1:3748)\ncheck <- merge(test_setK2, P2K, by = \"Row\") %>% mutate(AdoptionSpeed2 = ifelse(X0>=X1&X0>=X2&X0>=X3&X0>=X4, 0, ifelse(X1>=X0&X1>=X2&X1>=X3&X1>=X4, 1, ifelse(X2>=X0&X2>=X1&X2>=X3&X2>=X4, 2, ifelse(X3>=X0&X3>=X1&X3>=X2&X3>=X4, 3, ifelse(X4>=X0&X4>=X1&X4>=X2&X4>=X3, 4, \"NA\"))))))\n\ncheck2 <- check %>% mutate(Match = AdoptionSpeed==AdoptionSpeed2) %>% group_by(Match) %>% summarise(n())\ncheck2\n1338/3748","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"681ec98a1b8c9709a41dc877bf6e9ce4001dcbcd","scrolled":true},"cell_type":"code","source":"SampleSubK <- read_csv(\"../input/petfinder-adoption-prediction/test/sample_submission.csv\") %>% select(PetID)\n\nTest <- read_csv(\"../input/petfinder-adoption-prediction/test/test.csv\") %>% mutate(Word_Count=str_count(Description, \"\\\\w+\"), Row = 1:3948) \n\nPK2 <- predict(fitK, Test, type = \"prob\")\nPK22 <- PK2%>% data.frame() %>% mutate(Row = 1:3948)\n\nsubk <- merge(Test, PK22, by = \"Row\") %>% mutate(AdoptionSpeed = ifelse(X0>=X1&X0>=X2&X0>=X3&X0>=X4, 0, ifelse(X1>=X0&X1>=X2&X1>=X3&X1>=X4, 1, ifelse(X2>=X0&X2>=X1&X2>=X3&X2>=X4, 2, ifelse(X3>=X0&X3>=X1&X3>=X2&X3>=X4, 3, ifelse(X4>=X0&X4>=X1&X4>=X2&X4>=X3, 4, \"NA\"))))))\nsubk2 <- subk %>% select(PetID, AdoptionSpeed)\n\nwrite.csv(data.frame(subk2) , file = 'submission2.csv' , row.names = FALSE )","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"e77211858181e4c7a86616d5f6554aaf670c19c0"},"cell_type":"code","source":"Train %>% group_by(AdoptionSpeed) %>% summarise(total = n()) %>% ggplot(aes(AdoptionSpeed, total)) + geom_point()","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"05b38d7f30e4112edbc11dea29aace80e5b549ae"},"cell_type":"markdown","source":"QDA Train"},{"metadata":{"trusted":true,"_uuid":"9e5d506cb2afba6975cd4f5207a318cf9d478c55"},"cell_type":"code","source":"library(randomForest)\nset.seed(2)\ntest_indexK <- createDataPartition(Train$AdoptionSpeed, times = 1, p = 0.75, list = FALSE)\n\ntrain_setK <- Train %>% slice(test_indexK)\ntest_setK <- Train %>% slice(-test_indexK)\n\n#To test predictions\ntest_setK2 <- test_setK %>% mutate(Row = 1:3748)\n\nxK <- train_setK %>% select(AdoptionSpeed,Type,Age,Breed1,Breed2,Gender,Color1,Color2,Color3,MaturitySize,FurLength,Vaccinated,Dewormed,Sterilized,Health,Quantity,Fee,State,VideoAmt,PhotoAmt,Word_Count)\n\nfitK <- randomForest(AdoptionSpeed~., data = xK)\n\nPK <- predict(fitK, test_setK)\n\nPKFinal <- PK%>% round(0) %>% data.frame() %>% mutate(Row = 1:3748)\n\ncheck <- merge(test_setK2, PKFinal, by = \"Row\")\ncheck\n\ncheck2 <- check %>% mutate(Match = AdoptionSpeed==.) %>% group_by(Match) %>% summarise(n())\ncheck2\n1338/3748","execution_count":null,"outputs":[]}],"metadata":{"kernelspec":{"display_name":"R","language":"R","name":"ir"},"language_info":{"mimetype":"text/x-r-source","name":"R","pygments_lexer":"r","version":"3.4.2","file_extension":".r","codemirror_mode":"r"}},"nbformat":4,"nbformat_minor":1}