close_btn
조회 수 2339 추천 수 0 댓글 0
?

단축키

Prev이전 문서

Next다음 문서

+ - Up Down Comment Print Files
?

단축키

Prev이전 문서

Next다음 문서

+ - Up Down Comment Print Files
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
######NBC#####
################################################################################
## 0. 시행해 주세요
rm(list= ls())
work1 <- read.table('work1.txt', header = TRUE)
work2 <- read.table('work2.txt', header = TRUE)
work3 <- read.table('work3.txt', header = TRUE)
test <- read.table('test.txt', header = TRUE)
 
converting <- function(mydata) {
  for(i in c(13467)) mydata[,i] <- factor(mydata[,i])
  return(mydata)
}
 
work1 <- converting(work1)
work2 <- converting(work2)
work3 <- converting(work3)
test <- converting(test)
 
#################################################################################
## 1. 초기화
PARAMS <- list(wife_edu_C1 = vector(mode = 'numeric'4),
               husband_edu_C1 = vector(mode = 'numeric'4),
               husband_job_C1 = vector(mode = 'numeric'4),
               living_index_C1 = vector(mode = 'numeric'4),
               wife_age_C1 = c(08.2272),
               children_C1 = c(02.3585),
               wife_edu_C2 = vector(mode = 'numeric'4),
               husband_edu_C2 = vector(mode = 'numeric'4),
               husband_job_C2 = vector(mode = 'numeric'4),
               living_index_C2 = vector(mode = 'numeric'4),
               wife_age_C2 = c(08.2272),
               children_C2 = c(02.3585),
               prior = vector(mode = 'numeric'2),
               prev_cnt = c(00))
 
##################################################################################
## 2. 모수 업데이트 함수
library(dplyr) 
ParmasUpdate <- function(D, PARAMS) {
  msd <- D %>% group_by(wife_work) %>% summarise(mean(wife_age), sd(wife_age), mean(children), sd(children))
  counts <- D %>% group_by(wife_work) %>% summarise(n())
  vari <- c("wife_edu""husband_edu""husband_job""living_index")
  for (u in 1:4) {
    temp <- addmargins(with(D, table(wife_work, get(vari[u]))))
    PARAMS[[u]] <- (temp[1-5+ (PARAMS[[u]] * as.numeric(PARAMS$prev_cnt[1])))/(as.numeric(counts[12]) + PARAMS$prev_cnt[1])
    PARAMS[[u+6]] <- (temp[2-5+ (PARAMS[[u+6]] * as.numeric(PARAMS$prev_cnt[2]) ))/(as.numeric(counts[22]) + PARAMS$prev_cnt[2])
  }
  for (j in c(5,6)){
    PARAMS[[j]][1<- (((as.numeric(msd[12*(j - 4)]) * as.numeric(counts[1,2])) + PARAMS[[j]][1* PARAMS$prev_cnt[1])
                       / (as.numeric(counts[12]) + PARAMS$prev_cnt[1]))
    PARAMS[[j]][2<- (((as.numeric(msd[12*(j - 4+ 1]) * as.numeric(counts[1,2])) + PARAMS[[j]][2* PARAMS$prev_cnt[1])
                       / (as.numeric(counts[12]) + PARAMS$prev_cnt[1]))
    PARAMS[[j+6]][1<- (((as.numeric(msd[22*(j - 4)]) * as.numeric(counts[2,2])) + PARAMS[[j+6]][1* PARAMS$prev_cnt[2])
                         / (as.numeric(counts[22]) + PARAMS$prev_cnt[2]))
    PARAMS[[j+6]][2<- (((as.numeric(msd[22*(j - 4+ 1]) * as.numeric(counts[2,2])) + PARAMS[[j+6]][2* PARAMS$prev_cnt[2])
                         / (as.numeric(counts[22]) + PARAMS$prev_cnt[2]))
  }
  PARAMS$prev_cnt <- c(as.numeric(counts[12]) + PARAMS$prev_cnt[1], as.numeric(counts[22]) + PARAMS$prev_cnt[2])
  PARAMS$prior <- as.numeric(PARAMS$prev_cnt)/sum(PARAMS$prev_cnt)
  return(PARAMS)
}
 
##################################################################################
## 3. predict 함수
predict.1 <- function(newdata, params) {
  result <- NULL
  for (i in 1:nrow(newdata)) {
  temp <- dnorm(newdata[i,1], mean = as.numeric(params$wife_age_C1[1]), sd = as.numeric(params$wife_age_C1[2]))
  pro1 <- params$wife_edu_C1[newdata[i,2]]
  pro2 <- params$husband_edu_C1[newdata[i,3]]
  temp1 <- dnorm(newdata[i,4], mean = as.numeric(params$children_C1[1]), sd = as.numeric(params$children_C1[2]))
  pro3 <- params$husband_job_C1[newdata[i,5]]
  pro4 <- params$living_index_C1[newdata[i,6]]
  total.pro1 <- prod(temp, pro1, pro2, temp1, pro3, pro4, params$prior[1])
  
  temp2 <- dnorm(newdata[i,1], mean = as.numeric(params$wife_age_C2[1]), sd = as.numeric(params$wife_age_C2[2]))
  pro12 <- params$wife_edu_C2[newdata[i,2]]
  pro22 <- params$husband_edu_C2[newdata[i,3]]
  temp22 <- dnorm(newdata[i,4], mean = as.numeric(params$children_C2[1]), sd = as.numeric(params$children_C2[2]))
  pro32 <- params$husband_job_C2[newdata[i,5]]
  pro42 <- params$living_index_C2[newdata[i,6]]
  total.pro12 <- prod(temp2, pro12, pro22, temp22, pro32, pro42, params$prior[2])
  result[i] <- ifelse(total.pro1 > total.pro12, "0""1")
  }
  return(as.factor(result)) 
}
 
###################################################################################
## 4. 결과 확인
library(naivebayes)
 
# 모수 추정이 같은가?
PARAMS_1 <- ParmasUpdate(work1, PARAMS)
model.1 <- naive_bayes(work1[,-1], work1[,1])
 
#
PARAMS_2 <- ParmasUpdate(work2, PARAMS_1)
PARAMS_3 <- ParmasUpdate(work3, PARAMS_2)
 
work123 <- rbind(work1, work2, work3)
model.3 <- naive_bayes(work123[,-1], work123[,1] )
 
 
## 예측값이 같은가?
predict.1(test[,-1], PARAMS_3)
predict(model.3, newdata=test[,-1])
 
predict.1(test[,-1], PARAMS_1)
predict(model.1, newdata=test[,-1])
 
<- predict.1(test[,-1], PARAMS_1)
<- predict(model.1, newdata=test[,-1])
 
table(a,b)
 
##############################################
#나이브 베이즈 성능이 안좋은 이유에 관하여
# 나이브 베이즈가 성능이 안 좋은 이유에 관하여
# 1) MLE 방식 채택 
# MLE 방식의 한계점은 분포를 알고 있다는 것을 전제를 하기 때문에 발생한다. 
#나이브 베이즈는 연속형(수치형) 자료에서 확률을 계산하기 위해서 정규성을 가정하고 정규 분포에 집어 넣어서 확률을 계산한다.
#만약 수치형 자료가 정규 분포가 아니라 특정 다른 분포를 따르게 되는 경우에는 정확도가 잘못된 확률로 정확도가 떨어질 수밖에 없다. 
#그러나 이 한계점은 모든 분포의 합 분포가 정규분포가 되는 중심극한정리에 의해서, 
#대수의 법칙에 의해서 표본 수가 늘어날수록 극복될 수 있는 특징을 갖는다.
# 2) Prior 확률의 문제
# 베이시안 추정에서는 사전확률을 통해서 사후확률을 조건부 확률적으로 예측하는 원리를 갖고 있다. 
#그러므로 사전확률 추정방식에 따라서 결과 역시 달라질 수 있다. 
#과제에서 주어진 확률 방식의 경우 한 쪽으로 치우친 자료들이 들어갈 경우 결과 역시 한 쪽으로 편향되어서 나오는 방식이다. 
#예를 들어 과제에서 진행된 사전확률(prior probability) 방식은 총 개수에서 특정 개수를 세는 방식을 채택했다. 
#다시 말해 {wife_work = 0}/({wife_work = 1} + {wife_work = 0}) 방식으로 P(wife_work = 0)을 계산하였다. 
#wife_work =1에 해당한 개수가 많을수록 wife_work =0이 나올 확률이 작아지도록 되는 구조이기에 
#랜덤하지 못한 자료가 들어갔을 경우에 결과가 오염될 가능성이 커지는 구조이다. 
cs

List of Articles
번호 제목 글쓴이 날짜 조회 수
공지 R 소스 공유 게시판 이용 관련 공지사항 1 DataMarket 2014.05.21 25223
110 투빅스 8&9기 8주차 LDA - 9기 전민규 file 전민규 2018.03.25 2298
109 투빅스 8&9기 8주차 SVM - 9기 최영제 file :) 2018.03.25 2033
108 투빅스 8&9기 8주차 과제 PCA -9기 신용재 file 신용재 2018.03.23 1961
107 투빅스 8&9기 7주차 과제 논문 요약 - 9기 배현주 file 배현주 2018.03.16 2064
106 투빅스 8&9기 7주차 과제 논문 요약 - 8기 김강열 file 김강열 2018.03.15 2093
105 투빅스 8&9기 7주차 과제 - 9기 김수지 file 김수지 2018.03.15 2087
104 투빅스 8&9기 6주차 과제 - 9기 서석현 file 스르륵 2018.03.08 2057
103 투빅스 8&9기 설 알고리즘 과제 - 9기 백광제 file 백광제 2018.02.25 2470
102 투빅스 8&9기 설 분석 과제 16' 뉴욕 택시 운행시간 예측 - 9기 최영제 :) 2018.02.24 2739
101 투빅스 8&9기 4주차 과제 Random Forest -9기 이잉걸 잉걸 2018.02.15 2380
» 투빅스 8&9기 4주차 과제 Naive Bayes Classification -9기 서석현 file 스르륵 2018.02.14 2339
99 투빅스 8&9기 3주차 과제 K-Nearest Neighbor, K-means 구현 -9기 신용재 1 신용재 2018.02.08 2842
98 투빅스 8&9기 3주차 과제 연관성 분석 - 9기 최영제 :) 2018.02.08 2551
97 투빅스 8&9기 2주차 과제 Gradient Descent, Softmax, Cross Entropy - 9기 서석현 file 스르륵 2018.02.02 2412
96 투빅스 8&9기 2주차 과제 회귀분석/로지스틱 - 9기 최영제 file :) 2018.02.02 2865
95 투빅스 8&9기 2주차 과제 Gradient Descent, Softmax, Cross Entropy - 9기 김명진 file kimji 2018.02.02 2291
94 투빅스 8&9기 1주차 과제 R 9기-신용재 file 신용재 2018.01.25 2685
93 투빅스 8&9기 1주차 과제 R 알고리즘 - 9기 서석현 file 스르륵 2018.01.25 2717
92 투빅스 7&8기 9주차 과제 Neural Network를 이용한 MNIST 분류 - 8기 김민정 민정e 2017.09.23 4078
91 투빅스 7&8기 9주차 과제 Neural Network를 이용한 MNIST 분류 - 8기 최서현 최서현 2017.09.22 3934
Board Pagination ‹ Prev 1 2 3 4 5 ... 6 Next ›
/ 6

나눔글꼴 설치 안내


이 PC에는 나눔글꼴이 설치되어 있지 않습니다.

이 사이트를 나눔글꼴로 보기 위해서는
나눔글꼴을 설치해야 합니다.

설치 취소

Designed by sketchbooks.co.kr / sketchbook5 board skin

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5