close

/*
Logistic Regression 逻辑回归
薪金与房屋补贴的关系。
假设月薪是12150、那预测他会不会同时申请房屋补贴。
逻辑回归用来预测0与1、是与否的模型。
*/

salary <- c(5500, 5800, 6400, 6700, 7100, 7500, 8800, 9500, 11000, 11500, 12000, 12500, 13100, 13800, 13900, 15000)
# salary <- rnorm(16, 10000, 8000)
claimNum <- c(0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 1, 1, 1, 1)

cat("\n")
cat("===============Result===============","\n")
result <- data.frame(claimNum, salary)
result

# Draw
plot(salary, claimNum, main="Salary & claimNum", xlab="Salary", ylab="claimNum", col = "red")

cat("\n")
cat("===============Model===============","\n")
model <- glm(formula= claimNum ~ salary, data=result, family=binomial)
model

cat("\n")
cat("===============Summary Model===============","\n")
summary(model)

# Draw
curve(predict(model, data.frame(salary = x), type="resp"), add=TRUE)
points(salary, fitted(model), pch=20, col = "blue")


cat("\n")
cat("===============Predict===============","\n")
newdata = data.frame(salary = 12150)
predict(model, newdata, type="response")

 

===============Result=============== 
   claimNum salary
1         0   5500
2         0   5800
3         0   6400
4         0   6700
5         0   7100
6         1   7500
7         0   8800
8         1   9500
9         0  11000
10        1  11500
11        0  12000
12        0  12500
13        1  13100
14        1  13800
15        1  13900
16        1  15000

===============Model=============== 

Call:  glm(formula = claimNum ~ salary, family = binomial, data = result)

Coefficients:
(Intercept)       salary  
 -5.0425584    0.0004657  

Degrees of Freedom: 15 Total (i.e. Null);  14 Residual
Null Deviance:	    21.93 
Residual Deviance: 16.05 	AIC: 20.05

===============Summary Model=============== 

Call:
glm(formula = claimNum ~ salary, family = binomial, data = result)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-1.5208  -0.6299  -0.4147   0.6946   1.8668  

Coefficients:
              Estimate Std. Error z value Pr(>|z|)  
(Intercept) -5.0425584  2.4936676  -2.022   0.0432 *
salary       0.0004657  0.0002285   2.038   0.0415 *
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 21.930  on 15  degrees of freedom
Residual deviance: 16.046  on 14  degrees of freedom
AIC: 20.046

Number of Fisher Scoring iterations: 4


===============Predict=============== 
        1 
0.6492079 

 

下載.png

全站熱搜
創作者介紹
創作者 kk匡 的頭像
kk匡

kk匡的日記&學習筆記

kk匡 發表在 痞客邦 留言(0) 人氣()