R, Python 분석과 프로그래밍의 친구 (by R Friend)

#----------------

# histogram with variable size of bin width and different colors per bins using ggplot2

#----------------

# sample data frame

mydf <- data.frame(var = c(1100, 10000, 100000, 190000, 110000, 220000, 550000, 701000, 790000))

# numeric notation for large numbers

options(scipen = 30)

library("ggplot2")

# fill color with different colors per bins

mydf$group <- ifelse(mydf$var < 10000, 1, 

                          ifelse(mydf$var < 100000, 2, 

                                 ifelse(mydf$var < 200000, 3, 

                                        ifelse(mydf$var < 500000, 4, 5))))

# breaks of bin

bins <- c(1000, 10000, 100000, 200000, 500000, 800000)

# draw histogram with variable size of bin width and different colors per bins

ggplot(mydf, aes(x= var)) +

  geom_histogram(data=subset(mydf, group==1), breaks = c(1000, 10000), fill="black") +

  geom_histogram(data=subset(mydf, group==2), breaks = c(10000, 100000), fill="yellow") +

  geom_histogram(data=subset(mydf, group==3), breaks = c(100000, 200000), fill="green") +

  geom_histogram(data=subset(mydf, group==4), breaks = c(200000, 500000), fill="blue") +

  geom_histogram(data=subset(mydf, group==5), breaks = c(500000, 800000), fill="red") +

  scale_x_continuous(breaks = bins, limits = c(1000, 800000)) +

  xlab("variable 1") + 

  ylab("count") +

  ggtitle("Histogram with different size of bin width and colors") + 

  theme(plot.title = element_text(hjust = 0.5, size = 14))

[로지스틱 회귀분석을 통한 유방암 예측(분류) 포스팅 순서]

1. WDBC(Wisconsin Diagnostic Breast Cancer) dataset 소개 및 분석 목적과 방향 설정
2. 탐색적 데이터 분석 및 전처리
3. 1차 변수 선택 및 목표변수와 설명변수 간 관계 분석
4. 로지스틱 회귀모형 적합 및 모델 평가, 해석

  (1) training set (80%) vs. test set (20%) 분리

> ##=========================

> ## fitting logistic regression

> #----------

> 

> # data set with 12 input variable and Y variable

> wdbc_12 <- data.frame(Y, wdbc[,x_names_sorted])

> str(wdbc_12)

'data.frame': 569 obs. of  13 variables:

 $ Y                      : num  1 1 1 1 1 1 1 1 1 1 ...

 $ concavity_se           : num  0.0537 0.0186 0.0383 0.0566 0.0569 ...

 $ compactness_se         : num  0.049 0.0131 0.0401 0.0746 0.0246 ...

 $ fractal_dimension_worst: num  0.1189 0.089 0.0876 0.173 0.0768 ...

 $ symmetry_mean          : num  0.242 0.181 0.207 0.26 0.181 ...

 $ smoothness_mean        : num  0.1184 0.0847 0.1096 0.1425 0.1003 ...

 $ concave.points_se      : num  0.0159 0.0134 0.0206 0.0187 0.0188 ...

 $ texture_mean           : num  10.4 17.8 21.2 20.4 14.3 ...

 $ symmetry_worst         : num  0.46 0.275 0.361 0.664 0.236 ...

 $ smoothness_worst       : num  0.162 0.124 0.144 0.21 0.137 ...

 $ perimeter_se           : num  8.59 3.4 4.58 3.44 5.44 ...

 $ area_worst             : num  2019 1956 1709 568 1575 ...

 $ concave.points_mean    : num  0.1471 0.0702 0.1279 0.1052 0.1043 ...

> 

> # split train(0.8) and test set(0.2)

> set.seed(123) # for reproducibility

> train <- sample(1:nrow(wdbc_12), size=0.8*nrow(wdbc_12), replace=F)

> test <- (-train)

> Y.test <- Y[test]

  (2) 로지스틱 회귀모형 적합 (w/ training set)

[ Family Objects for Models ]

binomial(link = "logit")  # logistic regression model

poisson(link = "log") # poisson regression model

gaussian(link = "identity") # linear regression model

Gamma(link = "inverse") # gamma regression model

inverse.gaussian(link = "1/mu^2")

quasi(link = "identity", variance = "constant")

quasibinomial(link = "logit")

quasipoisson(link = "log") 

> # train with training set

> glm.fit <- glm(Y ~ ., 

+                data = wdbc_12, 

+                family = binomial(link = "logit"), 

+                subset = train)

Warning message:

glm.fit: 적합된 확률값들이 0 또는 1 입니다 

> 

> summary(glm.fit)

Call:

glm(formula = Y ~ ., family = binomial(link = "logit"), data = wdbc_12, 

    subset = train)

Deviance Residuals: 

    Min       1Q   Median       3Q      Max  

-1.8232  -0.0662  -0.0074   0.0001   3.8847  

Coefficients:

                           Estimate  Std. Error z value Pr(>|z|)    

(Intercept)              -36.903201    9.099492  -4.056  0.00005 ***

concavity_se              29.311264   22.989079   1.275 0.202306    

compactness_se          -100.786803   36.755041  -2.742 0.006104 ** 

fractal_dimension_worst   37.094117   43.007209   0.863 0.388407    

symmetry_mean             19.015372   30.163882   0.630 0.528432    

smoothness_mean         -109.619744   74.382548  -1.474 0.140554    

concave.points_se       -123.097155  203.980072  -0.603 0.546192    

texture_mean               0.393147    0.107909   3.643 0.000269 ***

symmetry_worst            13.278414   10.461508   1.269 0.204347    

smoothness_worst         105.722805   35.197258   3.004 0.002667 ** 

perimeter_se               1.033524    0.780904   1.323 0.185670    

area_worst                 0.013239    0.003786   3.496 0.000472 ***

concave.points_mean      104.113327   46.738810   2.228 0.025910 *  

---

Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 601.380  on 454  degrees of freedom

Residual deviance:  60.175  on 442  degrees of freedom

AIC: 86.175

Number of Fisher Scoring iterations: 10

Wald Test

• 통계량  
• 귀무가설(): 회귀계수 
• 대립가설(): 회귀계수 

  (3) 후진 소거법 (backward elimination)

> # Backward Elimination Approach

> # remove 'concave.points_se' variable

> glm.fit.2 <- glm(Y ~ concave.points_mean + area_worst + 

+                    perimeter_se + smoothness_worst + symmetry_worst +

+                    texture_mean + smoothness_mean + symmetry_mean + 

+                    fractal_dimension_worst + compactness_se + concavity_se, 

+                  data = wdbc_12, 

+                  family = binomial(link = "logit"), 

+                  subset = train)

Warning message:

glm.fit: 적합된 확률값들이 0 또는 1 입니다 

> 

> summary(glm.fit.2)

Call:

glm(formula = Y ~ concave.points_mean + area_worst + perimeter_se + 

    smoothness_worst + symmetry_worst + texture_mean + smoothness_mean + 

    symmetry_mean + fractal_dimension_worst + compactness_se + 

    concavity_se, family = binomial(link = "logit"), data = wdbc_12, 

    subset = train)

Deviance Residuals: 

    Min       1Q   Median       3Q      Max  

-1.8363  -0.0645  -0.0076   0.0001   3.8297  

Coefficients:

                           Estimate  Std. Error z value  Pr(>|z|)    

(Intercept)              -37.182194    8.981711  -4.140 0.0000348 ***

concave.points_mean       87.773808   37.117336   2.365  0.018041 *  

area_worst                 0.013785    0.003734   3.692  0.000222 ***

perimeter_se               0.894502    0.747623   1.196  0.231517    

smoothness_worst         104.169968   35.281001   2.953  0.003151 ** 

symmetry_worst            15.057387   10.048439   1.498  0.134009    

texture_mean               0.385946    0.105254   3.667  0.000246 ***

smoothness_mean         -103.800173   73.953483  -1.404  0.160442    

symmetry_mean             10.952803   26.586484   0.412  0.680362    

fractal_dimension_worst   42.376803   42.322307   1.001  0.316688    

compactness_se           -98.379602   35.688499  -2.757  0.005840 ** 

concavity_se              18.847381   13.973683   1.349  0.177409    

---

Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 601.380  on 454  degrees of freedom

Residual deviance:  60.551  on 443  degrees of freedom

AIC: 84.551

Number of Fisher Scoring iterations: 10

> 

> # remove 'symmetry_mean' variable

> glm.fit.3 <- glm(Y ~ concave.points_mean + area_worst + 

+                    perimeter_se + smoothness_worst + symmetry_worst +

+                    texture_mean + smoothness_mean + 

+                    fractal_dimension_worst + compactness_se + concavity_se, 

+                  data = wdbc_12, 

+                  family = binomial(link = "logit"), 

+                  subset = train)

Warning message:

glm.fit: 적합된 확률값들이 0 또는 1 입니다 

> 

> summary(glm.fit.3)

Call:

glm(formula = Y ~ concave.points_mean + area_worst + perimeter_se + 

    smoothness_worst + symmetry_worst + texture_mean + smoothness_mean + 

    fractal_dimension_worst + compactness_se + concavity_se, 

    family = binomial(link = "logit"), data = wdbc_12, subset = train)

Deviance Residuals: 

    Min       1Q   Median       3Q      Max  

-1.7842  -0.0630  -0.0083   0.0001   3.7588  

Coefficients:

                          Estimate Std. Error z value  Pr(>|z|)    

(Intercept)             -36.121685   8.504448  -4.247 0.0000216 ***

concave.points_mean      89.488263  37.243081   2.403  0.016269 *  

area_worst                0.013329   0.003532   3.774  0.000161 ***

perimeter_se              0.976273   0.722740   1.351  0.176762    

smoothness_worst        100.865240  33.783402   2.986  0.002830 ** 

symmetry_worst           17.885605   7.503047   2.384  0.017136 *  

texture_mean              0.382870   0.103885   3.686  0.000228 ***

smoothness_mean         -95.335007  70.234774  -1.357  0.174662    

fractal_dimension_worst  40.176580  41.722080   0.963  0.335569    

compactness_se          -97.950160  35.684347  -2.745  0.006053 ** 

concavity_se             19.800333  13.655596   1.450  0.147064    

---

Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 601.380  on 454  degrees of freedom

Residual deviance:  60.721  on 444  degrees of freedom

AIC: 82.721

Number of Fisher Scoring iterations: 10

> 

> # remove 'fractal_dimension_worst' variable

> glm.fit.4 <- glm(Y ~ concave.points_mean + area_worst + 

+                    perimeter_se + smoothness_worst + symmetry_worst +

+                    texture_mean + smoothness_mean + 

+                    compactness_se + concavity_se, 

+                  data = wdbc_12, 

+                  family = binomial(link = "logit"), 

+                  subset = train)

Warning message:

glm.fit: 적합된 확률값들이 0 또는 1 입니다 

> 

> summary(glm.fit.4)

Call:

glm(formula = Y ~ concave.points_mean + area_worst + perimeter_se + 

    smoothness_worst + symmetry_worst + texture_mean + smoothness_mean + 

    compactness_se + concavity_se, family = binomial(link = "logit"), 

    data = wdbc_12, subset = train)

Deviance Residuals: 

    Min       1Q   Median       3Q      Max  

-1.6650  -0.0653  -0.0079   0.0001   3.9170  

Coefficients:

                       Estimate  Std. Error z value  Pr(>|z|)    

(Intercept)          -33.656002    7.809704  -4.310 0.0000164 ***

concave.points_mean   96.137001   36.867939   2.608  0.009118 ** 

area_worst             0.012905    0.003435   3.757  0.000172 ***

perimeter_se           0.676729    0.642490   1.053  0.292208    

smoothness_worst     109.530724   32.239695   3.397  0.000680 ***

symmetry_worst        19.724732    7.543696   2.615  0.008930 ** 

texture_mean           0.381544    0.103567   3.684  0.000230 ***

smoothness_mean     -101.037553   70.839248  -1.426  0.153784    

compactness_se       -80.383972   30.461425  -2.639  0.008318 ** 

concavity_se          20.771502   14.372162   1.445  0.148385    

---

Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 601.380  on 454  degrees of freedom

Residual deviance:  61.657  on 445  degrees of freedom

AIC: 81.657

Number of Fisher Scoring iterations: 10

> 

> # remove 'perimeter_se' variable

> glm.fit.5 <- glm(Y ~ concave.points_mean + area_worst + smoothness_worst + 

+                    symmetry_worst + texture_mean + smoothness_mean + 

+                    compactness_se + concavity_se, 

+                  data = wdbc_12, 

+                  family = binomial(link = "logit"), 

+                  subset = train)

Warning message:

glm.fit: 적합된 확률값들이 0 또는 1 입니다 

> 

> summary(glm.fit.5)

Call:

glm(formula = Y ~ concave.points_mean + area_worst + smoothness_worst + 

    symmetry_worst + texture_mean + smoothness_mean + compactness_se + 

    concavity_se, family = binomial(link = "logit"), data = wdbc_12, 

    subset = train)

Deviance Residuals: 

    Min       1Q   Median       3Q      Max  

-1.7487  -0.0602  -0.0079   0.0002   4.2383  

Coefficients:

                      Estimate Std. Error z value  Pr(>|z|)    

(Intercept)         -33.156014   7.674110  -4.321 0.0000156 ***

concave.points_mean  98.900172  35.529247   2.784   0.00538 ** 

area_worst            0.013819   0.003339   4.139 0.0000349 ***

smoothness_worst    105.448378  32.444984   3.250   0.00115 ** 

symmetry_worst       17.412883   6.654537   2.617   0.00888 ** 

texture_mean          0.385751   0.102180   3.775   0.00016 ***

smoothness_mean     -89.410469  70.307291  -1.272   0.20348    

compactness_se      -78.009472  29.946520  -2.605   0.00919 ** 

concavity_se         24.607453  13.153360   1.871   0.06137 .  

---

Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 601.380  on 454  degrees of freedom

Residual deviance:  62.777  on 446  degrees of freedom

AIC: 80.777

Number of Fisher Scoring iterations: 10

> 

> # remove 'smoothness_mean' variable

> glm.fit.6 <- glm(Y ~ concave.points_mean + area_worst + smoothness_worst + 

+                    symmetry_worst + texture_mean +  

+                    compactness_se + concavity_se, 

+                  data = wdbc_12, 

+                  family = binomial(link = "logit"), 

+                  subset = train)

Warning message:

glm.fit: 적합된 확률값들이 0 또는 1 입니다 

> 

> summary(glm.fit.6)

Call:

glm(formula = Y ~ concave.points_mean + area_worst + smoothness_worst + 

    symmetry_worst + texture_mean + compactness_se + concavity_se, 

    family = binomial(link = "logit"), data = wdbc_12, subset = train)

Deviance Residuals: 

    Min       1Q   Median       3Q      Max  

-1.8607  -0.0640  -0.0080   0.0002   4.0912  

Coefficients:

                      Estimate Std. Error z value     Pr(>|z|)    

(Intercept)         -39.164619   6.748646  -5.803 0.0000000065 ***

concave.points_mean  73.504634  27.154772   2.707     0.006792 ** 

area_worst            0.015465   0.003248   4.762 0.0000019175 ***

smoothness_worst     78.962941  23.746808   3.325     0.000884 ***

symmetry_worst       17.429475   6.497808   2.682     0.007310 ** 

texture_mean          0.423250   0.099815   4.240 0.0000223171 ***

compactness_se      -79.556564  29.747330  -2.674     0.007486 ** 

concavity_se         27.279384  12.093534   2.256     0.024089 *  

---

Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 601.380  on 454  degrees of freedom

Residual deviance:  64.446  on 447  degrees of freedom

AIC: 80.446

Number of Fisher Scoring iterations: 10

> # likelihood ratio test

> LR_statistic = 601.380 - 64.446

> LR_statistic

[1] 536.934

> pchisq(LR_statistic, df = (454-447), lower.tail = F)

[1] 9.140339e-112

> summary(glm.fit.6)

Call:

glm(formula = Y ~ concave.points_mean + area_worst + smoothness_worst + 

    symmetry_worst + texture_mean + compactness_se + concavity_se, 

    family = binomial(link = "logit"), data = wdbc_12, subset = train)

Deviance Residuals: 

    Min       1Q   Median       3Q      Max  

-1.8607  -0.0640  -0.0080   0.0002   4.0912  

Coefficients:

                      Estimate Std. Error z value     Pr(>|z|)    

(Intercept)         -39.164619   6.748646  -5.803 0.0000000065 ***

concave.points_mean  73.504634  27.154772   2.707     0.006792 ** 

area_worst            0.015465   0.003248   4.762 0.0000019175 ***

smoothness_worst     78.962941  23.746808   3.325     0.000884 ***

symmetry_worst       17.429475   6.497808   2.682     0.007310 ** 

texture_mean          0.423250   0.099815   4.240 0.0000223171 ***

compactness_se      -79.556564  29.747330  -2.674     0.007486 ** 

concavity_se         27.279384  12.093534   2.256     0.024089 *  

---

Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 601.380  on 454  degrees of freedom

Residual deviance:  64.446  on 447  degrees of freedom

AIC: 80.446

Number of Fisher Scoring iterations: 10

> confint(glm.fit.6)

Waiting for profiling to be done...

                            2.5 %       97.5 %

(Intercept)         -5.483332e+01 -27.92705624

concave.points_mean  2.353047e+01 131.95158315

area_worst           9.906713e-03   0.02282079

smoothness_worst     3.617243e+01 131.06234268

symmetry_worst       6.422548e+00  32.73189772

texture_mean         2.428527e-01   0.64064918

compactness_se      -1.411215e+02 -15.15533223

concavity_se        -1.259598e+01  49.25042906

  (4) 모델 성능 평가 (w/ test set) : confusion matrix, ROC curve

> # calculate the probabilities on test set

> glm.probs <- predict(glm.fit.6, wdbc_12[test,], type="response")

> glm.probs[1:20]

                6                 8                10                11                12 

0.986917125953939 0.992018931502162 0.998996856414432 0.992792364235021 0.999799557490392 

               13                25                35                39                54 

0.999938548975209 1.000000000000000 0.999981682993826 0.003031968742568 0.999978684326258 

               61                67                72                77                86 

0.000024521469882 0.000434266606978 0.000000006158534 0.002210951131364 0.999999952448192 

               92                98               106               108               115 

0.923496652258054 0.000007994931448 0.998688178459914 0.000576845750543 0.000149114805822 

> 

> # compute the predictions with the threshold of 0.5

> glm.pred <- rep(0, nrow(wdbc_12[test,]))

> glm.pred[glm.probs > .5] = 1

> table(Y.test, glm.pred)

      glm.pred

Y.test  0  1

     0 72  0

     1  1 41

> 

> mean(Y.test == glm.pred) # accuracy

[1] 0.9912281

> mean(Y.test != glm.pred) # test error rate

[1] 0.00877193

> # ROC curve

> install.packages("ROCR")

> library(ROCR)

> pr <- prediction(glm.probs, Y.test)

> prf <- performance(pr, measure = "tpr", x.measure = "fpr")

> plot(prf, main="ROC Curve")

> 

> # AUC (The Area Under an ROC Curve)

> auc <- performance(pr, measure = "auc")

> auc <- auc@y.values[[1]]

> auc

[1] 0.9933862

> 

> detach(wdbc)

  (5) 모델 해석

[로지스틱 회귀분석을 통한 유방암 예측(분류) 포스팅 순서]

1. WDBC(Wisconsin Diagnostic Breast Cancer) dataset 소개 및 분석 목적과 방향 설정
2. 탐색적 데이터 분석 및 전처리
3. 1차 변수 선택 및 목표변수와 설명변수 간 관계 분석
4. 로지스틱 회귀모형 적합 및 모델 평가, 해석

  (1) t-test 를 통한 1차 변수 선별

> # Variable selection (1st round)

> # Multiple t-tests of explanatory variables between diagnosis

> X_names <- names(data.frame(X_3))

> X_names

 [1] "texture_mean"            "smoothness_mean"         "concave.points_mean"    

 [4] "symmetry_mean"           "fractal_dimension_mean"  "texture_se"             

 [7] "perimeter_se"            "smoothness_se"           "compactness_se"         

[10] "concavity_se"            "concave.points_se"       "symmetry_se"            

[13] "fractal_dimension_se"    "area_worst"              "smoothness_worst"       

[16] "symmetry_worst"          "fractal_dimension_worst"

> 

> t.test_p.value_df <- data.frame() # blank data.frame for saving

> 

> for (i in 1:length(X_names)) {

+   t.test_p.value <- t.test(wdbc[,X_names[i]] ~ wdbc$diagnosis, var.equal = TRUE)$p.value

+   

+   t.test_p.value_df[i,1] <- X_names[i]

+   t.test_p.value_df[i,2] <- t.test_p.value

+ }

> 

> colnames(t.test_p.value_df) <- c("x_var_name", "p.value")

> t.test_p.value_df

                x_var_name       p.value

1             texture_mean  4.058636e-25

2          smoothness_mean  1.051850e-18

3      concave.points_mean 7.101150e-116

4            symmetry_mean  5.733384e-16

5   fractal_dimension_mean  7.599368e-01

6               texture_se  8.433320e-01

7             perimeter_se  1.651905e-47

8            smoothness_se  1.102966e-01

9           compactness_se  9.975995e-13

10            concavity_se  8.260176e-10

11       concave.points_se  3.072309e-24

12             symmetry_se  8.766418e-01

13    fractal_dimension_se  6.307355e-02

14              area_worst  2.828848e-97

15        smoothness_worst  6.575144e-26

16          symmetry_worst  2.951121e-25

17 fractal_dimension_worst  2.316432e-15

> # sorting by p.value in ascending order

> install.packages("dplyr")

> library(dplyr)

> arrange(t.test_p.value_df, p.value)

                x_var_name       p.value

1      concave.points_mean 7.101150e-116

2               area_worst  2.828848e-97

3             perimeter_se  1.651905e-47

4         smoothness_worst  6.575144e-26

5           symmetry_worst  2.951121e-25

6             texture_mean  4.058636e-25

7        concave.points_se  3.072309e-24

8          smoothness_mean  1.051850e-18

9            symmetry_mean  5.733384e-16

10 fractal_dimension_worst  2.316432e-15

11          compactness_se  9.975995e-13

12            concavity_se  8.260176e-10

13    fractal_dimension_se  6.307355e-02

14           smoothness_se  1.102966e-01

15  fractal_dimension_mean  7.599368e-01

16              texture_se  8.433320e-01

17             symmetry_se  8.766418e-01

> # select x_variables only if p.value < 0.05

> t.test_filtered <- t.test_p.value_df$p.value < 0.05

> X_names_filtered <- X_names[t.test_filtered]

> 

> X_4 <- data.frame(X_3[, X_names_filtered])

> str(X_4)

'data.frame': 569 obs. of  12 variables:

 $ texture_mean           : num  -2.072 -0.353 0.456 0.254 -1.151 ...

 $ smoothness_mean        : num  1.567 -0.826 0.941 3.281 0.28 ...

 $ concave.points_mean    : num  2.53 0.548 2.035 1.45 1.427 ...

 $ symmetry_mean          : num  2.21557 0.00139 0.93886 2.86486 -0.00955 ...

 $ perimeter_se           : num  2.831 0.263 0.85 0.286 1.272 ...

 $ compactness_se         : num  1.3157 -0.6923 0.8143 2.7419 -0.0485 ...

 $ concavity_se           : num  0.723 -0.44 0.213 0.819 0.828 ...

 $ concave.points_se      : num  0.66 0.26 1.42 1.11 1.14 ...

 $ area_worst             : num  2 1.89 1.46 -0.55 1.22 ...

 $ smoothness_worst       : num  1.307 -0.375 0.527 3.391 0.22 ...

 $ symmetry_worst         : num  2.748 -0.244 1.151 6.041 -0.868 ...

 $ fractal_dimension_worst: num  1.935 0.281 0.201 4.931 -0.397 ...

  (2) 목표변수와 설명변수 간 관계 분석 (시각화)

> # sorting by p.value in descending order

> # t.test_p.value_df.sorted <- arrange(t.test_p.value_df[t.test_filtered,], p.value)

> # t.test_p.value_df.sorted

> 

> t.test_p.value_df.sorted_2 <- arrange(t.test_p.value_df[t.test_filtered,], desc(p.value))

> t.test_p.value_df.sorted_2

                x_var_name       p.value

1             concavity_se  8.260176e-10

2           compactness_se  9.975995e-13

3  fractal_dimension_worst  2.316432e-15

4            symmetry_mean  5.733384e-16

5          smoothness_mean  1.051850e-18

6        concave.points_se  3.072309e-24

7             texture_mean  4.058636e-25

8           symmetry_worst  2.951121e-25

9         smoothness_worst  6.575144e-26

10            perimeter_se  1.651905e-47

11              area_worst  2.828848e-97

12     concave.points_mean 7.101150e-116

> x_names_sorted <- t.test_p.value_df.sorted_2$x_var_name

> x_names_sorted

 [1] "concavity_se"            "compactness_se"          "fractal_dimension_worst"

 [4] "symmetry_mean"           "smoothness_mean"         "concave.points_se"      

 [7] "texture_mean"            "symmetry_worst"          "smoothness_worst"       

[10] "perimeter_se"            "area_worst"              "concave.points_mean"    

> 

> X_5 <- X_4[x_names_sorted] # rearrange column order for plotting below 

> head(X_5,2)

  concavity_se compactness_se fractal_dimension_worst symmetry_mean smoothness_mean

1    0.7233897      1.3157039               1.9353117   2.215565542       1.5670875

2   -0.4403926     -0.6923171               0.2809428   0.001391139      -0.8262354

  concave.points_se texture_mean symmetry_worst smoothness_worst perimeter_se area_worst

1         0.6602390   -2.0715123      2.7482041        1.3065367    2.8305403   1.999478

2         0.2599334   -0.3533215     -0.2436753       -0.3752817    0.2630955   1.888827

  concave.points_mean

1           2.5302489

2           0.5476623

> 

> 

> #-----

> # combine Y and X

> wdbc_2 <- data.frame(Y, X_5)

> str(wdbc_2)

'data.frame': 569 obs. of  13 variables:

 $ Y                      : num  1 1 1 1 1 1 1 1 1 1 ...

 $ concavity_se           : num  0.723 -0.44 0.213 0.819 0.828 ...

 $ compactness_se         : num  1.3157 -0.6923 0.8143 2.7419 -0.0485 ...

 $ fractal_dimension_worst: num  1.935 0.281 0.201 4.931 -0.397 ...

 $ symmetry_mean          : num  2.21557 0.00139 0.93886 2.86486 -0.00955 ...

 $ smoothness_mean        : num  1.567 -0.826 0.941 3.281 0.28 ...

 $ concave.points_se      : num  0.66 0.26 1.42 1.11 1.14 ...

 $ texture_mean           : num  -2.072 -0.353 0.456 0.254 -1.151 ...

 $ symmetry_worst         : num  2.748 -0.244 1.151 6.041 -0.868 ...

 $ smoothness_worst       : num  1.307 -0.375 0.527 3.391 0.22 ...

 $ perimeter_se           : num  2.831 0.263 0.85 0.286 1.272 ...

 $ area_worst             : num  2 1.89 1.46 -0.55 1.22 ...

 $ concave.points_mean    : num  2.53 0.548 2.035 1.45 1.427 ...

> #-----

> # Box plot of X per Y(M, B)

> install.packages("reshape2")

> library(reshape2)

> wdbc_2_melt <- melt(wdbc_2, id.var = "Y")

> 

> install.packages("ggplot2")

> library(ggplot2)

> ggplot(data = wdbc_2_melt[wdbc_2_melt$value < 3,], aes(x=variable, y=value)) + 

+   geom_boxplot(aes(fill=as.factor(Y))) +

+   theme_bw() + # white background

+   coord_flip() # flip the x & y-axis

> # scatter plot of x=concave.points_mean, y=area_worst

> ggplot(data=wdbc_2, aes(x=concave.points_mean, y=area_worst, colour=as.factor(Y), alpha=0.5)) +

+   geom_point(shape=19, size=3) +

+   ggtitle("Scatter Plot of concave.points_mean & area_worst by Y")

> 

> ggplot(data=wdbc_2, aes(x=area_worst, y=texture_mean, colour=as.factor(Y), alpha=0.5)) +

+   geom_point(shape=19, size=3) +

+   ggtitle("Scatter Plot of area_worst & texture_mean by Y")

[로지스틱 회귀분석을 통한 유방암 예측(분류) 포스팅 순서]

1. WDBC(Wisconsin Diagnostic Breast Cancer) dataset 소개 및 분석 목적과 방향 설정
2. 탐색적 데이터 분석 및 전처리
3. 1차 변수 선택 및 목표변수와 설명변수 간 관계 분석
4. 로지스틱 회귀모형 적합 및 모델 평가, 해석

rm(list=ls())

options(scipen=30)

# data loading: WDBC (Wisconsin Diagnostic Breast Cancer)

library(data.table)

library(curl)

url <- c("https://archive.ics.uci.edu/ml/machine-learning-databases/breast-cancer-wisconsin/wdbc.data")

wdbc <- data.frame(fread(url))

str(wdbc)

# column names

colnames(wdbc) <- c("id", "diagnosis", "radius_mean", "texture_mean", 

                    "perimeter_mean", "area_mean", "smoothness_mean", "compactness_mean",

                    "concavity_mean", "concave.points_mean", "symmetry_mean", "fractal_dimension_mean", 

                    "radius_se", "texture_se", "perimeter_se", "area_se", 

                    "smoothness_se", "compactness_se", "concavity_se", "concave.points_se", 

                    "symmetry_se", "fractal_dimension_se", "radius_worst", "texture_worst", 

                    "perimeter_worst", "area_worst", "smoothness_worst", "compactness_worst", 

                    "concavity_worst", "concave.points_worst", "symmetry_worst", "fractal_dimension_worst")

str(wdbc)

head(wdbc, 2)

 (1) 결측값 (Missing Value) 확인 및 처리

> attach(wdbc)

The following objects are masked from wdbc (pos = 3):

    area_mean, area_se, area_worst, compactness_mean, compactness_se, compactness_worst,

    concave.points_mean, concave.points_se, concave.points_worst, concavity_mean,

    concavity_se, concavity_worst, diagnosis, fractal_dimension_mean,

    fractal_dimension_se, fractal_dimension_worst, id, perimeter_mean, perimeter_se,

    perimeter_worst, radius_mean, radius_se, radius_worst, smoothness_mean,

    smoothness_se, smoothness_worst, symmetry_mean, symmetry_se, symmetry_worst,

    texture_mean, texture_se, texture_worst

> 

> # check missing value

> colSums(is.na(wdbc)) # no missing value, good

                     id               diagnosis             radius_mean            texture_mean 

                      0                       0                       0                       0 

         perimeter_mean               area_mean         smoothness_mean        compactness_mean 

                      0                       0                       0                       0 

         concavity_mean     concave.points_mean           symmetry_mean  fractal_dimension_mean 

                      0                       0                       0                       0 

              radius_se              texture_se            perimeter_se                 area_se 

                      0                       0                       0                       0 

          smoothness_se          compactness_se            concavity_se       concave.points_se 

                      0                       0                       0                       0 

            symmetry_se    fractal_dimension_se            radius_worst           texture_worst 

                      0                       0                       0                       0 

        perimeter_worst              area_worst        smoothness_worst       compactness_worst 

                      0                       0                       0                       0 

        concavity_worst    concave.points_worst          symmetry_worst fractal_dimension_worst 

                      0                       0                       0                       0

> sum(is.na(wdbc))

[1] 0

  (2) 중복 데이터 (Duplicated Data) 확인 및 처리

> # check duplicated data

> sum(duplicated(wdbc)) # no duplicated data, good~!

[1] 0

  (3) 목표변수 범주/계급 구성 분포(class distribution) 확인 및 처리

> # check Y: diagnosis

> # The diagnosis of breast tissues (M = malignant, B = benign)

> table(diagnosis); cat("total :", margin.table(table(diagnosis)))

diagnosis

  B   M 

357 212 

total : 569

> prop.table(table(diagnosis)) # Benign 62.7% vs. Malignant 37.2%

diagnosis

        B         M 

0.6274165 0.3725835

  (4) 설명변수 간 다중공선성(Multicollinearity) 확인 및 처리

> # split Y, X

> Y <- ifelse(wdbc$diagnosis == 'M', 1, 0)

> X <- wdbc[,c(3:32)]

> names(X)

 [1] "radius_mean"             "texture_mean"            "perimeter_mean"         

 [4] "area_mean"               "smoothness_mean"         "compactness_mean"       

 [7] "concavity_mean"          "concave.points_mean"     "symmetry_mean"          

[10] "fractal_dimension_mean"  "radius_se"               "texture_se"             

[13] "perimeter_se"            "area_se"                 "smoothness_se"          

[16] "compactness_se"          "concavity_se"            "concave.points_se"      

[19] "symmetry_se"             "fractal_dimension_se"    "radius_worst"           

[22] "texture_worst"           "perimeter_worst"         "area_worst"             

[25] "smoothness_worst"        "compactness_worst"       "concavity_worst"        

[28] "concave.points_worst"    "symmetry_worst"          "fractal_dimension_worst"

> # distribution and correlation check among input variables of WDBC

> install.packages("PerformanceAnalytics")

> library(PerformanceAnalytics)

> chart.Correlation(X[,c(1:10)], histogram=TRUE, col="grey10", pch=1) # MEAN

> chart.Correlation(X[,c(11:20)], histogram=TRUE, col="grey10", pch=1) # SE

> chart.Correlation(X[,c(21:30)], histogram=TRUE, col="grey10", pch=1) # WORST

> # heatmap plot of correlation coefficients of WDBC

> install.packages("GGally")

> library(GGally)

> ggcorr(X, name="corr", label=T)

> # multicolleniarity check

> install.packages("fmsb")

> library(fmsb)

> VIF(lm(radius_mean ~ .,data=X))

[1] 3806.115

> VIF(lm(texture_mean ~ .,data=X))

[1] 11.88405

# Multi-collinearity check and remove the highly correlated variables step by step

# UDF of stepwise VIF function with preallocated vectors

# code source: https://beckmw.wordpress.com/2013/02/05/collinearity-and-stepwise-vif-selection/

vif_func <- function(in_frame,thresh=10, trace=F,...){

  require(fmsb)

  if(class(in_frame) != 'data.frame') in_frame<-data.frame(in_frame)

  #get initial vif value for all comparisons of variables

  vif_init <- vector('list', length = ncol(in_frame))

  names(vif_init) <- names(in_frame)

  var_names <- names(in_frame)

  for(val in var_names){

    regressors <- var_names[-which(var_names == val)]

    form <- paste(regressors, collapse = '+')

    form_in <- formula(paste(val,' ~ .'))

    vif_init[[val]] <- VIF(lm(form_in,data=in_frame,...))

  }

  vif_max<-max(unlist(vif_init))

  if(vif_max < thresh){

    if(trace==T){ #print output of each iteration

      prmatrix(vif_init,collab=c('var','vif'),rowlab=rep('', times = nrow(vif_init) ),quote=F)

      cat('\n')

      cat(paste('All variables have VIF < ', thresh,', max VIF ',round(vif_max,2), sep=''),'\n\n')

    }

    return(names(in_frame))

  }

  else{

    in_dat<-in_frame

    #backwards selection of explanatory variables, stops when all VIF values are below 'thresh'

    while(vif_max >= thresh){

      vif_vals <- vector('list', length = ncol(in_dat))

      names(vif_vals) <- names(in_dat)

      var_names <- names(in_dat)

      for(val in var_names){

        regressors <- var_names[-which(var_names == val)]

        form <- paste(regressors, collapse = '+')

        form_in <- formula(paste(val,' ~ .'))

        vif_add <- VIF(lm(form_in,data=in_dat,...))

        vif_vals[[val]] <- vif_add

      }

      max_row <- which.max(vif_vals)

      #max_row <- which( as.vector(vif_vals) == max(as.vector(vif_vals)) )

      vif_max<-vif_vals[max_row]

      if(vif_max<thresh) break

      if(trace==T){ #print output of each iteration

        vif_vals <- do.call('rbind', vif_vals)

        vif_vals

        prmatrix(vif_vals,collab='vif',rowlab=row.names(vif_vals),quote=F)

        cat('\n')

        cat('removed: ', names(vif_max),unlist(vif_max),'\n\n')

        flush.console()

      }

      in_dat<-in_dat[,!names(in_dat) %in% names(vif_max)]

    }

    return(names(in_dat))

  }

}

# Remove multicollinarity recursively using Python

from statsmodels.stats.outliers_influence import variance_inflation_factor

def X_filter_multicollinearity(X, thresh=5.0):

    from datetime import datetime

    start_tm = datetime.now()

    variables = list(range(X.shape[1]))

    dropped = True

    while dropped:

        dropped = False

        vif = [variance_inflation_factor(X.iloc[:, variables].values, ix) 

               for ix in range(X.iloc[:, variables].shape[1])]

        maxloc = vif.index(max(vif))

        if max(vif) > thresh:

            print('==> [Dropped variable] : ' + X.iloc[:, variables].columns[maxloc])

            del variables[maxloc]

            if len(variables) > 1:

                dropped = True

    print('[Remaining variables] :')

    print(X.columns[variables])

    print('[Elapsed time] :', str(datetime.now() - start_tm))

    return variables

# run the UDF

X_remained_idx = X_filter_multicollinearity(X)

print('X index after filtering multicollinearity:', X_remained_idx)

> # run vif_function

> X_independent <- vif_func(X, thresh=10, trace=T)

                                vif

radius_mean             3806.115296

texture_mean              11.884048

perimeter_mean          3786.400419

area_mean                347.878657

smoothness_mean            8.194282

compactness_mean          50.505168

concavity_mean            70.767720

concave.points_mean       60.041733

symmetry_mean              4.220656

fractal_dimension_mean    15.756977

radius_se                 75.462027

texture_se                 4.205423

perimeter_se              70.359695

area_se                   41.163091

smoothness_se              4.027923

compactness_se            15.366324

concavity_se              15.694833

concave.points_se         11.520796

symmetry_se                5.175426

fractal_dimension_se       9.717987

radius_worst             799.105946

texture_worst             18.569966

perimeter_worst          405.023336

area_worst               337.221924

smoothness_worst          10.923061

compactness_worst         36.982755

concavity_worst           31.970723

concave.points_worst      36.763714

symmetry_worst             9.520570

fractal_dimension_worst   18.861533

removed:  radius_mean 3806.115 

                               vif

texture_mean             11.882933

perimeter_mean          541.712931

area_mean               317.093211

smoothness_mean           7.990641

compactness_mean         38.106611

concavity_mean           65.978202

concave.points_mean      60.025840

symmetry_mean             4.203501

fractal_dimension_mean   15.677673

radius_se                75.101495

texture_se                4.185513

perimeter_se             67.720819

area_se                  41.089343

smoothness_se             4.017499

compactness_se           15.341790

concavity_se             15.234133

concave.points_se        11.399633

symmetry_se               5.175369

fractal_dimension_se      9.699518

radius_worst            616.350861

texture_worst            18.539292

perimeter_worst         375.408537

area_worst              304.471896

smoothness_worst         10.727206

compactness_worst        36.053404

concavity_worst          31.968539

concave.points_worst     36.763168

symmetry_worst            9.511243

fractal_dimension_worst  18.841897

removed:  radius_worst 616.3509 

                               vif

texture_mean             11.759131

perimeter_mean          325.641312

area_mean               237.012095

smoothness_mean           7.988003

compactness_mean         36.681620

concavity_mean           64.836935

concave.points_mean      60.019062

symmetry_mean             4.123603

fractal_dimension_mean   15.670406

radius_se                38.637579

texture_se                4.132025

perimeter_se             59.062677

area_se                  33.911923

smoothness_se             4.010296

compactness_se           15.304014

concavity_se             15.002055

concave.points_se        11.218541

symmetry_se               5.156085

fractal_dimension_se      9.542616

texture_worst            18.191599

perimeter_worst         308.052048

area_worst              168.343121

smoothness_worst         10.679641

compactness_worst        35.779767

concavity_worst          31.942417

concave.points_worst     35.761242

symmetry_worst            9.312564

fractal_dimension_worst  18.445566

removed:  perimeter_mean 325.6413 

                               vif

texture_mean             11.714252

area_mean                34.491349

smoothness_mean           7.964156

compactness_mean         31.979571

concavity_mean           64.655174

concave.points_mean      59.967015

symmetry_mean             4.123603

fractal_dimension_mean   14.921612

radius_se                36.056151

texture_se                4.092556

perimeter_se             42.980382

area_se                  32.570748

smoothness_se             3.914161

compactness_se           15.283194

concavity_se             14.769198

concave.points_se        10.464462

symmetry_se               5.128175

fractal_dimension_se      9.542575

texture_worst            18.112512

perimeter_worst         123.257811

area_worst               72.764912

smoothness_worst         10.648133

compactness_worst        34.263137

concavity_worst          31.681663

concave.points_worst     35.231031

symmetry_worst            9.268771

fractal_dimension_worst  18.287262

removed:  perimeter_worst 123.2578 

                              vif

texture_mean            11.679833

area_mean               28.534200

smoothness_mean          7.909212

compactness_mean        28.746302

concavity_mean          64.654796

concave.points_mean     59.816820

symmetry_mean            4.071436

fractal_dimension_mean  12.724264

radius_se               36.045576

texture_se               4.040107

perimeter_se            31.225949

area_se                 20.995394

smoothness_se            3.894739

compactness_se          15.199363

concavity_se            14.766025

concave.points_se       10.344938

symmetry_se              5.007681

fractal_dimension_se     9.302515

texture_worst           18.004692

area_worst              23.311066

smoothness_worst        10.619439

compactness_worst       34.253186

concavity_worst         31.669493

concave.points_worst    34.141124

symmetry_worst           9.077526

fractal_dimension_worst 18.285365

removed:  concavity_mean 64.6548 

                              vif

texture_mean            11.679763

area_mean               28.512892

smoothness_mean          7.543056

compactness_mean        26.110203

concave.points_mean     28.499831

symmetry_mean            4.064239

fractal_dimension_mean  12.668596

radius_se               35.617518

texture_se               4.034866

perimeter_se            31.178650

area_se                 19.985188

smoothness_se            3.872144

compactness_se          14.858964

concavity_se            11.587995

concave.points_se       10.013827

symmetry_se              5.005381

fractal_dimension_se     9.248401

texture_worst           18.003124

area_worst              23.026283

smoothness_worst        10.598388

compactness_worst       33.972256

concavity_worst         21.188494

concave.points_worst    32.115706

symmetry_worst           9.068073

fractal_dimension_worst 18.090939

removed:  radius_se 35.61752 

                              vif

texture_mean            11.465264

area_mean               25.427695

smoothness_mean          7.482881

compactness_mean        26.043226

concave.points_mean     27.801240

symmetry_mean            4.047744

fractal_dimension_mean  12.232750

texture_se               4.011486

perimeter_se            16.007813

area_se                 16.951023

smoothness_se            3.861783

compactness_se          14.577396

concavity_se            11.499061

concave.points_se        9.999462

symmetry_se              5.003384

fractal_dimension_se     8.800984

texture_worst           17.724662

area_worst              20.617761

smoothness_worst        10.595373

compactness_worst       33.960639

concavity_worst         21.056095

concave.points_worst    32.088040

symmetry_worst           9.065905

fractal_dimension_worst 18.084650

removed:  compactness_worst 33.96064 

                              vif

texture_mean            11.448852

area_mean               25.389376

smoothness_mean          7.479515

compactness_mean        19.208231

concave.points_mean     25.697888

symmetry_mean            3.982308

fractal_dimension_mean  10.961595

texture_se               3.998307

perimeter_se            15.960835

area_se                 16.935889

smoothness_se            3.859669

compactness_se           9.974677

concavity_se            10.850219

concave.points_se        9.805676

symmetry_se              4.941233

fractal_dimension_se     7.983689

texture_worst           17.701635

area_worst              20.613295

smoothness_worst        10.586935

concavity_worst         18.432076

concave.points_worst    30.596655

symmetry_worst           8.754474

fractal_dimension_worst 13.187594

removed:  concave.points_worst 30.59666 

                              vif

texture_mean            11.278555

area_mean               25.387830

smoothness_mean          7.162886

compactness_mean        19.175385

concave.points_mean     19.091402

symmetry_mean            3.918815

fractal_dimension_mean  10.902634

texture_se               3.937299

perimeter_se            15.808730

area_se                 16.917891

smoothness_se            3.637606

compactness_se           9.956527

concavity_se             9.775933

concave.points_se        5.347299

symmetry_se              4.900803

fractal_dimension_se     7.965699

texture_worst           17.427935

area_worst              20.406468

smoothness_worst         9.741783

concavity_worst         16.192763

symmetry_worst           8.435382

fractal_dimension_worst 13.047801

removed:  area_mean 25.38783 

                              vif

texture_mean            11.179202

smoothness_mean          7.162712

compactness_mean        18.843208

concave.points_mean     15.619381

symmetry_mean            3.895936

fractal_dimension_mean   9.707446

texture_se               3.937174

perimeter_se            15.619268

area_se                 16.655447

smoothness_se            3.632008

compactness_se           9.936443

concavity_se             9.705569

concave.points_se        5.250584

symmetry_se              4.872228

fractal_dimension_se     7.946733

texture_worst           17.236427

area_worst              10.626847

smoothness_worst         9.608528

concavity_worst         16.109962

symmetry_worst           8.409532

fractal_dimension_worst 13.023306

removed:  compactness_mean 18.84321 

                              vif

texture_mean            11.134313

smoothness_mean          6.970849

concave.points_mean     11.753066

symmetry_mean            3.829642

fractal_dimension_mean   7.907186

texture_se               3.890957

perimeter_se            15.333308

area_se                 16.345495

smoothness_se            3.552541

compactness_se           6.363339

concavity_se             9.367267

concave.points_se        5.245367

symmetry_se              4.871870

fractal_dimension_se     7.584276

texture_worst           17.232376

area_worst              10.602010

smoothness_worst         9.606389

concavity_worst         15.700019

symmetry_worst           8.401090

fractal_dimension_worst 13.023120

removed:  texture_worst 17.23238 

                              vif

texture_mean             1.715846

smoothness_mean          6.795612

concave.points_mean     11.715292

symmetry_mean            3.654734

fractal_dimension_mean   7.890069

texture_se               2.033874

perimeter_se            15.281161

area_se                 16.333806

smoothness_se            3.384881

compactness_se           6.337432

concavity_se             9.364521

concave.points_se        5.235966

symmetry_se              4.312472

fractal_dimension_se     7.575192

area_worst              10.540176

smoothness_worst         8.644833

concavity_worst         15.699140

symmetry_worst           7.294569

fractal_dimension_worst 13.021119

removed:  area_se 16.33381 

                              vif

texture_mean             1.709993

smoothness_mean          6.701262

concave.points_mean     11.653729

symmetry_mean            3.651771

fractal_dimension_mean   7.750052

texture_se               2.009042

perimeter_se             4.317808

smoothness_se            3.338723

compactness_se           6.317986

concavity_se             8.849322

concave.points_se        4.645375

symmetry_se              4.312339

fractal_dimension_se     7.575158

area_worst               8.677078

smoothness_worst         8.642994

concavity_worst         15.510661

symmetry_worst           7.265658

fractal_dimension_worst 12.938791

removed:  concavity_worst 15.51066 

> X_independent

 [1] "texture_mean"            "smoothness_mean"         "concave.points_mean"    

 [4] "symmetry_mean"           "fractal_dimension_mean"  "texture_se"             

 [7] "perimeter_se"            "smoothness_se"           "compactness_se"         

[10] "concavity_se"            "concave.points_se"       "symmetry_se"            

[13] "fractal_dimension_se"    "area_worst"              "smoothness_worst"       

[16] "symmetry_worst"          "fractal_dimension_worst"

> # explanatory/independant variables after VIF test

> X_2 <- X[, X_independent]

> str(X_2)

'data.frame': 569 obs. of  17 variables:

 $ texture_mean           : num  10.4 17.8 21.2 20.4 14.3 ...

 $ smoothness_mean        : num  0.1184 0.0847 0.1096 0.1425 0.1003 ...

 $ concave.points_mean    : num  0.1471 0.0702 0.1279 0.1052 0.1043 ...

 $ symmetry_mean          : num  0.242 0.181 0.207 0.26 0.181 ...

 $ fractal_dimension_mean : num  0.0787 0.0567 0.06 0.0974 0.0588 ...

 $ texture_se             : num  0.905 0.734 0.787 1.156 0.781 ...

 $ perimeter_se           : num  8.59 3.4 4.58 3.44 5.44 ...

 $ smoothness_se          : num  0.0064 0.00522 0.00615 0.00911 0.01149 ...

 $ compactness_se         : num  0.049 0.0131 0.0401 0.0746 0.0246 ...

 $ concavity_se           : num  0.0537 0.0186 0.0383 0.0566 0.0569 ...

 $ concave.points_se      : num  0.0159 0.0134 0.0206 0.0187 0.0188 ...

 $ symmetry_se            : num  0.03 0.0139 0.0225 0.0596 0.0176 ...

 $ fractal_dimension_se   : num  0.00619 0.00353 0.00457 0.00921 0.00511 ...

 $ area_worst             : num  2019 1956 1709 568 1575 ...

 $ smoothness_worst       : num  0.162 0.124 0.144 0.21 0.137 ...

 $ symmetry_worst         : num  0.46 0.275 0.361 0.664 0.236 ...

 $ fractal_dimension_worst: num  0.1189 0.089 0.0876 0.173 0.0768 ...

> 

> # correlation heatmap plot again

> ggcorr(X_2, name="corr", label=T)

  (5) 설명변수 표준화, 척도 변환 (standardization, rescal)

> # Standardization

> X_3 <- scale(X_2)

> summary(X_3)

  texture_mean     smoothness_mean    concave.points_mean symmetry_mean      fractal_dimension_mean

 Min.   :-2.2273   Min.   :-3.10935   Min.   :-1.2607     Min.   :-2.74171   Min.   :-1.8183       

 1st Qu.:-0.7253   1st Qu.:-0.71034   1st Qu.:-0.7373     1st Qu.:-0.70262   1st Qu.:-0.7220       

 Median :-0.1045   Median :-0.03486   Median :-0.3974     Median :-0.07156   Median :-0.1781       

 Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.0000     Mean   : 0.00000   Mean   : 0.0000       

 3rd Qu.: 0.5837   3rd Qu.: 0.63564   3rd Qu.: 0.6464     3rd Qu.: 0.53031   3rd Qu.: 0.4706       

 Max.   : 4.6478   Max.   : 4.76672   Max.   : 3.9245     Max.   : 4.48081   Max.   : 4.9066       

   texture_se       perimeter_se     smoothness_se     compactness_se     concavity_se    

 Min.   :-1.5529   Min.   :-1.0431   Min.   :-1.7745   Min.   :-1.2970   Min.   :-1.0566  

 1st Qu.:-0.6942   1st Qu.:-0.6232   1st Qu.:-0.6235   1st Qu.:-0.6923   1st Qu.:-0.5567  

 Median :-0.1973   Median :-0.2864   Median :-0.2201   Median :-0.2808   Median :-0.1989  

 Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000  

 3rd Qu.: 0.4661   3rd Qu.: 0.2428   3rd Qu.: 0.3680   3rd Qu.: 0.3893   3rd Qu.: 0.3365  

 Max.   : 6.6494   Max.   : 9.4537   Max.   : 8.0229   Max.   : 6.1381   Max.   :12.0621  

 concave.points_se  symmetry_se      fractal_dimension_se   area_worst      smoothness_worst 

 Min.   :-1.9118   Min.   :-1.5315   Min.   :-1.0960      Min.   :-1.2213   Min.   :-2.6803  

 1st Qu.:-0.6739   1st Qu.:-0.6511   1st Qu.:-0.5846      1st Qu.:-0.6416   1st Qu.:-0.6906  

 Median :-0.1404   Median :-0.2192   Median :-0.2297      Median :-0.3409   Median :-0.0468  

 Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000      Mean   : 0.0000   Mean   : 0.0000  

 3rd Qu.: 0.4722   3rd Qu.: 0.3554   3rd Qu.: 0.2884      3rd Qu.: 0.3573   3rd Qu.: 0.5970  

 Max.   : 6.6438   Max.   : 7.0657   Max.   : 9.8429      Max.   : 5.9250   Max.   : 3.9519  

 symmetry_worst    fractal_dimension_worst

 Min.   :-2.1591   Min.   :-1.6004        

 1st Qu.:-0.6413   1st Qu.:-0.6913        

 Median :-0.1273   Median :-0.2163        

 Mean   : 0.0000   Mean   : 0.0000        

 3rd Qu.: 0.4497   3rd Qu.: 0.4504        

 Max.   : 6.0407   Max.   : 6.8408

[로지스틱 회귀분석을 통한 유방암 예측(분류) 포스팅 순서]

1. WDBC(Wisconsin Diagnostic Breast Cancer) dataset 소개 및 분석 목적과 방향 설정
2. 탐색적 데이터 분석 및 전처리
3. 1차 변수 선택 및 목표변수와 설명변수 간 관계 분석
4. 로지스틱 회귀모형 적합 및 모델 평가, 해석

  (1) WDBC(Wisconsin Diagnostic Breast Cancer) Dataset 소개

> rm(list=ls()) # clear all

> options(scipen=30)

> # data loading: WDBC (Wisconsin Diagnostic Breast Cancer)

> library(data.table)

data.table 1.11.8  Latest news: r-datatable.com

> library(curl)

> 

> url <- c("https://archive.ics.uci.edu/ml/machine-learning-databases/breast-cancer-wisconsin/wdbc.data")

> wdbc <- data.frame(fread(url))

  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current

                                 Dload  Upload   Total   Spent    Left  Speed

  0     0    0     0    0     0      0      0 --:--:-- --:--:-- --:--:--     0  0  121k    0     0    0     0      0      0 --:--:-- --:--:-- --:--:--     0100  121k  100  121k    0     0  81060      0  0:00:01  0:00:01 --:--:-- 81060

> str(wdbc)

'data.frame': 569 obs. of  32 variables:

 $ V1 : int  842302 842517 84300903 84348301 84358402 843786 844359 84458202 844981 84501001 ...

 $ V2 : chr  "M" "M" "M" "M" ...

 $ V3 : num  18 20.6 19.7 11.4 20.3 ...

 $ V4 : num  10.4 17.8 21.2 20.4 14.3 ...

 $ V5 : num  122.8 132.9 130 77.6 135.1 ...

 $ V6 : num  1001 1326 1203 386 1297 ...

 $ V7 : num  0.1184 0.0847 0.1096 0.1425 0.1003 ...

 $ V8 : num  0.2776 0.0786 0.1599 0.2839 0.1328 ...

 $ V9 : num  0.3001 0.0869 0.1974 0.2414 0.198 ...

 $ V10: num  0.1471 0.0702 0.1279 0.1052 0.1043 ...

 $ V11: num  0.242 0.181 0.207 0.26 0.181 ...

 $ V12: num  0.0787 0.0567 0.06 0.0974 0.0588 ...

 $ V13: num  1.095 0.543 0.746 0.496 0.757 ...

 $ V14: num  0.905 0.734 0.787 1.156 0.781 ...

 $ V15: num  8.59 3.4 4.58 3.44 5.44 ...

 $ V16: num  153.4 74.1 94 27.2 94.4 ...

 $ V17: num  0.0064 0.00522 0.00615 0.00911 0.01149 ...

 $ V18: num  0.049 0.0131 0.0401 0.0746 0.0246 ...

 $ V19: num  0.0537 0.0186 0.0383 0.0566 0.0569 ...

 $ V20: num  0.0159 0.0134 0.0206 0.0187 0.0188 ...

 $ V21: num  0.03 0.0139 0.0225 0.0596 0.0176 ...

 $ V22: num  0.00619 0.00353 0.00457 0.00921 0.00511 ...

 $ V23: num  25.4 25 23.6 14.9 22.5 ...

 $ V24: num  17.3 23.4 25.5 26.5 16.7 ...

 $ V25: num  184.6 158.8 152.5 98.9 152.2 ...

 $ V26: num  2019 1956 1709 568 1575 ...

 $ V27: num  0.162 0.124 0.144 0.21 0.137 ...

 $ V28: num  0.666 0.187 0.424 0.866 0.205 ...

 $ V29: num  0.712 0.242 0.45 0.687 0.4 ...

 $ V30: num  0.265 0.186 0.243 0.258 0.163 ...

 $ V31: num  0.46 0.275 0.361 0.664 0.236 ...

 $ V32: num  0.1189 0.089 0.0876 0.173 0.0768 ...

> # column names

> colnames(wdbc) <- c("id", "diagnosis", "radius_mean", "texture_mean", 

+                     "perimeter_mean", "area_mean", "smoothness_mean", "compactness_mean",

+                     "concavity_mean", "concave.points_mean", "symmetry_mean", "fractal_dimension_mean", 

+                     "radius_se", "texture_se", "perimeter_se", "area_se", 

+                     "smoothness_se", "compactness_se", "concavity_se", "concave.points_se", 

+                     "symmetry_se", "fractal_dimension_se", "radius_worst", "texture_worst", 

+                     "perimeter_worst", "area_worst", "smoothness_worst", "compactness_worst", 

+                     "concavity_worst", "concave.points_worst", "symmetry_worst", "fractal_dimension_worst")

> 

> str(wdbc)

'data.frame': 569 obs. of  32 variables:

 $ id                     : int  842302 842517 84300903 84348301 84358402 843786 844359 84458202 844981 84501001 ...

 $ diagnosis              : chr  "M" "M" "M" "M" ...

 $ radius_mean            : num  18 20.6 19.7 11.4 20.3 ...

 $ texture_mean           : num  10.4 17.8 21.2 20.4 14.3 ...

 $ perimeter_mean         : num  122.8 132.9 130 77.6 135.1 ...

 $ area_mean              : num  1001 1326 1203 386 1297 ...

 $ smoothness_mean        : num  0.1184 0.0847 0.1096 0.1425 0.1003 ...

 $ compactness_mean       : num  0.2776 0.0786 0.1599 0.2839 0.1328 ...

 $ concavity_mean         : num  0.3001 0.0869 0.1974 0.2414 0.198 ...

 $ concave.points_mean    : num  0.1471 0.0702 0.1279 0.1052 0.1043 ...

 $ symmetry_mean          : num  0.242 0.181 0.207 0.26 0.181 ...

 $ fractal_dimension_mean : num  0.0787 0.0567 0.06 0.0974 0.0588 ...

 $ radius_se              : num  1.095 0.543 0.746 0.496 0.757 ...

 $ texture_se             : num  0.905 0.734 0.787 1.156 0.781 ...

 $ perimeter_se           : num  8.59 3.4 4.58 3.44 5.44 ...

 $ area_se                : num  153.4 74.1 94 27.2 94.4 ...

 $ smoothness_se          : num  0.0064 0.00522 0.00615 0.00911 0.01149 ...

 $ compactness_se         : num  0.049 0.0131 0.0401 0.0746 0.0246 ...

 $ concavity_se           : num  0.0537 0.0186 0.0383 0.0566 0.0569 ...

 $ concave.points_se      : num  0.0159 0.0134 0.0206 0.0187 0.0188 ...

 $ symmetry_se            : num  0.03 0.0139 0.0225 0.0596 0.0176 ...

 $ fractal_dimension_se   : num  0.00619 0.00353 0.00457 0.00921 0.00511 ...

 $ radius_worst           : num  25.4 25 23.6 14.9 22.5 ...

 $ texture_worst          : num  17.3 23.4 25.5 26.5 16.7 ...

 $ perimeter_worst        : num  184.6 158.8 152.5 98.9 152.2 ...

 $ area_worst             : num  2019 1956 1709 568 1575 ...

 $ smoothness_worst       : num  0.162 0.124 0.144 0.21 0.137 ...

 $ compactness_worst      : num  0.666 0.187 0.424 0.866 0.205 ...

 $ concavity_worst        : num  0.712 0.242 0.45 0.687 0.4 ...

 $ concave.points_worst   : num  0.265 0.186 0.243 0.258 0.163 ...

 $ symmetry_worst         : num  0.46 0.275 0.361 0.664 0.236 ...

 $ fractal_dimension_worst: num  0.1189 0.089 0.0876 0.173 0.0768 ...

> head(wdbc, 2)

      id diagnosis radius_mean texture_mean perimeter_mean area_mean smoothness_mean compactness_mean

1 842302         M       17.99        10.38          122.8      1001         0.11840          0.27760

2 842517         M       20.57        17.77          132.9      1326         0.08474          0.07864

  concavity_mean concave.points_mean symmetry_mean fractal_dimension_mean radius_se texture_se

1         0.3001             0.14710        0.2419                0.07871    1.0950     0.9053

2         0.0869             0.07017        0.1812                0.05667    0.5435     0.7339

  perimeter_se area_se smoothness_se compactness_se concavity_se concave.points_se symmetry_se

1        8.589  153.40      0.006399        0.04904      0.05373           0.01587     0.03003

2        3.398   74.08      0.005225        0.01308      0.01860           0.01340     0.01389

  fractal_dimension_se radius_worst texture_worst perimeter_worst area_worst smoothness_worst

1             0.006193        25.38         17.33           184.6       2019           0.1622

2             0.003532        24.99         23.41           158.8       1956           0.1238

  compactness_worst concavity_worst concave.points_worst symmetry_worst fractal_dimension_worst

1            0.6656          0.7119               0.2654         0.4601                 0.11890

2            0.1866          0.2416               0.1860         0.2750                 0.08902

  (2) 분석 목적 및 분석 방향 설정

# clear all

rm(list=ls())

# install and load libries

install.packages("textreadr")

install.packages("rvest")

install.packages("xlsx")

library(textreadr)

library(rvest)

library(xlsx)

urlbase <- "https://search.shopping.naver.com/search/all.nhn?query="

low <- c("에어팟","코카콜라","건전지","삼다수")

df <- data.frame()

# for loop statement

for (i in low){

  url <- paste(urlbase, i ,"&cat_id=&frm=NVSHATC",sep="")

  nv <- read_html(url, encoding = "UTF-8")

  st <- html_nodes(nv, '.mall_name') %>% html_text()

  st <- st[1:10]

  price3 <- html_nodes(nv, '._lowPriceByMall') %>% html_nodes('.price') %>% html_text()

  price3 <- gsub('최저가','',price3)

  price3 <- price3[1:10] # 최저가 Top 10

  df <- data.frame(가게명=st, 가격=price3)

  # append df to df_all

  df <- rbind(df, data.frame(가게명=url, 가격="r"))

  # adding sheetName

  write.xlsx(df, file="C:/Users/admin/Documents/df_sheet.xlsx", 

             sheetName=i, # excel sheet per each product or brand

             col.names=TRUE, 

             append=TRUE)

  # check progress

  print(paste0(i, " has been completed."))

}

urlbase <- "https://search.shopping.naver.com/search/all.nhn?query="

low <- c("에어팟","코카콜라","건전지","삼다수")

df_all <- data.frame()

# for loop statement

for (i in low){

  url <- paste(urlbase, i ,"&cat_id=&frm=NVSHATC",sep="")

  nv <- read_html(url, encoding = "UTF-8")

  st <- html_nodes(nv, '.mall_name') %>% html_text()

  st <- st[1:10]

  price3 <- html_nodes(nv, '._lowPriceByMall') %>% html_nodes('.price') %>% html_text()

  price3 <- gsub('최저가','',price3)

  price3 <- price3[1:10]

  df <- data.frame(item=i, 가게명=st, 가격=price3)

  # append url info to df_all

  df <- rbind(df, data.frame(item=i, 가게명=url, 가격="r"))

  # combining df to df_all one by one

  df_all <- rbind(df_all, df)

  # check progress

  print(paste0(i, " has been completed."))

}

# exporting df_all to excel

write.xlsx(df_all, 

           file="C:/Users/admin/Documents/df_all.xlsx", 

           col.names=TRUE)

[문제]  시간이 지남에 따라 일어난 어떤 특정 사건의 발생건수에 대한 결과가 다음과 같이 주어졌다고 하자. 그 때 특정 사건의 발생 회수가 포아송(λ) 분포를 따르는지에 대한 검정을 유의수준 5%에서 실시하시오.

 발생건수

0회

1회

2회 

3회 

4회 

5회 

6회 

7회 

8회 

9회 이상 

 관찰회수

6

20

36 

50 

52 

40 

25 

12 

4 

5 

 = (0*6+1*20+2*36+3*50*4*52+5*40+6*25+7*12+8*4+9*5)/250 = 3.844

> #===========================================
> # Chi-squared Goodness-of-fit Test
> # Poisson Distribution, 5% significant level
> #===========================================
> rm(list=ls()) # clear all
>
> # Class of Events
> classnum <- c(0:9)
>
> # Observed Frequency
> obsnum <- c(6, 20, 36, 50, 52, 40, 25, 12, 4, 5)
>
> # Sum of Observed Frequency
> obssum <- sum(obsnum); obssum
[1] 250
>
> # Calculate Lambda
> lamb <- sum(classnum*obsnum) / sum(obsnum); lamb
[1] 3.844 

> # Chi-squared goodness-of-fit test
> chisq.gof.test <- chisq.test(obsnum, p=hyp_prob) # error
Error in chisq.test(obsnum, p = hyp_prob) : 
  확률값들의 총계는 반드시 1 이어야 합니다 

> # Change the last hypothesised probability to make sum(hyp_prob)=1
> hyp_prob[length(hyp_prob)] <- 1-sum(hyp_prob[1:(length(hyp_prob)-1)]); hyp_prob
[1] 0.021 0.082 0.158 0.203 0.195 0.150 0.096 0.053 0.025 0.017
> sum(hyp_prob) # 1
[1] 1 

 발생건수

0회

1회

2회 

3회 

4회 

5회 

6회 

7회 

8회 

9회 이상 

 계

 발생확률

0.021

0.082

0.158

0.203

0.195

0.150

0.096

0.053

0.025

0.017

 1

기대도수

(Ei=Pi*250)

5.25

20.50

39.50

50.75

48.75

37.50

24.00

13.25

6.25

4.25

250

 관측도수

(Oi)

6

20

36

50

52

40

25

12

4

5

250

> # Chi-squared goodness-of-fit test
> chisq.gof.test <- chisq.test(obsnum, p=hyp_prob)
Warning message:
In chisq.test(obsnum, p = hyp_prob) :
카이제곱 approximation은 정확하지 않을수도 있습니다
> chisq.gof.test

Chi-squared test for given probabilities

data:  obsnum
X-squared = 1.9258, df = 9, p-value = 0.9926 

> names(chisq.gof.test)
[1] "statistic" "parameter" "p.value"   "method"    "data.name"
[6] "observed"  "expected"  "residuals" "stdres"  

> chisq.gof.test$observed
[1]  6 20 36 50 52 40 25 12  4  5
> chisq.gof.test$expected
[1]  5.25 20.50 39.50 50.75 48.75 37.50 24.00 13.25  6.25  4.25
> round(hyp_prob, 3)
[1] 0.021 0.082 0.158 0.203 0.195 0.150 0.096 0.053 0.025 0.017 

> # Plot of Poisson Distribution: Observed vs. Expected
> # Observed Frequency
> plot(c(0:9), chisq.gof.test$observed, 
+      main="Poisson Distribution: Observed vs. Expected", 
+      type='b', 
+      pch=0,
+      col='blue',
+      xlab="Number of Events",
+      ylab="Frequency",
+      ylim=c(0,55))
> 
> # Dual Y-axes plot (secondary Y-axis)
> par(new=T)
> 
> # Expected frequency
> plot(c(0:9), chisq.gof.test$expected, 
+      type='b', 
+      pch=1,
+      col='red', 
+      xlab="", 
+      ylab="",
+      ylim=c(0,55))
> 
> legend(x=6.5, y=50, 
+        c("Observed", "Expected"), 
+        pch=c(0,1), 
+        col=c('blue', 'red'))

#=========================================
# Dual y-axes plot using ggplot2 sec.axis
#=========================================

rm(list=ls()) # clear all

# make a DataFrame
data_val <- matrix(
  c(-4.2922960, 0.00000000000389755, 0.00000000268579,
  -3.9102123, 0.00000000000939471, 0.00000003082191,
  -3.5281286, 0.00000000002264455, 0.00000027610486,
  -3.1460449, 0.00000000005458189, 0.00000193070482,
  -2.7639612, 0.00000000013156254, 0.00001053865139,
  -2.3818776, 0.00000000031711433, 0.00004490363779,
  -1.9997939, 0.00000000076436268, 0.00014935003987,
  -1.6177102, 0.00000000184239690, 0.00038775418083,
  -1.2356265, 0.00000000444085801, 0.00078584150863,
  -0.8535428, 0.00000001070411038, 0.00124319933681,
  -0.4714591, 0.00000002580086522, 0.00153523161114,
  -0.0893754, 0.00000006218962756, 0.00147990680737,
  0.2927083, 0.00000014989999897, 0.00111358189390,
  0.6747920, 0.00000036131440584, 0.00065408965954,
  1.0568757, 0.00000087090114242, 0.00029990225777,
  1.4389594, 0.00000209919260108, 0.00010733701573,
  1.8210431, 0.00000505982314747, 0.00002998793957,
  2.2031268, 0.00001219600184343, 0.00000653989939,
  2.5852105, 0.00002939662278856, 0.00000111332724,
  3.5852105, 0.00029392734366929, 0.00000000000000,
  4.5852105, 0.00293538878457633, 0.00000000000000,
  5.5852105, 0.02896916461589227, 0.00000000000000,
  6.5852105, 0.25470155892952129, 0.00000000000000,
  7.5852105, 0.94711869936516890, 0.00000000000000,
  8.5852105, 0.99999999999982903, 0.00000000000000,
  9.5852105, 1.00000000000000000, 0.0000000000000),
  nrow=26,
  byrow=TRUE)

# convert a matrix into a dataframe
df <- data.frame(data_val)

# column name
colnames(df) <- c("x", "y1", "y2")

> head(df)
          x           y1           y2
1 -4.292296 3.897550e-12 2.685790e-09
2 -3.910212 9.394710e-12 3.082191e-08
3 -3.528129 2.264455e-11 2.761049e-07
4 -3.146045 5.458189e-11 1.930705e-06
5 -2.763961 1.315625e-10 1.053865e-05
6 -2.381878 3.171143e-10 4.490364e-05

> # max ratio b/w 2 axes
> summary(df)
       x                 y1                  y2          
Min.   :-4.2923   Min.   :0.0000000   Min.   :0.000e+00 
1st Qu.:-1.9043   1st Qu.:0.0000000   1st Qu.:7.000e-10 
Median : 0.4838   Median :0.0000003   Median :8.539e-06 
Mean   : 1.1492   Mean   :0.1243873   Mean   :3.020e-04 
3rd Qu.: 3.3352   3rd Qu.:0.0002278   3rd Qu.:3.658e-04 
Max.   : 9.5852   Max.   :1.0000000   Max.   :1.535e-03 
> max_ratio <- max(df$y1)/max(df$y2); max_ratio
[1] 651.367

> # Dual y-axes plot using ggplot2 sec.axis
> library(ggplot2)
> 
> g <- ggplot(df, aes(x = x))
>   g <- g + geom_line(aes(y = y1), colour = "red", size = 2)
>   
>   # adding the relative result5.data.A, 
>   # transformed to match roughly the range of the B
>   g <- g + geom_bar(aes(y = y2*max_ratio), 
>                         fill = "blue", 
>                         stat = "identity")
>   
>   # adding secondary axis
>   g <- g + scale_y_continuous(sec.axis = sec_axis(~.*max_ratio, name="y2*651"))
>   
> g

> # adding text
>   g <- g + annotate("text", x = -2, y = 0.75, colour="black", label="y2*651")
>   g <- g + annotate("text", x = 5, y = 0.5, colour="black", label="y1")
>   
> # adding arrow
> library(grid)
>   g <- g + annotate("segment", x = -1.8, y = 0.75, 
+                     xend = -1, yend = 0.6, colour="blue", arrow=arrow())
>   g <- g + annotate("segment", x = 5.2, y = 0.5, 
+                     xend = 6.7, yend = 0.4, colour="red", arrow=arrow())
> g

# To make an environment, console clear 

rm(list=ls()) # clearing environment

cat("\014") # clearing Console

# To make several sample DataFrames

data_1 <- data.frame(var1 = c(1, 2), var2 = c(3, 4))

data_2 <- data.frame(var1 = c('a', 'b'), var2 = c('c', 'd'))

data_3 <- data.frame(var1 = c(TRUE, TRUE), var2 = c(FALSE, TRUE))

file_1 <- data.frame(var1 = c(1, 2), var2 = c(3, 4))

file_2 <- data.frame(var1 = c('a', 'b'), var2 = c('c', 'd'))

file_3 <- data.frame(var1 = c(TRUE, TRUE), var2 = c(FALSE, TRUE))

> # To list up all objects in an environment

> ls()

[1] "data_1" "data_2" "data_3" "file_1" "file_2" "file_3"

> 

> # To list up objects which have a matching 'pattern' in a DataFrame name

> ls(pattern = "data_")

[1] "data_1" "data_2" "data_3"

> ls(pattern = "file_")

[1] "file_1" "file_2" "file_3"

> # To combine all DataFrame into a List using mget()

> list_df_data <- mget(ls(pattern = "data_"))

> list_df_data

$data_1

  var1 var2

1    1    3

2    2    4

$data_2

  var1 var2

1    a    c

2    b    d

$data_3

  var1  var2

1 TRUE FALSE

2 TRUE  TRUE

> 

> list_df_file <- mget(ls(pattern = "file_"))

> list_df_file

$file_1

  var1 var2

1    1    3

2    2    4

$file_2

  var1 var2

1    a    c

2    b    d

$file_3

  var1  var2

1 TRUE FALSE

2 TRUE  TRUE

> # To index one of object in a List using [[ ]]

> list_df_data[[1]] # using 'number'

  var1 var2

1    1    3

2    2    4

> list_df_data["data_1"] # using 'name'

$data_1

  var1 var2

1    1    3

2    2    4 

> rm(list=ls()) # clean all

# Sample vector

> set.seed(123) # for reproducibility

> vec_raw <- sample(c(0, 1), size=30, replace=TRUE, prob=(c(0.8, 0.2)))

> vec_raw

 [1] 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0

> vec <- vec_raw # copy for manipulation

##---------------------------------------------

# Vector Bin Split by successive '0's criteria

##---------------------------------------------

# Setting

vec_tmp <- c() # null vector

bin_range <- 3 # successive '0's criterion

vec_idx <- 1

vec_num <- 1

# Zero_Bin_Splitter

while (length(vec) > 0){

  if (sum(vec[1:bin_range], na.rm=T) != 0){

    vec_tmp[vec_idx] <- vec[1]

    vec <- vec[-1]

    vec_idx <- vec_idx + 1

  } else if (is.null(vec_tmp)){

    assign(paste0("vec_split_", vec_num), vec[1:bin_range])

    vec <- vec[-(1:bin_range)]

    vec_idx <- 1 # initialization

    vec_num <- vec_num + 1

  } else {

    assign(paste0("vec_split_", vec_num), vec_tmp)

    vec_tmp <- c() # initialization

    vec_num <- vec_num + 1

    assign(paste0("vec_split_", vec_num), vec[1:bin_range])

    vec <- vec[-(1:bin_range)]

    vec_idx <- 1 # initialization

    vec_num <- vec_num + 1

  }

}

# delete temp vector and arguments

rm(vec, vec_tmp, bin_range, vec_idx, vec_num)

# by June Young Lee

library(data.table)

# 0이 세번 연속으로 들어 있는 아무 벡터 생성

vec <- c(0,0,0,3,10,2,3,0,4,0,0,0,1,2,50,4,0,0,32,1,0,0,0,1,1)

# data.table함수인 rleid이용하여 연속인 행들을 구분하는 idx1 컬럼 생성 

dt <- data.table(v1=vec, idx1=rleid(vec))

# idx1 기준으로 갯수를 세어 N 컬럼 생성 

dt[,N:=.N, by=idx1]

# 0이 세번 연속으로 나온 그룹(=N컬럼변수가 3인)을 idx2로 체크하기 

dt[v1==0&N==3,idx2:=1L]

# split 하기 위한 기준 벡터를 마찬가지로 rleid함수를 이용하여 idx3로 생성

dt[,idx3:=rleid(idx2)]

# data.table의 split 함수 적용하고, lapply 적용하여 v1 칼럼만 추출 

res <- lapply(split(dt, by="idx3"), function(x) x[,v1])

res

# $`1`

# [1] 0 0 0

# 

# $`2`

# [1] 3 10 2 3 0 4

# 

# $`3`

# [1] 0 0 0

# 

# $`4`

# [1] 1 2 50 4 0 0 32 1

# 

# $`5`

# [1] 0 0 0

# 

# $`6`

# [1] 1 1

# 0이 3번 연속으로 나온 놈들을 남겨두도록 작성한 이유는, 

# 위치확인 & 확인용입니다. 

# 필요없으면, 아래 정도의 코드를 추가하면 되겠네요.

res2 <- res[!unlist(lapply(res, function(x) length(x)==3&sum(x)==0))]

res2

# $`2`

# [1] 3 10 2 3 0 4

# 

# $`4`

# [1] 1 2 50 4 0 0 32 1

# 

# $`6`

# [1] 1 1