Liz's Blog

就是要學R #13:機器學習之邏輯迴歸實作篇

| Comments

這篇很多時候,都在講怎麼整理資料,因為分析只是幾個特定指令,但整理資料卻會花掉大多時間。學習這篇的時候,複習了R Programming 進階篇資料前處理篇(dplyr、tidyr)機器學習之線性迴歸實作篇。然後跟之前另一堂課Data Science A-Z™: Real-Life Data Science Exercises Included教過的一些建模方法又模模糊糊的複習一次。

Udemy
課程名稱:Data Science and Machine Learning Bootcamp with R
講師:Jose Portilla

邏輯迴歸利用的是Kaggle上有名的鐵達尼號資料,預測是存活還是死亡的練習。會用到Generalized Linear Model(GLM廣義線性模型)來做模型,理論可以先參考這篇〈廣義線性模型觀點:統計迴歸分析(REGRESSION)的基本原理與結構〉。
1.整理資料

df.train <- read.csv('titanic_train.csv')
head(df.train)

#安裝並載入Amelia套件,處理Missing Data的資料。
install.packages('Amelia')
library(Amelia)

#missmap()用圖表表現出資料缺失的位置。main=圖表標題,col=c("缺失資料的顏色", "正常資料的顏色"),legend=圖例。會跑出約有五分之一的年齡資料是沒有的。
missmap(df.train, main="Titanic Training Data - Missings Map", 
        col=c("yellow", "black"), legend=FALSE)

#利用ggplot2來視覺化資料。
library(ggplot2)

#畫出存活人數的柱狀圖。
ggplot(df.train,aes(Survived)) + geom_bar()

#將艙等轉成factor,再畫出各船票等級人數柱狀圖。
ggplot(df.train,aes(Pclass)) + geom_bar(aes(fill=factor(Pclass)),alpha=0.5)

#將性別先轉成factor,再畫出男女人數柱狀圖。
ggplot(df.train,aes(Sex)) + geom_bar(aes(fill=factor(Sex)),alpha=0.5)

#畫出各年齡的直方圖。
ggplot(df.train,aes(Age)) + geom_histogram(fill='blue',bins=20,alpha=0.5)

#畫出和兄弟姊妹、配偶一起搭船人數柱狀圖。
ggplot(df.train,aes(SibSp)) + geom_bar(fill='red',alpha=0.5)

#畫出費用分佈的柱狀圖。
ggplot(df.train,aes(Fare)) + geom_histogram(fill='green',color='black',alpha=0.5)

#利用盒鬚圖來視覺化不同艙等的平均年齡。會看到較高級的艙等,平均年齡較高。
pl <- ggplot(df.train,aes(Pclass,Age)) + geom_boxplot(aes(group=Pclass,fill=factor(Pclass),alpha=0.4)) 
pl + scale_y_continuous(breaks = seq(min(0), max(80), by = 2))

#將年齡顯示NA的資料,依照艙等轉成平均年齡。
impute_age <- function(age,class){
    out <- age
    for (i in 1:length(age)){
        
        if (is.na(age[i])){

            if (class[i] == 1){
                out[i] <- 37

            }else if (class[i] == 2){
                out[i] <- 29

            }else{
                out[i] <- 24
            }
        }else{
            out[i]<-age[i]
        }
    }
    return(out)
}

fixed.ages <- impute_age(df.train$Age,df.train$Pclass)
df.train$Age <- fixed.ages

#確認是否還有缺失資料。
missmap(df.train, main="Titanic Training Data - Missings Map", 
        col=c("yellow", "black"), legend=FALSE)

2.建立邏輯迴歸模型

str(df.train)
head(df.train,3)

#先去除不相關的欄位,如:PassengerId、Name、Ticket、Cabin。
library(dplyr)
df.train <- select(df.train,-PassengerId,-Name,-Ticket,-Cabin)
head(df.train,3)
str(df.train)

#將Survived、Pclass、Parch、SibSp,從整數轉成factor。
df.train$Survived <- factor(df.train$Survived)
df.train$Pclass <- factor(df.train$Pclass)
df.train$Parch <- factor(df.train$Parch)
df.train$SibSp <- factor(df.train$SibSp)

#使用廣義線性迴歸。針對所有變數去預測是否會存活。
log.model <- glm(formula=Survived ~ . , family = binomial(link='logit'),data = df.train)
summary(log.model)

#使用測試組資料來預測資料。
library(caTools)
set.seed(101)
split = sample.split(df.train$Survived, SplitRatio = 0.70)
final.train = subset(df.train, split == TRUE)
final.test = subset(df.train, split == FALSE)

#利用訓練組資料來建立模型。
final.log.model <- glm(formula=Survived ~ . , family = binomial(link='logit'),data = final.train)
summary(final.log.model)

#確認預測的準確率。
fitted.probabilities <- predict(final.log.model,newdata=final.test,type='response')
fitted.results <- ifelse(fitted.probabilities > 0.5,1,0)
misClasificError <- mean(fitted.results != final.test$Survived)
print(paste('Accuracy',1-misClasificError))
table(final.test$Survived, fitted.probabilities > 0.5)

講師給的另外一個範例是,利用UCI adult資料集中的變數,來預測每年收入會是小於等於50k,還是大於50k。
1.整理資料(該變數類別太多時,可將數量比較少的或是性質類似的組別合併成同一個類別)

adult <- read.csv('adult_sal.csv')
head(adult)
library(dplyr)

#X欄位是重複的,所以不選擇。
adult <- select(adult,-X)

#檢查資料時,會發現有許多欄位屬於類別因子,但有些是不需要的。
head(adult)
str(adult)
summary(adult)

#利用table()確認各選項的數目。
table(adult$type_employer)

#最小的兩個組別是Never-worked和Without-pay,將兩個合併成Unemployed。可以用as.character()先轉成character的形式,再利用sapply組合。
unemp <- function(job){
    job <- as.character(job)
    if (job=='Never-worked' | job=='Without-pay'){
        return('Unemployed')
    }else{
        return(job)
    }
}
adult$type_employer <- sapply(adult$type_employer,unemp)

#把State-gov或Local-gov的兩個選項合併到SL-gov的組別裡,再把Self-emp-inc及Self-emp-not-inc,放到self-emp的群組裡。
group_emp <- function(job){
    if (job=='Local-gov' | job=='State-gov'){
        return('SL-gov')
    }else if (job=='Self-emp-inc' | job=='Self-emp-not-inc'){
        return('self-emp')
    }else{
        return(job)
    }
}
adult$type_employer <- sapply(adult$type_employer,group_emp)

#最後則會得到?、Federal-gov、Private、self-emp、SL-gov、Unemployed六個類別。
table(adult$type_employer)

2.整理資料(婚姻狀況一言難盡???先用已婚、未婚、結過婚即可)

#婚姻欄位中,本來有Divorced、Married-AF-spouse、Married-civ-spouse、Married-spouse-absent、Never-married、Separated、Widowed類別。
table(adult$marital)

#目標把類別縮減成Not-Married、Never-Married、Married。
group_marital <- function(mar){
    mar <- as.character(mar)
    
    # Not-Married
    if (mar=='Separated' | mar=='Divorced' | mar=='Widowed'){
        return('Not-Married')
    
    # Never-Married   
    }else if(mar=='Never-married'){
        return(mar)
    
    # Married
    }else{
        return('Married')
    }
}
adult$marital <- sapply(adult$marital,group_marital)
table(adult$marital)

3.整理資料(文化大熔爐???或許可以先用六大洲當作分類別)

table(adult$country)
levels(adult$country)

Asia <- c('China','Hong','India','Iran','Cambodia','Japan', 'Laos' ,
          'Philippines' ,'Vietnam' ,'Taiwan', 'Thailand')

North.America <- c('Canada','United-States','Puerto-Rico' )

Europe <- c('England' ,'France', 'Germany' ,'Greece','Holand-Netherlands','Hungary',
            'Ireland','Italy','Poland','Portugal','Scotland','Yugoslavia')

Latin.and.South.America <- c('Columbia','Cuba','Dominican-Republic','Ecuador',
                             'El-Salvador','Guatemala','Haiti','Honduras',
                             'Mexico','Nicaragua','Outlying-US(Guam-USVI-etc)','Peru',
                            'Jamaica','Trinadad&Tobago')
Other <- c('South')

group_country <- function(ctry){
    if (ctry %in% Asia){
        return('Asia')
    }else if (ctry %in% North.America){
        return('North.America')
    }else if (ctry %in% Europe){
        return('Europe')
    }else if (ctry %in% Latin.and.South.America){
        return('Latin.and.South.America')
    }else{
        return('Other')      
    }
}
adult$country <- sapply(adult$country,group_country)
table(adult$country)

#剛剛轉換type_employer、country、marital的時候,有把資料轉成character,這時候再用sapply轉成factor的形式。利用adult$type_employer <- factor(adult$type_employer)也是同樣可行。
adult$type_employer <- sapply(adult$type_employer,factor)
adult$country <- sapply(adult$country,factor)
adult$marital <- sapply(adult$marital,factor)
str(adult)

4.使用Amelia套件來處理缺失的資料。

library(Amelia)
adult[adult == '?'] <- NA

#利用missmap可以快速得知資料缺失的變數。
missmap(adult,y.at=c(1),y.labels = c(''),col=c('yellow','black'))

#na.omit()是用來去除NA資料的函數,但是不是要去除NA應該取決於分析的資料。
adult <- na.omit(adult)
missmap(adult,y.at=c(1),y.labels = c(''),col=c('yellow','black'))

str(adult)
library(ggplot2)
library(dplyr)

#利用直方圖來看年齡和收入的分佈。
ggplot(adult,aes(age)) + geom_histogram(aes(fill=income),color='black',binwidth=1) + theme_bw()

#利用直方圖來看每週工時的分佈。
ggplot(adult,aes(hr_per_week)) + geom_histogram() + theme_bw()

#將國家欄位改成區域。
names(adult)[names(adult)=="country"] <- "region"

#利用直方圖來看各區域收入分佈。
ggplot(adult,aes(region)) + geom_bar(aes(fill=income),color='black')+theme_bw()+
theme(axis.text.x = element_text(angle = 90, hjust = 1))

5.建立模型來預測薪水會是小於等於50k,或者大於50k。

#利用caTools套件將樣本分成訓練組或測試組。
head(adult)
library(caTools)
set.seed(101) 
sample <- sample.split(adult$income, SplitRatio = 0.70)
train = subset(adult, sample == TRUE)
test = subset(adult, sample == FALSE)

#使用glm來建模。邏輯迴歸記得要輸入family = binomial(logit)。
model = glm(income ~ ., family = binomial(logit), data = train)
summary(model)

#從結果中可以看到有些變數比較相關,有些則不是,這時候可以使用step()來去除比較不相關的變數。
help(step)
new.step.model <- step(model)
summary(new.step.model)

#建立一個confusion matrix,來看預測正確率。
test$predicted.income = predict(model, newdata=test, type="response")
table(test$income, test$predicted.income > 0.5)

如果有rank deficient fit的問題,有可能跟資料不夠有關,詳細可參考這篇文章。Precision、Accuracy、Recall則可以參考這篇的說明

【延伸閱讀】
1.就是要學R #1:Basic 基礎篇
2.就是要學R #2:Matrix 矩陣篇
3.就是要學R #3:Data Frame 資料框架篇
4.就是要學R #4:List 列表篇
5.就是要學R #5:Import & Export 匯入匯出篇(csv & excel)
6.就是要學R #6:Import & Export 匯入匯出篇(SQL & web scraping)
7.就是要學R #7:R programming 基礎篇
8.就是要學R #8:R Programming 進階篇
9.就是要學R #9:資料前處理篇(dplyr、tidyr)
10.就是要學R #10:ggplot2幫你搞定資料視覺化
11.就是要學R #11:資料視覺化應用篇(ggplot2、Plotly)
12.就是要學R #12:機器學習之線性迴歸實作篇
13.就是要學R #13:機器學習之邏輯迴歸實作篇
14.就是要學R #14:機器學習之K Nearest Neighbor(KNN)實作篇
15.就是要學R #15:機器學習之決策樹、隨機森林實作篇
16.就是要學R #16:機器學習之Support Vector Machine(SVM)實作篇
17.就是要學R #17:機器學習之K Means Clustering實作篇
18.就是要學R #18:機器學習之自然語言處理(NLP)實作篇
19.就是要學R #19:機器學習之類神經網路(Neural Net)實作篇

Comments

comments powered by Disqus