카테고리 없음
[Project] 한국 아파트 가격 네트워크 - 소셜 네트워크 분석
Doyun+
2021. 6. 23. 00:40
Subject : Expressing Korea’s Real Estate Network with Social Network
Language : R
Data : ‘한국감정원 아파트 지수’ Data
1. Data preprocessing
### 주제 - 전국 지역별 아파트 가격 지수의 네트워크 파악
### 기대효과 - 혼란스러운 부동산 시장의 흐름을 파악하여 부동산 시장의 변동에 대비
## Vertex : 각 지역
## Edge(Weight) : 각 지역별 아파트 가격 지수 변동의 상관계수
# 디렉토리 설정 및 라이브러리 불러오기
setwd("C:\\r_temp")
library(tidyverse)
# 데이터 불러오기
df <- read.csv("sna_data.csv", fileEncoding = "euc-kr", stringsAsFactors = F)
## 데이터 전처리
# 4개로 나뉘어져 있는 지역명 합치기
a <- subset(df, select=c('지.역','X','X.1','X.2'))
a <- unite(a, col="지역",지.역,X,X.1,X.2,sep="")
result <- data.frame(a, df[,5:268])
result <- result[2:221, ]
df <- t(result)
b <- df[1, ]
# 짝수 열만 불러오기 (지수만 가져오기 위함)
q <- seq(2, 264 , by = 2)
t <- data.frame()
for (a in q){
t <- rbind(t, df[q,])
}
# 열이름 지정
colnames(t) <- b
# 필요한 부분 불러오기
sna <- t[1:132,]
# 겹치는 "구"명 바꾸기
names(sna)[which(names(sna) == "중구")] <- c("서울중구", "인천중구", "부산중구", "대구중구", "대전중구", "울산중구")
names(sna)[which(names(sna) == "남구")] <- c("인천남구" , "부산남구", "대구남구", "광주남구", "울산남구", "포항남구")
names(sna)[which(names(sna) == "동구")] <- c("인천동구", "부산동구", "대구동구", "광주동구", "대전동구","울산동구")
names(sna)[which(names(sna) == "강서구")] <- c("서울강서구","부산강서구")
names(sna)[which(names(sna) == "북구")] <- c("부산북구", "대구북구","광주북구" ,"울산북구" ,"포항북구")
names(sna)[which(names(sna) == "서구")] <- c("인천서구", "부산서구", "대구서구" ,"광주서구" ,"대전서구")
# 불필요한 열 제거
sna$경부2권 <- NULL
sna$용인시 <- NULL
sna$수원시 <- NULL
sna$서해안권 <- NULL
sna$안산시 <- NULL
sna$동부1권 <- NULL
sna$동부2권 <- NULL
sna$경의권 <- NULL
sna$고양시 <- NULL
sna$강북지역 <-NULL
sna$도심권 <- NULL
sna$동북권 <- NULL
sna$서북권 <- NULL
sna$서남권 <- NULL
sna$동남권 <- NULL
sna$경기 <- NULL
sna$경부1권 <- NULL
sna$안양시 <- NULL
sna$성남시 <- NULL
sna$제주 <- NULL
sna$경원권 <- NULL
sna$인천 <- NULL
sna$부산 <- NULL
sna$중부산권 <- NULL
sna$동부산권 <- NULL
sna$서부산권 <- NULL
sna$대구 <- NULL
sna$광주 <- NULL
sna$대전 <- NULL
sna$울산 <- NULL
sna$경북 <- NULL
sna$경남 <- NULL
sna$충북 <- NULL
sna$충남 <- NULL
sna$전북 <- NULL
sna$전남 <- NULL
sna$강원 <- NULL
sna$창원시 <- NULL
sna$포항시 <- NULL
sna$천안시 <- NULL
sna$전주시 <- NULL
sna$청주시 <- NULL
# 최종 데이터 파일 저장
data <- data.frame(sna)
# 열별로 숫자형으로 바꿔주기
data <- as.data.frame(apply(data, 2, as.numeric))- Edge List 생성 전, 데이터프레임 전처리 해주는 과정을 거침.
# 열 개수 = 132개
nrow(data)
## [1] 132
# Data가 2009년 1월부터 2019년 12월 데이터
# 4로 나눠주어 33개월(2년 9개월)씩 나누어 지수의 평균값 구하기
net <- t(data.frame(apply(data[1:33, ], 2, mean, na.rm = T), apply(data[34:66, ], 2, mean, na.rm = T),
apply(data[67:101, ], 2, mean, na.rm = T), apply(data[102:132, ], 2, mean, na.rm = T)))
net <- data.frame(net)
# Combination 조합
comb <- combn(colnames(net), 2) %>% t()
# 행이름 지정
rownames(net) <- c("one", "two", "three", "four")
net$강원.1 <- NULL
# 지수의 변동 파악
change <- data.frame(apply(net, 2, diff))
# 지수 변동 데이터프레임 생성
change <- t(change)
change <- data.frame(change)
colnames(change) <- c("a", "b", "c")
a <- data.frame(change$a)
b <- data.frame(change$b)
c <- data.frame(change$c)
colnames(a) <- "지수"
colnames(b) <- "지수"
colnames(c) <- "지수"
d <- data.frame(rbind(a, b, c))
nm <- data.frame(rownames(change))
ae <- data.frame(rbind(nm, nm, nm))
last <- data.frame(cbind(d, ae))
colnames(last) <- c("지수", "지역")
# 조합별로 상관계수 추출
price <- c()
for(i in 1:nrow(comb)){ # 조합 한줄씩 읽어오기
# i번째 조합의 첫번째 주식의 종가diff 추출
a <- last[last$지역 == comb[i, 1], "지수"]
b <- last[last$지역 == comb[i, 2], "지수"]
print(i)
price <- c(price, cor(a, b)) # 두 주식 correlation 산출 후 저장
}
# 최종 edge list 생성
edge <- as.data.frame(comb)
edge <- cbind(edge, price)
colnames(edge) <- c("source", "target", "weight")
edge <- na.omit(edge)
# edge list csv 파일 저장
write.csv(edge, "sna_edge.csv")
- 조합별 상관계수를 가지는 Edge List 생성
2. Data visualization
- 지역별 상관계수로 Heat map 생성
- Network graph
# 상관계수 히트 맵 생성
netm <- as_adjacency_matrix(gg, attr="weight", sparse=F)
colnames(netm) <- V(gg)$name
rownames(netm) <- V(gg)$name
palf <- colorRampPalette(c("gold", "dark orange"))
heatmap(netm, Rowv = NA, Colv = NA, col = palf(100),
scale="none", margins=c(10,10) )
# Graph DataFrame 생성
g <- graph.data.frame(edge, directed = T)
# 상관계수 0.8 미만 삭제
gg <- delete.edges(g, E(g)[abs(weight) < 0.8])
# weight average cut
cut.off <- mean(edge$weight)
ggg <- delete_edges(g, E(g)[weight<cut.off])
# 엄청난 상관성을 보이는 것만 추출하여 시각화
ggs <- delete.edges(g, E(g)[abs(weight) < 0.99])
# weight 절대 값으로 변경 후, Graph DataFrame 생성
edge.abs <- edge
edge.abs$weight <- abs(edge$weight)
g.abs <- graph.data.frame(edge.abs, directed = T)
g.abs <- delete_edges(g.abs, E(g.abs)[weight<cut.off])
# 지역별로 다른 색 지정을 위해 벡터 생성
seoul <- c("종로구", "서울중구", "성동구", "광진구", "동대문구", "중랑구", "성북구",
"강북구", "도봉구", "노원구", "은평구", "서대문구", "마포구", "강남지역",
"양천구", "서울강서구", "구로구", "금천구", "영등포구", "동작구",
"관악구", "서초구", "강남구", "송파구", "강동구", "용산구")
gig <- c('과천시','만안구','동안구','수정구','중원구','분당구',
'군포시','의왕시','안성시','처인구','기흥구','수지구',
'장안구','권선구','팔달구','영통구','부천시','상록구',
'단원구','시흥시','광명시','화성시','오산시','평택시',
'남양주시','구리시','하남시','광주시','이천시','여주시','김포시',
'덕양구','일산동구','일산서구','파주시','포천시','동두천시','양주시', "의정부시")
ic <- c("인천중구","인천동구","인천남구","연수구","남동구","부평구","계양구","인천서구", "미추홀구")
busan <- c("부산중구","부산서구","부산동구","영도구","부산진구","부산남구",
"연제구","수영구","해운대구","금정구","동래구","기장군","부산북구", "부산강서구",
"사상구","사하구", "울산중구", "울산남구", "울산동구", "울산북구" ,"울주군")
daegu <- c("대구중구","대구동구","대구서구","대구남구","대구북구","수성구","달서구","달성군")
kwangju <- c("광주동구", "광주서구", "광주남구", "광주북구", "광산구")
daejun <- c("대전동구", "대전중구", "대전서구", "유성구", "대덕구")
gangwon <-c('춘천시','원주시','강릉시','동해시','태백시','속초시')
chunbuk <-c('삼척시','상당구','서원구','흥덕구','청원구','충주시','제천시','음성군')
chungnam <- c("동남구" ,"서북구", "공주시", "보령시", "서산시", "아산시", "논산시", "계룡시", "홍성군", "예산군", "당진시")
junbuk <- c("완산구", "덕진구", "군산시", "익산시", "정읍시" ,"남원시", "김제시")
junnam <- c("목포시", "여수시", "순천시", "나주시", "광양시", "무안군")
kb <- c("포항남구", "포항북구","경주시","김천시","안동시","구미시","영주시","영천시","상주시","문경시","경산시","칠곡군")
kn <- c("의창구","성산구","마산합포구","마산회원구","진해구","진주시","통영시","사천시","밀양시","김해시","거제시","양산시")
jeju <- c("제주시","서귀포시")
# 지역별로 Vertex 색 벡터 생성
colors <- ifelse(V(g)$name %in% seoul, "red",
ifelse(V(g)$name %in% gig, "#458B00",
ifelse(V(g)$name %in% ic, "blue",
ifelse(V(g)$name %in% busan, "purple",
ifelse(V(g)$name %in% daegu, "gold",
ifelse(V(g)$name %in% kwangju, "orange",
ifelse(V(g)$name %in% daejun, "skyblue",
ifelse(V(g)$name %in% gangwon, "beige",
ifelse(V(g)$name %in% chunbuk, "skyblue",
ifelse(V(g)$name %in% chungnam, "skyblue",
ifelse(V(g)$name %in% junbuk, "orange",
ifelse(V(g)$name %in% junnam, "orange",
ifelse(V(g)$name %in% kb, "gold",
ifelse(V(g)$name %in% kn, "purple", "black"))))))))))))))
# weight 값에 따라 색과 선굵기 구별해주는 벡터 생성
e.color <- ifelse(abs(E(g)$weight) > 0.8, "dark red", "skyblue")
e.width <- ifelse(abs(E(g)$weight) > 0.8, abs(E(gg)$weight*0.1), 0.5)
# 시각화
plot(g, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = log(degree(g)*0.2), edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA)
plot(g, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = log(degree(g)*0.2), edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, layout = layout_with_mds)
plot(g, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, layout = layout_as_star)
plot(g, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, layout = layout_as_tree)
# 시각화 2
plot(gg, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, edge.curved = 1, layout = layout.fruchterman.reingold)
plot(gg, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, edge.curved = 1, layout = layout_with_mds)
plot(gg, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, layout = layout_with_lgl)
plot(ggg, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, layout = layout_as_tree)
plot(gg, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, layout = layout_in_circle)
plot(gg, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, edge.curved = 0, layout = layout_nicely)
plot(gg, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, layout = layout_on_grid)
plot(gg, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, layout = layout_on_sphere)
plot(gg, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, layout = layout_randomly)
plot(gg, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = log(degree(g)*0.2), edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, edge.curved = 2, layout = layout_with_gem)
plot(gg, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, layout = layout_with_graphopt)
plot(gg, vertex.label.cex = 1, edge.width = abs(E(g)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, layout = layout_with_fr)
# Cluster
gD <- igraph::simplify(igraph::graph.data.frame(edge.abs, directed=FALSE))
lou <- cluster_louvain(gD)
plot(lou, gD, vertex.label = NA, vertex.size=5, edge.arrow.size = 0.0000002,
vertex.color = colors, edge.width = 0.05, edge.curved = 0.2)
# 시각화 2-1 (ppt)
plot(ggg, vertex.label.cex = 1, edge.width = 0.08,
vertex.size = 3, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA)
# tidygraph 객체 생성
ggg1<- tidygraph::as_tbl_graph(ggg) %>% activate(nodes) %>% mutate(label=name)
# tidygraph로 시각화 3
ggg1 %>%
ggraph(layout="tree") +
geom_edge_diagonal(alpha = .2, color='#8B8378') +
geom_node_point(size=0.001, color=colors) +
geom_node_text(aes(label = name), repel = TRUE, point.padding = unit(0.2, "lines"), colour=colors) +
theme_graph(background = 'white')
ggg1 %>%
ggraph(layout="eigen") +
geom_edge_diagonal(alpha = .2, color='#8B8378') +
geom_node_point(size=0.001, color=colors) +
geom_node_text(aes(label = name), repel = TRUE, point.padding = unit(0.2, "lines"), colour=colors) +
theme_graph(background = 'white')
## Warning in layout_with_eigen(graph, type = type, ev = eigenvector): g is
## directed. undirected version is used for the layout.
ggg1 %>%
ggraph(layout="graphopt") +
geom_edge_diagonal(alpha = .2, color='#8B8378') +
geom_node_point(size=0.001, color=colors) +
geom_node_text(aes(label = name), repel = TRUE, point.padding = unit(0.2, "lines"), colour=colors) +
theme_graph(background = 'white')
# 시각화 4
plot(ggs, vertex.label.cex = 1, edge.width = abs(E(ggs)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, edge.curved = 0, layout = layout_with_mds)
plot(ggs, vertex.label.cex = 1, edge.width = 1,
vertex.size = log(degree(g)*0.2), edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, edge.curved = 2, layout = layout_with_gem)
plot(ggs, vertex.label.cex = 1, edge.width = abs(E(ggs)$weight*0.1),
vertex.size = 2, edge.arrow.size = 0.000000000000001,
vertex.color = colors, vertex.label = NA, layout = layout_with_graphopt)
3. Interpretation of results
# 근접 중심성
# 단거리로 모든 노드에 접근이 가능
which.max(closeness(g.abs, mode = "all"))
## 단원구
## 45
which.max(closeness(g.abs, mode = "in"))
## Warning in closeness(g.abs, mode = "in"): At centrality.c:2617 :closeness
## centrality is not well-defined for disconnected graphs
## 제주시
## 141
which.max(closeness(g.abs, mode = "out"))
## Warning in closeness(g.abs, mode = "out"): At centrality.c:2617 :closeness
## centrality is not well-defined for disconnected graphs
## 종로구
## 1
# 연결 중심성
which.max(centralization.degree(ggg)$res)
## [1] 87
V(ggg)$name[87]
## [1] "대구중구"
# 중개 중심성
# 노드 사이에 위치한 정도 (노드의 중요성)
# 최단 경로로 끼이게 되는 경우의 수로 산출
max(betweenness(g.abs))
## [1] 1265
# 아이젠벡터 중심성
# 자신과 연결된 노드의 중요도
eigen_centrality(ggg)
# Diameter
get.diameter(g.abs)
## + 2/141 vertices, named, from 0024510:
## [1] 덕양구 부산남구
# 추이성
# 친구의 친구가 내 친구인 비율
transitivity(gg)
## [1] 0.8651398
# 상호 호혜성
reciprocity(ggg)
## [1] 0
dyad_census(ggg) # 한쪽으로 가는관계, edge가 없는 node쌍
## $mut
## [1] 0
##
## $asym
## [1] 4889
##
## $null
## [1] 4981
# 네트워크 밀도
edge_density(ggg, loops = F) # 연결선수/가능한 연결선수
## [1] 0.2476697
# 다른 노드로 정보를 전달할 때, 가장 효율적인 노드
which.min(apply(d, 1, sum))
## [1] 531
# 다른 노드로부터 모든 정보를 수집할 때, 가장 효율적인 노드
which.min(apply(d, 2, sum))
## integer(0)
# Degree 평균
mean(degree(ggg))
## [1] 69.34752
# Vertex 수
length(V(ggg))
## [1] 141
# Edge 수
length(E(ggg))
## [1] 4889
4. Conclusion
# 결론
## Degree Centrality
# 디그리 중심성이 가장 높은 지역은 대구광역시 중구이다. 수도권과 떨어져 있지만 대구광역시가 대표적인 부동산 투기 지역으로 인식된 적이 있어 높은 중심성을 보이는 것 같다 [대구지역은 지방보다는 수도권과 가격이 비슷한 모습(대구 수성구와 남구도 그렇다)]
## Closeness Centrality
# 근접 중심성이 가장 높은 지역은 안산시 단원구이다. 안산시 지역이 대부분 네트워크 그래프에서 수도권과 멀리 떨어져있는 모습을 볼 수 있는데, 안산 지역이 다른 수도권 지역에 비해 아파트 가격이 낮은 편이라 수도권과 지방 중간에 위치하는 모습을 보이는 것 같다.
## Betweenness Centrality
# 매개 중심성이 가장 높은 지역은 안산시 상록구이다. 상록구가 부동산 시장의 가격변동 흐름에 통제 능력을 갖고 있고 부동산 가격 정보를 많이 가지고 있다고 판단 할 수 있다.
## Eigenvector Centrality
# 아이겐벡터 중심성이 가장 높은 지역은 서울특별시 노원구이다. 노원구가 전국 아파트 가격흐름을 파악하는데 중요한 역할을 한다고 볼 수 있다.
## 추이성 - 86.8%로 나타났다.
### 아파트 부동산 시장의 흐름을 파악해보고 싶을 때, 종로구의 부동산 시장 흐름을 잘 파악해 보면 될것같다. 또한, 이 분석을 통해서 대구 지역의 부동산 가격을 파악할 수 있었고, 안산의 상록구와 단원구는 수도권 부동산 시장에서 떨어져 나와있는 것을 알 수 있었다. 마지막으로, 대부분 수도권은 수도권끼리 지방은 지방끼리 부동산 시장을 형성하는 것 같다.