반응형

카이스트 명강 시리즈 중 하나. 카이스트 정하웅 교수님의 책. 예전에 한 번 읽긴 하였는데 최근 데이터 분석 공부를 하면서 신경망 그리고 텍스트마이닝의 네트워크 분석의 매력에 크게 빠져 있는 상태라 그런지 이 책을 다시 읽어보니 너무 재미있었다. 


우연히 티비를 틀었을 때 EBS의 <과학다큐 비욘드>에서 네트워크 과학을 소개하는 프로를 본적이 있었다. 물리학자 윤혜진 교수님이 진행이었는데, 이 책에는 카이스트 박사과정 윤혜진 학생으로 소개되어 다소 색다르기도 하였다. EBS 과학다큐 비욘드 내용을 잠시 소개하자면 아래와 같다.


우리를 바라보는 새로운 시선네트워크 사이언스

 

세상 만물을 물리로 풀어내는 과학자들이 나타났다도시가 어떤 모습으로 성장을 하는지부자들의 특징이 무엇인지를 과학으로 풀어내는 물리학자들이들은 어떤 시선으로 세상에 관심을 가지고 질문을 던지는 걸까이들이 바라보는 세상은 어떤 구조로 되어 있을까?

 

물리학자 윤혜진은 1870년대 이후 새로운 아이디어로 나온 특허는 드물다는 사실을 알아냈다기존의 아이디어가 조합되어 나온 조합특허가 대부분이라는 것이다세상을 바꾸는 혁신은 완전히 새로운 아이디어로 만들어지는 게 아니라는 거다.

 

세계 최대 복잡계 연구소인 산타페 연구소의 제프리 웨스트 교수는 도시가 ‘15%의 법칙으로 움직인다는 것을 밝혀냈다도시가 두 배 성장할 때 어떤 것은 15% 더 성장하고어떤 것은 15% 덜 성장한다는 것이다세계의 어떤 도시라도 예외는 없다.

 

하버드대 인터넷과 사회를 위한 버크만 클라인 센터’ 요하이 벵클러 교수는 지난해 미국 대선 보도를 받아들이는 이용자들의 이용패턴을 네트워크 지도로 그렸다미국 대선을 강타했던 가짜뉴스’ 논란이 가짜뉴스 그 자체가 아니라 이용자들에게 달린 문제라는 것을 분석해냈다.

 

이들의 공통점은 모두 네트워크를 통해 세상을 바라본다는 것갈수록 복잡해지는 세상에서 네트워크 사이언스는 나무가 아닌 숲을 볼 수 있게 하는 길잡이가 되어 준다초연결사회연결을 거부할 수 없다면 내가 어디에어떻게 연결되어 있는지를 아는 것만으로도 나의 역할이 무엇인지내가 누구인지를 알 수 있다.

 

이외에도 네트워크를 통해 알아보는 부자의 특성가짜뉴스의 특징과 판별법 등 일상에 영향을 끼치는 과학에 대한 새로운 정보와 지식은 앞으로 살아갈 세상에서 우리가 나아가야할 방향을 제시해줄 것이다.

 


지금은 유튜브에서 너무 손쉽게 찾을 수 있어, 유튜브 링크도 찾아보았다.



복잡계 네트워크를 가장 쉽게 표현하는 것은 바로 고속도로와 항공망. 고속도로의 경우 한 도시마다 일반적으로 3-4개의 도로가 연결된 반면, 항공 네트워크의 경우 뉴욕, 시카고, LA의 경우 무수히 많은 항공망이 연결되어 있다. 


이를 다시 그래프로 표현하면 멱함수 분포 곡선으로 표현할 수 있는데, x축의 우측으로 가면 갈 수록 연결 횟수가 많은 소수의 점을 나타낸다. 이를 이용한 수많은 자연/사회 현상을 재미있게 소개한다. 


 - 국회의원 네트워크: 구글 검색을 통해 얻은 검색 결과를 바탕으로 허브 조사


의 그래프는 시각화도 잘 되어 있어 한참을 쳐다 보았다.


문득 드는 아이디어로는 화장품도 요즘은 멀티 브랜드, 멀티 채널인데 소비자가 2개 이상의 브랜드를 함께 쓴다고 가정하였을 때, 허브 브랜드가 존재할 것 같았다. 더 나아가 허브 제품도 있을 것이고. 허브 제품 구매자와 비구매자 간 비교 분석을 하거나, 허브 제품 비구매자에게 허브 제품 구매 유도하는 CRM을 하였을 때 어떤 반응을 보인지 분석하는 것도 의미 있어 보인다. 


이 책덕분에 복잡계 네트워크에 크게 관심을 가지게 되었다. 내가 만약 대학원을 가 석사 공부를 하게 된다면 이것을 전공으로 하고 싶을 정도로 말이다.


 - 책 링크: 구글 신은 모든 것을 알고 있다

 - 정하웅 교수님 홈페이지 링크 : http://stat.kaist.ac.kr/

 - 윤혜진 교수님(노스웨스턴대 경영학교 교수님) 홈페이지: http://hyoun.me/

 

참고문헌

- 알버트 라즐로 바라바시, "링크", 2002년

- 마크 뷰캐넌, "넥서스" , 2003년

- 던컨 와츠, "스몰월드", 2004년

- 마크 뷰캐넌, "세상은 생각보다 단순하다", 2004년

- 강병남, "복잡계 네트워크 과학: 21세기의 정보과학", 2010년

- 알버트 라즐로 바라바시, "버스트: 인간의 행동 속에 숨겨진 법칙", 2010년


일반독자의 경우 링크나 넥서스, 과학 분야는 링크, 인문 사회 과학분야는 스몰월드, 대학 수준의 교재는 복잡계 네트워크 과학



<몇가지 용어들 정리>

1. 복잡계 네트워크: 점(vertex, node)과 연결선(edge, link)들로 이루어진 집합을 의미한다. 특히 연결선들이 들어오고 나오는 방향이 있는 경우 방향성 네트워크라고 하고, 각 연결선들에 가중치가 부여된 경우 가중치 네트워크라고 한다. '네트워크 이론'은 응용수학과 물리학 분야에서 다루는 이론으로, 수학의 그래프 이론에서 비롯하였다. 현재 전산학생물학경제학사회학 분야에 널리 적용된다 (출처: 위키피디아)

2. CSSPL : Complex Systems and Statistical Physics Lab 복잡계와 통계 물리학 연구실





반응형

'서평' 카테고리의 다른 글

세계 최고의 MBA는 무엇을 가르치는가  (0) 2017.08.28
유라시아견문-제1권: 몽골 로드에서 할랄 스트리트까지  (0) 2017.08.07
불황을 넘어서  (0) 2014.07.13
월급전쟁  (0) 2014.07.13
탐스 스토리  (0) 2014.07.13
Posted by 마르띤
,
반응형



#데이터 불러오기

getwd()[1] "C:/Users/amore/Documents/FOR ME/Data Scientist/Udacity/Data Analysis with R/eda-course-materials/lesson3"
list.files()
[1] "lesson3.Rmd"         "lesson3_student.rmd" "pseudo_facebook.tsv"
pf <- read.csv('pseudo_facebook.tsv', sep='\t')
names(pf)
 [1] "userid"                "age"                   "dob_day"              
 [4] "dob_year"              "dob_month"             "gender"               
 [7] "tenure"                "friend_count"          "friendships_initiated"
[10] "likes"                 "likes_received"        "mobile_likes"         
[13] "mobile_likes_received" "www_likes"             "www_likes_received"   





#Histogram of User's Birthdays

library(ggplot2)qplot(x=dob_day, data = pf) 

Here's some things that I noticed. On the first day of the month I see this huge bin of almost 8,000 people. This seems really unusual since I would expect most people to have the same number of birthday's across every day of the month.  



library(ggplot2)qplot(x=dob_day, data = pf) + 
  scale_x_continuous(breaks=1:31)





#Faceting

library(ggplot2)qplot(x=dob_day, data = pf) + 
  scale_x_continuous(breaks=1:31)+
  facet_wrap(~dob_month, ncol=4) 

Now, you may have noticed some peaks in May or perhaps in October, but I think what's really interesting is this huge spike on January first. There's almost 4,000 users in this bin. Now, this could be because of the default settings that Facebook uses or perhaps users are choosing the first choice in the drop down menus. Another idea is that some users may want to protect their privacy and so they just go with January first by default. Whatever the case may be, I think it's important that we make our considerations in the context of our data. We want to look out for these types of anomalies. 



#Friend Count

ggplot(aes(x = friend_count),data = pf) +
   geom_histogram()






#Limiting the Axes

qplot(x = friend_count, data = pf, xlim = c(0,1000))



## alternative solution

qplot(x = friend_count, data = pf) + scale_x_continuous(limits = c(0,1000))




#adjust the bin width

 qplot(x = friend_count, data = pf) + 
   scale_x_continuous(limits = c(0,1000), breaks = seq(0,1000,50))


## alternative solution

qplot(x = friend_count, data = pf) + scale_x_continuous(limits = c(0,1000))



##splits up the data by gender 

qplot(x = friend_count, data = pf) + 
  scale_x_continuous(limits = c(0,1000), breaks = seq(0,1000,50)) + 
  facet_grid(gender~.)





#Omitting NA Obervations qplot(x = friend_count, data = subset(pf, !is.na(gender)), binwidth = 10) + scale_x_continuous(limits = c(0,1000), breaks = seq(0,1000,50)) + facet_grid(gender~.)

#equivalent ggplot syntax: ggplot(aes(x = friend_count), data = pf) + geom_histogram() + scale_x_continuous(limits = c(0, 1000), breaks = seq(0, 1000, 50)) + facet_wrap(~gender)



ggplot(aes(x = friend_count), data = subset(pf, !is.na(gender))) + geom_histogram() + scale_x_continuous(limits = c(0, 1000), breaks = seq(0, 1000, 50)) + facet_wrap(~gender)



##statistics by gender

> table(pf$gender)female   male 
 40254  58574 
> by(pf$friend_count, pf$gender, summary)
pf$gender: female
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
      0      37      96     242     244    4923 
--------------------------------------------------------------------- 
pf$gender: male
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
      0      27      74     165     182    4917 



### Tenure

qplot(x=tenure, data = pf, binwidth = 30,
      color = I('black'), fill = I('#099DD9'))




#Equivalent ggplot syntax: ggplot(aes(x = tenure), data = pf) + geom_histogram(binwidth = 30, color = 'black', fill = '#099DD9')


## How would you create a histogram of tenure by year?


#create a histogram of tenure measured in years rather than in days






#It looks like the bulk of our users had less than two and a half years on Facebook.qplot(x = tenure / 365, data = pf, binwidth = 0.25, color = I('black'), fill = I('#099DD9')) + scale_x_continuous(breaks = c(1,7,1), limits = c(0,7))
#Equivalent ggplot syntax: ggplot(aes(x = tenure/365), data = pf) + geom_histogram(binwidth = .25, color = 'black', fill = '#F79420')



## Labeling Plots


qplot(x = tenure / 365, data = pf, binwidth = 0.25, 
      xlab = 'Number of years using Facebook',      ylab = 'Number of users in sample',
      color = I('black'), fill = I('#099DD9')) +
  scale_x_continuous(breaks = c(1,7,1), limits = c(0,7))


#Equivalent ggplot syntax: ggplot(aes(x = tenure / 365), data = pf) + geom_histogram(color = 'black', fill = '#F79420') + scale_x_continuous(breaks = seq(1, 7, 1), limits = c(0, 7)) + xlab('Number of years using Facebook') + ylab('Number of users in sample')




## User Ages

> range(pf$age)
[1]  13 113
qplot(x = age, data = pf,binwidth = 5, xlab = 'User ages', ylab = 'Number of users in sample', color = I('black'), fill = I('blue')) + scale_x_continuous(breaks = c(0,113,5),limits= c(13,113))



#Equivalent ggplot syntax: ggplot(aes(x = age), data = pf) + geom_histogram(binwidth = 1, fill = '#5760AB') + scale_x_continuous(breaks = seq(0, 113, 5))





## Transforming Data

> summary(pf$friend_count)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
    0.0    31.0    82.0   196.4   206.0  4923.0 
> summary(log10(pf$friend_count))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   -Inf   1.491   1.914    -Inf   2.314   3.692 
> summary(log10(pf$friend_count + 1))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  0.000   1.505   1.919   1.868   2.316   3.692 
> summary(sqrt(pf$friend_count))
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  0.000   5.568   9.055  11.090  14.350  70.160 
#Learn about how to use scales and how to create multiple plots on one page. You'll also need to install and load the package gridExtra. #Create 1 column thwi the folling thres histograms, friend count / transformed using log 10 and square root.
> library(gridExtra) > p1 <- qplot(x = friend_count, data = pf) > p2 <- qplot(x = log10(friend_count+1), data = pf) > p3 <- qplot(x = sqrt(friend_count), data = pf) > grid.arrange(p1,p2,p3, ncol = 1)
#Equivalent ggplot syntax: we get the same outputs as we had before pp1 <- ggplot(aes(x=friend_count), data = pf) + geom_histogram() pp2 <- pp1 + scale_x_log10() pp3 <- pp1 + scale_x_sqrt() grid.arrange(pp1,pp2,pp3, ncol = 1)




## Add a Scaling Layer


> logScale <- qplot(x = log10(friend_count), data = pf)
> countScale <- ggplot(aes(x = friend_count), data = pf) +
  geom_histogram() +
  scale_x_log10()
> grid.arrange(logScale, countScale, ncol=2)


-> At the two plots, we can see that the difference is really in the x axis labeling.

Using scale_x_log10 will label the axis in actual friend_count. Where as using the

log10 wrapper will label the x axis in the log units. In general it is easier to

think about actual counts, so that's why people prefer using the scale_x_log10 as

a layer.


qplot(x=friend_count, data = pf) + scale_x_log10()





## Frequency Polygons : who has more friends on average men or women?


#This allows us to see the shape and the peaks of our distribution in more detail.qplot(x = friend_count, data = subset(pf, !is.na(gender)),
      binwidth = 10) +
  scale_x_continuous(lim = c(0,1000), breaks = seq(0,1000,50)) +
  facet_wrap(~gender)



qplot(x = friend_count, data = subset(pf, !is.na(gender)), binwidth = 10, geom='freqpoly', color = gender) + scale_x_continuous(lim = c(0,1000), breaks = seq(0,1000,50))




#But again, this plot doesn't really answer our question who has more friends on

average men or women. Let's change the y-axis to show proportions instead of raw

counts.



qplot(x = friend_count, y = ..count.. / sum(..count..), data = subset(pf, !is.na(gender)), xlab = 'Friend Count', ylab = 'Proportion of Users with that firned count', binwidth = 10, geom='freqpoly', color = gender) + scale_x_continuous(lim = c(0,1000), breaks = seq(0,1000,50))







## Likes on the Web

qplot(x=www_likes, data = subset(pf, !is.na(gender)),
      geom = 'freqpoly', color = gender) +
  scale_x_continuous()+
  scale_x_log10()




# what's the www_like count for males?The first question is asking how many www_likes

there are in the entire data set for males.


> by(pf$www_likes, pf$gender, sum)

pf$gender: female [1] 3507665 --------------------------------------------------------------------- pf$gender: male





## Box Plots


qplot(x = gender, y = friend_count,      data = subset(pf, !is.na(gender)),
      geom='boxplot')






## Adjust the code to focus on users who have friend counts between 0 and 1000.

qplot(x = gender, y = friend_count,
      data = subset(pf, !is.na(gender)),
      geom='boxplot',ylim = c(0,1000))





#same way qplot(x = gender, y = friend_count, data = subset(pf, !is.na(gender)), geom = 'boxplot') + scale_y_continuous(limits=c(0,1000))





-> Notice how the top of the box is just below 250, so it might be around 230. But this value might not be accurate for all of our data. use the ylim parameter or the scale_y_continious layer, we actually remove data points from calculations.

# So a better way to do this is tu use the cord Cartesian layer to set the y limits instead.qplot(x = gender, y = friend_count, data = subset(pf, !is.na(gender)), geom = 'boxplot') + coord_cartesian(ylim= c(0,1000))




-> Here we will set the y limts from 0 to a 1000, notice how the top of the box has moved slightly closer to 250 for females.




## Box Plots, Quartiles, and Friendships

qplot(x = gender, y = friend_count,
      data = subset(pf, !is.na(gender)),
      geom = 'boxplot') +
  coord_cartesian(ylim = c(0,250))



> by(pf$friend_count, pf$gender, summary) pf$gender: female Min. 1st Qu. Median Mean 3rd Qu. Max. 0 37 96 242 244 4923 ---------------------------------------------------------------------------- pf$gender: male Min. 1st Qu. Median Mean 3rd Qu. Max. 0 27 74 165 182 4917

-> The third quartile of the 75% mark is at 244 and that's all the way up

here(그래프를 보며). This means that 75% of female users have friend count below 244.

Or another way to say this is that 25% of female user have more than 244 friends.



## On average, who initiated more friendships in our sample: men or women?

> names(pf)
 [1] "userid"                "age"                   "dob_day"              
 [4] "dob_year"              "dob_month"             "gender"               
 [7] "tenure"                "friend_count"          "friendships_initiated"
[10] "likes"                 "likes_received"        "mobile_likes"         
[13] "mobile_likes_received" "www_likes"             "www_likes_received"   
qplot(x = gender, y = friendships_initiated, data = subset(pf, !is.na(gender)), geom = 'boxplot') + coord_cartesian(ylim = c(0,150))


> by(pf$friendships_initiated, pf$gender, summary) pf$gender: female Min. 1st Qu. Median Mean 3rd Qu. Max. 0.0 19.0 49.0 113.9 124.8 3654.0 ---------------------------------------------------------------------------- pf$gender: male Min. 1st Qu. Median Mean 3rd Qu. Max. 0.0 15.0 44.0 103.1 111.0 4144.0


-> On average, who initiated more friendships in our sample: men or women?
Women.


## Getting Logical : What percent of check in using mobile?

> head(pf$mobile_likes)
[1] 0 0 0 0 0 0
> summary(pf$mobile_likes)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
    0.0     0.0     4.0   106.1    46.0 25110.0 
> summary(pf$mobile_likes > 0)
   Mode   FALSE    TRUE    NA's 
logical   35056   63947       0 
> mobile_check_in <- NA > pf$mobile_check_in <- ifelse(pf$mobile_likes>0, 1, 0) > pf$mobile_check_in <- factor(pf$mobile_check_in) > summary(pf$mobile_check_in) 0 1 35056 63947 > sum(pf$mobile_check_in == 1) / length(pf$mobile_check_in) [1] 0.6459097
#what percent of check in using mobile? 65%




#reference

1. https://cn.udacity.com/course/data-analysis-with-r--ud651

2. http://www.cookbook-r.com/Graphs/Facets_(ggplot2)

3. https://en.wikipedia.org/wiki/Web_colors

4. http://ggplot2.tidyverse.org/reference/theme.html

5. http://lightonphiri.org/blog/ggplot2-multiple-plots-in-one-graph-using-gridextra

6. http://ggplot2.tidyverse.org/reference/scale_continuous.html

7. https://en.wikipedia.org/wiki/Linear_regression#Assumptions

8. https://en.wikipedia.org/wiki/Normal_distribution

9. https://www.r-statistics.com/2013/05/log-transformations-for-skewed-and-wide-distributions-from-practical-data-science-with-r/


반응형

'Python, R 분석과 프로그래밍 > Data Analysis with R' 카테고리의 다른 글

Lesson2: R Basic  (0) 2017.07.11
Posted by 마르띤
,
반응형


# 원하는 데이터만 발라서 보기

> data(mtcars)

> mean(mtcars$mpg)

[1] 20.09062

> subset(mtcars, mtcars$mpg >= 30 | mtcars$hp < 60)

                mpg cyl disp  hp drat    wt  qsec vs am gear carb

Fiat 128       32.4   4 78.7  66 4.08 2.200 19.47  1  1    4    1

Honda Civic    30.4   4 75.7  52 4.93 1.615 18.52  1  1    4    2

Toyota Corolla 33.9   4 71.1  65 4.22 1.835 19.90  1  1    4    1

Lotus Europa   30.4   4 95.1 113 3.77 1.513 16.90  1  1    5    2

> mtcars[mtcars$mpg >= 30 | mtcars$hp < 60, ] #column 전체를 보기 위해서는 콤마 필수

                mpg cyl disp  hp drat    wt  qsec vs am gear carb

Fiat 128       32.4   4 78.7  66 4.08 2.200 19.47  1  1    4    1

Honda Civic    30.4   4 75.7  52 4.93 1.615 18.52  1  1    4    2

Toyota Corolla 33.9   4 71.1  65 4.22 1.835 19.90  1  1    4    1

Lotus Europa   30.4   4 95.1 113 3.77 1.513 16.90  1  1    5    2




#reddit data 보기, 범주형 변수 그래프 그리기

> reddit <- read.csv('reddit.csv')

> library(ggplot2)

> qplot(data = reddit, x = age.range)





#오더 순서 정하기 setting levles of ordered factors solution


> reddit$age.range = ordered(reddit$age.range,levels=c("Under 18","18-24", "25-34","35-44","45-54","55-64","65 or Above"))

> qplot(data = reddit, x = age.range)



#alternative solution

> reddit$age.range = factor(reddit$age.range, levels=c("Under 18","18-24", "25-34","35-44","45-54","55-64","65 or Above"),ordered=T)

> qplot(data = reddit, x = age.range)




# practice

> nlevels(reddit$income.range)

[1] 8

> levels(reddit$income.range)

[1] "$100,000 - $149,999" "$150,000 or more"    "$20,000 - $29,999"   "$30,000 - $39,999"  

[5] "$40,000 - $49,999"   "$50,000 - $69,999"   "$70,000 - $99,999"   "Under $20,000"      

> qplot(data = reddit, x = income.range)



#아래같은 방법도 가능

> reddit$income.range = ordered(reddit$income.range, levels=c("Under $20,000" , "$20,000 - $29,999"   , "$30,000 - $39,999", "$40,000 - $49,999","$50,000 - $69,999" , "$70,000 - $99,999”, ”$100,000 - $149,999" , "$150,000 or more"))

> qplot(data = reddit, x = income.range)




#다른 예제

> tShirts <- factor(c('medium', 'small', 'large', 'medium', 'large', 'large'), levels = c('medium','small','large'))

> tShirts

[1] medium small  large  medium large  large 

Levels: medium small large

> qplot(x = tShirts)



> tShirts <- ordered(tShirts, levels = c('small', 'medium', 'large'))

> tShirts

[1] medium small  large  medium large  large 

Levels: small < medium < large

> qplot(x = tShirts)








참고

https://cn.udacity.com/course/data-analysis-with-r--ud651

https://cn.udacity.com/course/data-wrangling-with-mongodb--ud032

http://vita.had.co.nz/papers/tidy-data.pdf

http://courses.had.co.nz.s3-website-us-east-1.amazonaws.com/12-rice-bdsi/slides/07-tidy-data.pdf

http://www.computerworld.com/article/2497143/business-intelligence/business-intelligence-beginner-s-guide-to-r-introduction.html

http://www.statmethods.net/index.html

https://www.r-bloggers.com/

http://www.cookbook-r.com/

http://blog.revolutionanalytics.com/2013/08/foodborne-chicago.html

http://blog.yhat.com/posts/roc-curves.html

https://github.com/corynissen/foodborne_classifier

반응형
Posted by 마르띤
,