[재능상품] 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개발 - 응용프로그래밍] 통계 분석, 데이터 분석, 시각화를 성실하게 해 드립니다. - 재능마켓 �

판매가격:10,000원, [소개] - 데이터산업진흥원 데이터 가공 공급기업 선정 - 정보통신산업 진흥원 데이터 가공 공급기업 선정 - 다년간 축적된 경험 노하우를 바탕으로 개개인에게 맞춤형 솔루션�

www.otwojob.com

[재능플랫폼] 크몽

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

0개 총 작업 개수 완료한 총 평점 0점인 shlee1990의 IT·프로그래밍, 데이터분석·리포트, 데이터 마이닝·크롤링 서비스를 0개의 리뷰와 함께 확인해 보세요. IT·프로그래밍, 데이터분석·리포트, 데

kmong.com

요청

[세부 사항]

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

저작자표시 비영리 변경금지 (새창열림)

'자기계발 > 재능상품' 카테고리의 다른 글

[재능상품] R을 통한 지니계수 계산 및 시각화 (0)	2020.12.06
[재능상품] 파이썬으로 인스타그램 헤시태그 검색 기반 크롤링 프로그램 (0)	2020.12.05
[재능상품] 특정 지점의 위치 좌표가 주어졌을 때 해당 좌표의 고도 구하기 (0)	2020.12.05
[재능상품] Python을 이용한 웹 크롤링 및 워드 클라우드 시각화 (0)	2020.12.02
[재능상품] 리눅스 쉘 스크립트를 이용한 사용자 요구사항 (0)	2020.12.01

정보

내용