ID3 Algorithm - R Programming

HW07 Support Files/.Rhistory

data <- read.table(url, fileEncoding="UTF-8", sep=",") str(iris) library(ggplot2) ggplot(data = iris, aes(x = Sepal.Length, y = Sepal.Width, col = Species)) + geom_point() ggplot(data = iris, aes(x = Petal.Length, y = Petal.Width, col = Species)) + geom_point() library(GGally) ggpairs(iris) error <- c() for (i in 1:15) { knn.fit <- knn(train = iris_train[,1:4], test = iris_test[,1:4], cl = as.factor(iris_train$Species), k = i) error[i] = 1- mean(knn.fit == iris_test$Species) } head(iris) iris_2 <- iris[-5] head(iris_2) iris_3 <- as.data.frame(scale(iris_2)) head(iris_2) head(iris_3) sapply(iris_2) sapply(iris_2,mean) sapply(iris_3,mean) sapply(iris_3,sd) sapply(iris_2,sd) library(Nbclust) library(NBclust) library(NbClust) install.packages(NbClust) install.packages("NbClust") library(NbClust) wssplot(iris_3, nc=30, seed=1234) help(wssplot) ??wssplot wssplot <- function(data, nc=15, seed=1234){ wss <- (nrow(data)-1)*sum(apply(data,2,var)) for (i in 2:nc){ set.seed(seed) wss[i] <- sum(kmeans(data, centers=i)$withinss)} plot(1:nc, wss, type="b", xlab="Number of Clusters", ylab="Within groups sum of squares")} wssplot(iris_3, nc=30, seed=1234) ??NbClust w1 < kmeans(iris_3, 5) w1 <- kmeans(iris_3, 5) plot(w1) w1 wssplot <- function(data, nc=15, seed=1234){ wss <- (nrow(data)-1)*sum(apply(data,2,var)) for (i in 2:nc){ set.seed(seed) wss[i] <- sum(kmeans(data, centers=i)$withinss)} plot(1:nc, wss, type="b", xlab="Number of Clusters", ylab="Within groups sum of squares")} wssplot(iris_3,nc=30,seed=1234) wssplot(iris_3,nc=30,seed=1234) iris_kmeans<-kmeans(iris_3,7) iris_kmeans$centers iris_kmeans$size iris_kmeans iris$clstr<-iris_kmeans$cluster iris table(iris$Species,iris$clstr) set.seed(20) irisCluster <- kmeans(iris[, 3:4], 3, nstart = 20) irisCluster set.seed(20) irisCluster2 <- kmeans(iris_3, 3) irisCluster2 set.seed(20) irisCluster3 <- kmeans(iris[, 3:4], 3, nstart = 20) irisCluster3 ?table set.seed(20) irisCluster2 <- kmeans(iris_3, 3, nstart=3) irisCluster2 set.seed(20) irisCluster2 <- kmeans(iris_3, 3, nstart=20) irisCluster2 set.seed(20) irisCluster2 <- kmeans(iris_3, 3, nstart=20) irisCluster2 set.seed(20) irisCluster3 <- kmeans(iris[, 3:4], 3, nstart = 20) irisCluster3 install.packages(c("arules", "arulesViz")) # appears on console library('arules') library('arulesViz') data(Groceries) summary(Groceries) # indicates 9835 rows Groceries@itemInfo[1:10,] apply(Groceries@data[,10:20],2,function(r) paste(Groceries@itemInfo[r,"labels"],collapse=", ")) apply(Groceries@data[,10:20],2,function(r) paste(Groceries@itemInfo[r,"labels"],collapse=", ")) paste(Groceries@itemInfo[r,"labels"],collapse=", ")) apply(Groceries@data[,10:20],2,function(r) paste(Groceries@itemInfo[r,"labels"],collapse=", ")) library(tidyverse) mpg ggplot(data = mpg) + geom_point(mapping = aes(x = displ, y = hwy)) ggplot(data = mpg) str(mpg) table(mpg) summary(mpg) ggplot(data = mpg) + geom_point(mapping = aes(x = hwy, y = cyl)) ggplot(data = mpg) + geom_point(mapping = aes(x = cyl, y = hwy)) ggplot(data = mpg) + geom_point(mapping = aes(x = hwy, y = cyl)) clear() clr() demo() library(tidyverse) tidyverse_update() install.packages(c("broom", "haven", "httr", "jsonlite", "readr", "readxl")) library(tidyverse) library(dplyr) install.packages(c("nycflights13", "gapminder", "Lahman")) library(tidyverse) ggplot(data = mpg) + geom_point(mapping = aes(x = displ, y = hwy)) my_variable <- 12 my_variable my_variable <- 10 my_varıable my_variable <- 10 my_variable <- 10 my_varıable my_variable <- 10 my_varıable my_variable library(tidyverse) as_tibble(iris) iris mtcars as_tibble(mtcars) df <- data.frame(abc = 1, xyz = "a") df$x df[, "xyz"] df[, c("abc", "xyz")] df as_tibble(abc=1, xyz="a") df2 <- tibble(abc=1, xyz="a") dfw df2 table1 table2 table3 table4a table4b income_input = as.data.frame( read.csv("c:/data/income.csv") ) income_input[1:10,] income_input = as.data.frame( read.csv("/Users/alirshah/Desktop/Training/UC/RProg/rstudiofiles/income.csv") ) income_input[1:10,] summary(income_input) library(lattice) splom(~income_input[c(2:5)], groups=NULL, data=income_input, axis.line.tck = 0, axis.text.alpha = 0) library(GGally) ?ggally ggpairs(income_input) splom(~income_input[c(2:5)], groups=NULL, data=income_input, axis.line.tck = 0, axis.text.alpha = 0) results <- lm(Income~Age + Education + Gender, income_input) summary(results) results2 <- lm(Income ~ Age + Education, income_input) summary(results2) results3 <- lm(Income~Age + Education, + Alabama, + Alaska, + Arizona, . . . + WestVirginia, + Wisconsin, income_input) with(results2, { plot(fitted.values, residuals,ylim=c(-40,40) ) points(c(min(fitted.values),max(fitted.values)), c(0,0), type = "l")}) hist(results2$residuals, main="") hist(results2$residuals, main="") qqnorm(results2$residuals, ylab="Residuals", main="") qqline(results2$residuals) # compute confidence intevals for the model parameters confint(results2, level = .95) # compute a confidence interval on the expected income of a person Age <- 41 Education <- 12 new_pt <- data.frame(Age, Education) conf_int_pt <- predict(results2, new_pt, level=.95, interval="confidence") conf_int_pt # compute a prediction interval on the income of the same person pred_int_pt <- predict(results2, new_pt, level=.95, interval="prediction") pred_int_pt library(tidyverse) mpg ggplot(data = mpg) + geom_point(mapping = aes(x = displ, y = hwy)) ?ggplot ggplot(data = mpg) table(mpg) str(mpg) ggplot(data = mpg) + geom_point(mapping = aes(x = displ, y = hwy, color = class)) x <- 3 * 4 x iris as.tibble(iris) pairs(iris[1:4], main = "Anderson's Iris Data -- 3 species", pch = 21, bg = c("red", "green3", "blue")[unclass(iris$Species)] ) # Generate random log normal income data income = rlnorm(5000, meanlog=log(40000), sdlog=log(5)) # Part I: Create the density plot plot(density(log10(income), adjust=0.5), main="Distribution of Account Values (log10 scale)") # Add rug to the density plot rug(log10(income)) # Part II: Make the histogram # Create "log-like bins" breaks = c(0, 1000, 5000, 10000, 50000, 100000, 5e5, 1e6, 2e7) # Create bins and label the data bins = cut(income, breaks, include.lowest=T, labels = c("< 1K", "1-5K", "5-10K", "10-50K", "50-100K", "100-500K", "500K-1M", "> 1M")) # Plot the bins plot(bins, main = "Distribution of Account Values", xlab = "Account value ($ USD)", ylab = "Number of Accounts", col="blue") data(Groceries) Groceries install.packages('arules') install.packages('arulesViz') library('arules') library('arulesViz') data(Groceries) Groceries summary(Groceries) class(Groceries) # display the first 20 grocery labels Groceries@itemInfo[1:20,] # display the 10th to 20th transactions apply(Groceries@data[,10:20], 2, function(r) paste(Groceries@itemInfo[r,"labels"], collapse=", ") ) # frequent 1-itemsets itemsets <- apriori(Groceries, parameter=list(minlen=1, maxlen=1, support=0.02, target="frequent itemsets")) summary(itemsets) inspect(head(sort(itemsets, by = "support"), 10)) # frequent 2-itemsets itemsets <- apriori(Groceries, parameter=list(minlen=2, maxlen=2, support=0.02, target="frequent itemsets")) summary(itemsets) inspect(head(sort(itemsets, by ="support"),10)) # frequent 3-itemsets itemsets <- apriori(Groceries, parameter=list(minlen=3, maxlen=3, support=0.02, target="frequent itemsets")) inspect(sort(itemsets, by ="support")) # frequent 4-itemsets itemsets <- apriori(Groceries, parameter=list(minlen=4, maxlen=4, support=0.02, target="frequent itemsets")) inspect(sort(itemsets, by ="support")) # run Apriori without setting the maxlen parameter itemsets <- apriori(Groceries, parameter=list(minlen=1, support=0.02, target="frequent itemsets")) rules <- apriori(Groceries, parameter=list(support=0.001, confidence=0.6, target = "rules")) summary(rules) plot(rules) plot(rules@quality) # displays rules with top lift scores inspect(head(sort(rules, by="lift"), 10)) confidentRules <- rules[quality(rules)$confidence > 0.9] confidentRules plot(confidentRules, method="matrix", measure=c("lift", "confidence"), control=list(reorder=TRUE)) plot(confidentRules, method="matrix", measure=c("lift", "confidence"), control=list(reorder=TRUE)) plot(highLiftRules, method="graph", control=list(type="items")) highLiftRules <- head(sort(rules, by="lift"), 5) plot(highLiftRules, method="graph", control=list(type="items")) rules <- apriori(Groceries, parameter=list(support=0.001, confidence=0.6, target = "rules")) summary(rules) plot(rules) plot(rules@quality) # displays rules with top lift scores inspect(head(sort(rules, by="lift"), 10)) confidentRules <- rules[quality(rules)$confidence > 0.9] confidentRules plot(confidentRules, method="matrix", measure=c("lift", "confidence"), control=list(reorder=TRUE)) # select the 5 rules with the highest lift highLiftRules <- head(sort(rules, by="lift"), 5) plot(highLiftRules, method="graph", control=list(type="items")) data("Groceries") string(Groceries) str(Groceries) Groceries as.tibble(Groceries) mydata <- read.csv("https://stats.idre.ucla.edu/stat/data/binary.csv") mydata$rank <- factor(mydata$rank) mylogit <- glm(admit ~ gre + gpa + rank, data = mydata, family = "binomial") summary(mylogit) install.packages("rpart.plot") # install package rpart.plot library("rpart") library("rpart.plot") banktrain <- read.table("bank-sample.csv",header=TRUE,sep=",") setwd("~/Desktop/Training/UC/ITS 836 Big Data Analytics/ITS836 Spring 2019/Week07/HW07 Support Files") banktrain <- read.table("bank-sample.csv",header=TRUE,sep=",") View(banktrain) drops<-c("age", "balance", "day", "campaign", "pdays", "previous", "month") banktrain <- banktrain [,!(names(banktrain) %in% drops)] summary(banktrain) fit <- rpart(subscribed ~ job + marital + education + default + housing + loan + contact + poutcome, method="class", data=banktrain, control=rpart.control(minsplit=1), parms=list(split='information')) summary(fit) # Plot the tree rpart.plot(fit, type=4, extra=2, clip.right.labs=FALSE, varlen=0, faclen=3) # Entropy of coin flips x <- sort(runif(1000)) y <- data.frame(x=x, y=-x*log2(x)-(1-x)*log2(1-x)) plot(y, type="l", xlab="P(X=1)", ylab=expression("H"["X"])) grid() # include a numeric variable "duration" into the model fit <- rpart(subscribed ~ job + marital + education + default + housing + loan + contact + duration + poutcome, method="class", data=banktrain, control=rpart.control(minsplit=1), parms=list(split='information')) summary(fit) # Plot the tree rpart.plot(fit, type=4, extra=2, clip.right.labs=FALSE, varlen=0, faclen=3) newdata <- data.frame(job="retired", marital="married", education="secondary", default="no", housing="yes", loan="no", contact = "cellular", duration = 598, poutcome="unknown") newdata predict(fit,newdata=newdata,type=c("class")) library("rpart") # load libraries library("rpart.plot") # Read the data play_decision <- read.table("DTdata.csv", header=TRUE, sep=",") play_decision summary(play_decision) # build the decision tree fit <- rpart(Play ~ Outlook + Temperature + Humidity + Wind, method="class", data=play_decision, control=rpart.control(minsplit=1), parms=list(split='information')) summary(fit) ?rpart.plot rpart.plot(fit, type=4, extra=1) rpart.plot(fit, type=4, extra=1) rpart.plot(fit, type=4, extra=2, clip.right.labs=FALSE, varlen=0, faclen=0) newdata <- data.frame(Outlook="rainy", Temperature="mild", Humidity="high", Wind=FALSE) newdata predict(fit,newdata=newdata,type="prob") predict(fit,newdata=newdata,type="class") banktrain <- read.table("bank-sample.csv",header=TRUE,sep=",") # install some packages install.packages("ROCR") library(ROCR) banktrain <- read.table("bank-sample.csv",header=TRUE,sep=",") drops <- c("balance", "day", "campaign", "pdays", "previous", "month") banktrain <- banktrain [,!(names(banktrain) %in% drops)] # testing set banktest <- read.table("bank-sample-test.csv",header=TRUE,sep=",") banktest <- banktest [,!(names(banktest) %in% drops)] # build the na?ve Bayes classifier nb_model <- naiveBayes(subscribed~., data=banktrain) # perform on the testing set nb_prediction <- predict(nb_model, # remove column "subscribed" banktest[,-ncol(banktest)], type='raw') score <- nb_prediction[, c("yes")] actual_class <- banktest$subscribed == 'yes' pred <- prediction(score, actual_class) perf <- performance(pred, "tpr", "fpr") plot(perf, lwd=2, xlab="False Positive Rate (FPR)", ylab="True Positive Rate (TPR)") abline(a=0, b=1, col="gray50", lty=3) ## corresponding AUC score auc <- performance(pred, "auc") auc <- unlist(slot(auc, "y.values")) auc auc <- performance(pred, "auc") library("rpart") library("rpart.plot") banktrain <- read.table("bank-sample.csv",header=TRUE,sep=",") ## drop a few columns to simplify the model drops<-c("balance", "day", "campaign", "pdays", "previous", "month") banktrain <- banktrain [,!(names(banktrain) %in% drops)] summary(banktrain) ## testing set # banktest <- read.table("bank-sample-test.csv",header=TRUE,sep=",") # banktest <- banktest [,!(names(banktest) %in% drops)] # summary(banktest) ## manually compute the conditional probabilities maritalCounts <- table(banktrain[,c("subscribed", "marital")]) maritalCounts <- maritalCounts/rowSums(maritalCounts) maritalCounts maritalCounts["yes","divorced"] jobCounts <- table(banktrain[,c("subscribed", "job")]) jobCounts <- jobCounts/rowSums(jobCounts) jobCounts install.packages("e1071") # install package e1071 library(e1071) # load the library sample <- read.table("sample1.csv",header=TRUE,sep=",") print(sample) # read the data into a table from the file sample <- read.table("sample1.csv",header=TRUE,sep=",") # define the data frames for the NB classifier traindata <- as.data.frame(sample[1:14,]) testdata <- as.data.frame(sample[15,]) traindata testdata dir() sample <- read.table("sample1.csv",header=TRUE,sep=",") print(sample) # read the data into a table from the file sample <- read.table("sample1.csv",header=TRUE,sep=",") # define the data frames for the NB classifier traindata <- as.data.frame(sample[1:14,]) testdata <- as.data.frame(sample[15,]) traindata testdata tprior <- table(traindata$Enrolls) tprior tprior <- tprior/sum(tprior) tprior ageCounts <- table(traindata[,c("Enrolls", "Age")]) ageCounts ageCounts <- ageCounts/rowSums(ageCounts) ageCounts incomeCounts <- table(traindata[,c("Enrolls", "Income")]) incomeCounts <- incomeCounts/rowSums(incomeCounts) incomeCounts jsCounts <- table(traindata[,c("Enrolls", "JobSatisfaction")]) jsCounts <- jsCounts/rowSums(jsCounts) jsCounts desireCounts <- table(traindata[,c("Enrolls", "Desire")]) desireCounts <- desireCounts/rowSums(desireCounts) desireCounts prob_yes <- ageCounts["Yes",testdata[,c("Age")]]* incomeCounts["Yes",testdata[,c("Income")]]* jsCounts["Yes",testdata[,c("JobSatisfaction")]]* desireCounts["Yes",testdata[,c("Desire")]]* tprior["Yes"] prob_no <- ageCounts["No",testdata[,c("Age")]]* incomeCounts["No",testdata[,c("Income")]]* jsCounts["No",testdata[,c("JobSatisfaction")]]* desireCounts["No",testdata[,c("Desire")]]* tprior["No"] prob_yes prob_no max(prob_yes,prob_no) model <- naiveBayes(Enrolls ~ Age+Income+JobSatisfaction+Desire, traindata) # display model model # predict with testdata results <- predict (model,testdata) # display results results # use the NB classifier with Laplace smoothing model1 = naiveBayes(Enrolls ~., traindata, laplace=.01) # display model model1 # predict with testdata results1 <- predict (model1,testdata) # display results results1 banktrain <- read.table("bank-sample.csv",header=TRUE,sep=",") # drop a few columns drops <- c("balance", "day", "campaign", "pdays", "previous", "month") banktrain <- banktrain [,!(names(banktrain) %in% drops)] # testing set banktest <- read.table("bank-sample-test.csv",header=TRUE,sep=",") banktest <- banktest [,!(names(banktest) %in% drops)] # build the na?ve Bayes classifier nb_model <- naiveBayes(subscribed~., data=banktrain) # perform on the testing set nb_prediction <- predict(nb_model, # remove column "subscribed" banktest[,-ncol(banktest)], type='raw') score <- nb_prediction[, c("yes")] actual_class <- banktest$subscribed == 'yes' pred <- prediction(score, actual_class) perf <- performance(pred, "tpr", "fpr") plot(perf, lwd=2, xlab="False Positive Rate (FPR)", ylab="True Positive Rate (TPR)") abline(a=0, b=1, col="gray50", lty=3) ## corresponding AUC score auc <- performance(pred, "auc") auc <- unlist(slot(auc, "y.values")) auc