[재능상품] R을 통한 The Locus for Focus 모형을 이용한 설문조사 결과 시각화 및 워드 클라우드 생성

 정보

• 업무명     : R을 통한 The Locus for Focus 모형을 이용한 설문조사 결과 시각화 및 워드 클라우드 생성

• 작성자     : 박진만

• 작성일     : 2020-12-06

• 설   명      :

• 수정이력 :

 

 내용

[개요]

• 안녕하세요? 웹 개발 및 연구 개발을 담당하고 있는 해솔입니다.

• 다년간 축적된 경험 (기상학 학술 보고서 및 국/영문 학술 논문 게재, 블로그 운영, IT 회사 웹 개발 담당) 및 노하우를 바탕으로 개개인에게 맞춤형 솔루션을 수행할 수 있습니다.

• 특히 재능 플랫폼 (크몽, 오투잡, 해피캠퍼스, 레포트 월드)에서 누구보다도 경쟁력 있는 가격으로 양질의 서비스를 제공하고 있습니다.

  • 아스키 형식의 텍스트 (text) 파일부터 과학자료 형식 (HDF, H5, NetCDF, Grib, Grb) 및 Data Base (DB) 자료까지 다양한 형태의 자료를 이용하여 수집, 전처리, 분석, 시각화해 드립니다.

  • 또한 웹 사이트에 대한 정보를 이용한 웹 크롤링 및 그에 따른 엑셀 및 DB 구축도 가능합니다.

  • 아울러 기초 통계 (빈도분포, Prired t-test, Wilcoxn 등)에서 지도/비지도 학습을 통한 회귀모형 구축에 이르기 까지 효율적인 통계 정보를 제공합니다.

  • 최근 대한민국의 후속위성인 천리안위성 2A호 웹 서비스 서브시스템 및 환경위성 2B호 통합 자료처리 서브시스템에 대한 웹 개발을 수행하였습니다.

• 그리고 해솔 블로그에서는 다양한 기상학/천문학 정보와 더불어 사무 자동화/프로그래밍 언어를 소개하오니 방문 부탁드립니다.
  

• 좋은 하루 보내세요.

 

[재능플랫폼] 오투잡

[IT개발 - 응용프로그래밍] 통계 분석, 데이터 분석, 시각화를 성실하게 해 드립니다. - 재능마켓 �

 

[재능플랫폼] 크몽

데이터수집, 파싱, 크롤링 해 드립니다. | 50,000원부터 시작 가능한 총 평점 0점의 IT·프로그래밍,

 

 요청

[세부 사항]

• R 스크립트를 설문조사 데이터 분석

• 설문조사 문항은 선택지 문항과 서술 문항으로 나누어져 있으며 이를 각각 분석

• 선택지 문항의 경우 Locus for Focus 방법으로 분석하고 시각화 수행

• 서술 문항의 경우 wordcloud 방법으로 시각화 수행

 

 완료

[사용 OS]

• Windows 10

 

[사용 언어]

• R v4.0.3

 

[명세]

• 입력자료 상세

• 설문지 문항 데이터 일부

 

• 서술 문항 데이터 일부

 

• Locus for Focus 분석 및 시각화 코드

library(ggplot2)
library(dplyr)
library(data.table)
library(stringr)
library(xlsx)
library(tidyr)

data <- read.xlsx("./INPUT/교사데이터(마감)-+locus+for+focus용.xlsx",
                  sheetIndex = 1,encoding = "UTF-8")
    
dim(data)
colnames(data)[1:18] <- paste0("importance",seq(1,18,1))
colnames(data)[19:36] <- paste0("satisfaction",seq(1,18,1))


data_L1 <- data %>%
  dplyr::select(importance1:satisfaction18) 


#data_L1 <- na.omit(data_L1)



# 변화도 계산
data_L1[paste0("gradient",1:18)] = data_L1[paste0("importance",1:18)] - data_L1[paste0("satisfaction",1:18)] 

# 평균 중요도(전체)
total_mean_importance <- data_L1 %>% select(importance1:importance18) %>% summarise_all(mean,na.rm = T) 
total_mean_importance <- mean(as.matrix(total_mean_importance[,]), na.rm=T)

# 평균 변화도 (전체)
total_mean_gradient <- data_L1 %>% select(gradient1:gradient18) %>% summarise_all(mean,na.rm = T) 
total_mean_gradient <- mean(as.matrix(total_mean_gradient[,]), na.rm=T)

# 컬럼 평균 (중요도)
data_L2_importance <- data_L1 %>%
  dplyr::select(importance1:importance18) %>%
  dplyr::summarise_all(mean,na.rm = T)
  # tidyr::gather(key = "flower_att", value = "measurement",
  #        Sepal.Length, Sepal.Width, Petal.Length, Petal.Width)

# 컬럼 평균 (변화도)
data_L2_gradient <- data_L1 %>%
  dplyr::select(gradient1:gradient18) %>%
  dplyr::summarise_all(mean,na.rm = T)

## 가공1 ## 
data_L2_importance_L1 <- as.data.frame(t(data_L2_importance))
rownames_imp <- rownames(data_L2_importance_L1)
data_L2_importance_L1 <- cbind(data_L2_importance_L1,rownames_imp)
colnames(data_L2_importance_L1) <- c("Importance","row_import")
## 가공1 ## 

## 가공2 ## 
data_L2_gradient_L1 <- as.data.frame(t(data_L2_gradient))
rownames_grad <- rownames(data_L2_gradient_L1)
data_L2_gradient_L1 <- cbind(data_L2_gradient_L1,rownames_grad)
colnames(data_L2_gradient_L1) <- c("Gradient","row_grad")
## 가공2 ## 


## 최종 ##
result_set <- cbind(data_L2_importance_L1,data_L2_gradient_L1) %>%
  dplyr::mutate(data_label = paste0(seq(1:18)))

result_set_write <- result_set %>%
  dplyr::select(Importance,Gradient,data_label)

write.csv(result_set_write,"./교사_설문조사_문항별_결과.csv",row.names = FALSE)

## ggplot ##
ggplot() +
  theme_bw() +
  theme(plot.title=element_text(face="bold", size=20, color="black")) +
  theme(axis.title.x = element_text(face="bold", size=15, colour="black")) +
  theme(axis.title.y = element_text(face="bold", size=15, colour="black", angle=0, vjust = 0.5)) +
  theme(axis.text.x = element_text(face="bold", size=15, colour="black")) +
  theme(axis.text.y = element_text(face="bold", size=15, colour="black")) +
  #labs(title = paste0("Locus For Focus Result (교사)")) +
  labs(title = paste0("")) +
  #geom_point(data=result_set, aes(x=val_import,y=val_grad),color = "black",size = 8) +
  #annotate("text", x = result_set$val_import, y = result_set$val_grad, label = "Some text") +
  geom_text(data = result_set, aes(x = Importance, y = Gradient, label = data_label)) +
  geom_hline(yintercept=total_mean_gradient,size = 1.5, linetype='dashed') +
  geom_vline(xintercept=total_mean_importance,size = 1.5, linetype='dashed') +
  xlim(total_mean_importance-0.8,total_mean_importance+0.8) +
  ylim(total_mean_gradient-0.8,total_mean_gradient+0.8) +
  xlab(paste0("중요도 평균값 \n", "(M=",round(total_mean_importance,2),")")) + 
  ylab(paste0("중요도-만족도\n 차의 평균값 \n", "(M=",round(total_mean_gradient,2),")")) + 
  ggsave("./result_교사.png",width = 9.35,height = 6.79)
  #labs(title = paste0("WRF 300m ",daychr," night(04-05) mean WDIR and WS" ) ) +


  

 

• 결과 이미지

 

• 워드클라우드 시각화 코드

#전처리 프로그램은 패키지 설치 및 소스코드 실행에 문제가 없지만
#R 프로그램으로부터 한글 형태소를 분석하는 KoNLP 패키지는 2020년 1월 15일부터 
#CRAN 으로부터의 지원이 중단되어 기존의 install.package() 명령어로는 더이상 설치하실 수 없습니다.

#따라서 해당 패키지를 설치하기 위해서는 아래의 코드를 한줄씩 실행해 주시길 바랍니다 (주석 제거 후).
#install.packages("devtools")
library(devtools)
# install.packages("remotes")
# remotes::install_github('haven-jeon/KoNLP', upgrade = "never", INSTALL_opts=c("--no-multiarch"))
# devtools::install_github("lchiffon/wordcloud2")
library(KoNLP)
# 에러가 없다면 패키지 설치가 성공 한 것입니다.!

#install.packages("htmltools")
## 기타 라이브러리 로드 ##
library(ggplot2)
library(dplyr)
library(data.table)
library(stringr)
library(wordcloud2)
library(tidyr)
library(tm)
library(webshot)
# install.packages("munsell")
library(htmlwidgets)
library(devtools)

# 불용어 로드 작업 (은,는,것 등의 무의미한 단어 목록.) #
stopword <- read.table("./불용어사전.txt")
colnames(stopword) <- "stopword"
# 불용어 로드 작업 (은,는,것 등의 무의미한 단어 목록.) #

## 명사 추출 함수 로드 (시작) ##
sub_extractNoun <- function(santence = santence, stopword = stopword) {
  
  text <- extractNoun(santence)
  
  text <- gsub('[0-9a-zA-Z~!@#$%^&*()_+=?ㅜㅠㄱ-ㅎㅏ-ㅣ.<>‘’]','',text)
  
  for (i in stopword) {
    text <- str_replace_all(string = text,pattern = paste0(i,"$"),"")
  }
  
  return(text)
  
}


data <- fread("./INPUT/교사의+온라인한국어수업+경험+후+느낀+문제점+자유서술형응답(77명).txt",stringsAsFactors = F,sep = "\t",encoding = "UTF-8", header = FALSE)
data_len <- dim(data)[1]
colnames(data)

data_L1 <- data

data_len <- dim(data_L1)[1]

# 결과를 담을 변수 생성 #
word_text<- c()

# 명사 추출 수행
for (i in 1:data_len) {
  
  text <- sub_extractNoun(santence = data_L1$V1[i],stopword = stopword$stopword)
  word_text <- append(word_text,text)
  
}

# STEP 1에 대한 데이터프레임 생성
DF <- data.frame(word = word_text,stringsAsFactors = F)

# 명사 빈도분석 결과 (STEP1) #
DF_RESULT <- DF %>%
  dplyr::filter(nchar(word) >= 2) %>%
  dplyr::group_by(word) %>%
  dplyr::summarise(freq = n()) %>%
  dplyr::arrange(desc(freq)) %>%
  dplyr::ungroup() 

write.csv(DF_RESULT,"./result_ALL.csv",row.names = F)


DF_RESULT <- read.xlsx("./INPUT/제외통합1차+-+복사본.xlsx",
                  sheetIndex = 1,encoding = "UTF-8")

DF_RESULT <- DF_RESULT %>%
  dplyr::select(word,freq) %>%
  dplyr::arrange(desc(freq)) %>%
  dplyr::slice(1:135)



# 플롯 #
hw = wordcloud2(data = DF_RESULT,
                fontFamily='나눔바른고딕',
                minSize = 2,
                gridSize = 10, size = 1)



# 이미지화 이후 저장 #
saveWidget(hw,"2.html",selfcontained = F)
webshot::webshot("2.html","./WORDCLOUD_RESULT2.png",vwidth = 775, vheight = 550, delay = 10,zoom = 2)

 

 

[전체 소스 코드]

library(ggplot2)
library(dplyr)
library(data.table)
library(stringr)
library(xlsx)
library(tidyr)

data <- read.xlsx("./INPUT/교사데이터(마감)-+locus+for+focus용.xlsx",
                  sheetIndex = 1,encoding = "UTF-8")
    
dim(data)
colnames(data)[1:18] <- paste0("importance",seq(1,18,1))
colnames(data)[19:36] <- paste0("satisfaction",seq(1,18,1))


data_L1 <- data %>%
  dplyr::select(importance1:satisfaction18) 


#data_L1 <- na.omit(data_L1)



# 변화도 계산
data_L1[paste0("gradient",1:18)] = data_L1[paste0("importance",1:18)] - data_L1[paste0("satisfaction",1:18)] 

# 평균 중요도(전체)
total_mean_importance <- data_L1 %>% select(importance1:importance18) %>% summarise_all(mean,na.rm = T) 
total_mean_importance <- mean(as.matrix(total_mean_importance[,]), na.rm=T)

# 평균 변화도 (전체)
total_mean_gradient <- data_L1 %>% select(gradient1:gradient18) %>% summarise_all(mean,na.rm = T) 
total_mean_gradient <- mean(as.matrix(total_mean_gradient[,]), na.rm=T)

# 컬럼 평균 (중요도)
data_L2_importance <- data_L1 %>%
  dplyr::select(importance1:importance18) %>%
  dplyr::summarise_all(mean,na.rm = T)
  # tidyr::gather(key = "flower_att", value = "measurement",
  #        Sepal.Length, Sepal.Width, Petal.Length, Petal.Width)

# 컬럼 평균 (변화도)
data_L2_gradient <- data_L1 %>%
  dplyr::select(gradient1:gradient18) %>%
  dplyr::summarise_all(mean,na.rm = T)

## 가공1 ## 
data_L2_importance_L1 <- as.data.frame(t(data_L2_importance))
rownames_imp <- rownames(data_L2_importance_L1)
data_L2_importance_L1 <- cbind(data_L2_importance_L1,rownames_imp)
colnames(data_L2_importance_L1) <- c("Importance","row_import")
## 가공1 ## 

## 가공2 ## 
data_L2_gradient_L1 <- as.data.frame(t(data_L2_gradient))
rownames_grad <- rownames(data_L2_gradient_L1)
data_L2_gradient_L1 <- cbind(data_L2_gradient_L1,rownames_grad)
colnames(data_L2_gradient_L1) <- c("Gradient","row_grad")
## 가공2 ## 


## 최종 ##
result_set <- cbind(data_L2_importance_L1,data_L2_gradient_L1) %>%
  dplyr::mutate(data_label = paste0(seq(1:18)))

result_set_write <- result_set %>%
  dplyr::select(Importance,Gradient,data_label)

write.csv(result_set_write,"./교사_설문조사_문항별_결과.csv",row.names = FALSE)

## ggplot ##
ggplot() +
  theme_bw() +
  theme(plot.title=element_text(face="bold", size=20, color="black")) +
  theme(axis.title.x = element_text(face="bold", size=15, colour="black")) +
  theme(axis.title.y = element_text(face="bold", size=15, colour="black", angle=0, vjust = 0.5)) +
  theme(axis.text.x = element_text(face="bold", size=15, colour="black")) +
  theme(axis.text.y = element_text(face="bold", size=15, colour="black")) +
  #labs(title = paste0("Locus For Focus Result (교사)")) +
  labs(title = paste0("")) +
  #geom_point(data=result_set, aes(x=val_import,y=val_grad),color = "black",size = 8) +
  #annotate("text", x = result_set$val_import, y = result_set$val_grad, label = "Some text") +
  geom_text(data = result_set, aes(x = Importance, y = Gradient, label = data_label)) +
  geom_hline(yintercept=total_mean_gradient,size = 1.5, linetype='dashed') +
  geom_vline(xintercept=total_mean_importance,size = 1.5, linetype='dashed') +
  xlim(total_mean_importance-0.8,total_mean_importance+0.8) +
  ylim(total_mean_gradient-0.8,total_mean_gradient+0.8) +
  xlab(paste0("중요도 평균값 \n", "(M=",round(total_mean_importance,2),")")) + 
  ylab(paste0("중요도-만족도\n 차의 평균값 \n", "(M=",round(total_mean_gradient,2),")")) + 
  ggsave("./result_교사.png",width = 9.35,height = 6.79)
  #labs(title = paste0("WRF 300m ",daychr," night(04-05) mean WDIR and WS" ) ) +


 #===========================================================================================================
 
 #전처리 프로그램은 패키지 설치 및 소스코드 실행에 문제가 없지만
#R 프로그램으로부터 한글 형태소를 분석하는 KoNLP 패키지는 2020년 1월 15일부터 
#CRAN 으로부터의 지원이 중단되어 기존의 install.package() 명령어로는 더이상 설치하실 수 없습니다.

#따라서 해당 패키지를 설치하기 위해서는 아래의 코드를 한줄씩 실행해 주시길 바랍니다 (주석 제거 후).
#install.packages("devtools")
library(devtools)
# install.packages("remotes")
# remotes::install_github('haven-jeon/KoNLP', upgrade = "never", INSTALL_opts=c("--no-multiarch"))
# devtools::install_github("lchiffon/wordcloud2")
library(KoNLP)
# 에러가 없다면 패키지 설치가 성공 한 것입니다.!

#install.packages("htmltools")
## 기타 라이브러리 로드 ##
library(ggplot2)
library(dplyr)
library(data.table)
library(stringr)
library(wordcloud2)
library(tidyr)
library(tm)
library(webshot)
# install.packages("munsell")
library(htmlwidgets)
library(devtools)

# 불용어 로드 작업 (은,는,것 등의 무의미한 단어 목록.) #
stopword <- read.table("./불용어사전.txt")
colnames(stopword) <- "stopword"
# 불용어 로드 작업 (은,는,것 등의 무의미한 단어 목록.) #

## 명사 추출 함수 로드 (시작) ##
sub_extractNoun <- function(santence = santence, stopword = stopword) {
  
  text <- extractNoun(santence)
  
  text <- gsub('[0-9a-zA-Z~!@#$%^&*()_+=?ㅜㅠㄱ-ㅎㅏ-ㅣ.<>‘’]','',text)
  
  for (i in stopword) {
    text <- str_replace_all(string = text,pattern = paste0(i,"$"),"")
  }
  
  return(text)
  
}


data <- fread("./INPUT/교사의+온라인한국어수업+경험+후+느낀+문제점+자유서술형응답(77명).txt",stringsAsFactors = F,sep = "\t",encoding = "UTF-8", header = FALSE)
data_len <- dim(data)[1]
colnames(data)

data_L1 <- data

data_len <- dim(data_L1)[1]

# 결과를 담을 변수 생성 #
word_text<- c()

# 명사 추출 수행
for (i in 1:data_len) {
  
  text <- sub_extractNoun(santence = data_L1$V1[i],stopword = stopword$stopword)
  word_text <- append(word_text,text)
  
}

# STEP 1에 대한 데이터프레임 생성
DF <- data.frame(word = word_text,stringsAsFactors = F)

# 명사 빈도분석 결과 (STEP1) #
DF_RESULT <- DF %>%
  dplyr::filter(nchar(word) >= 2) %>%
  dplyr::group_by(word) %>%
  dplyr::summarise(freq = n()) %>%
  dplyr::arrange(desc(freq)) %>%
  dplyr::ungroup() 

write.csv(DF_RESULT,"./result_ALL.csv",row.names = F)


DF_RESULT <- read.xlsx("./INPUT/제외통합1차+-+복사본.xlsx",
                  sheetIndex = 1,encoding = "UTF-8")

DF_RESULT <- DF_RESULT %>%
  dplyr::select(word,freq) %>%
  dplyr::arrange(desc(freq)) %>%
  dplyr::slice(1:135)



# 플롯 #
hw = wordcloud2(data = DF_RESULT,
                fontFamily='나눔바른고딕',
                minSize = 2,
                gridSize = 10, size = 1)



# 이미지화 이후 저장 #
saveWidget(hw,"2.html",selfcontained = F)
webshot::webshot("2.html","./WORDCLOUD_RESULT2.png",vwidth = 775, vheight = 550, delay = 10,zoom = 2)

 

[결과물]

 

 

 참고 문헌

[논문]

• 없음

[보고서]

• 없음

[URL]

• 없음

 

 문의사항

[기상학/프로그래밍 언어]

• sangho.lee.1990@gmail.com

[해양학/천문학/빅데이터]

• saimang0804@gmail.com