filez <- list.files(pattern="bscore_with*")
file.rename(filez, sub(pattern="bscore_with_package_scorecard", replacement="bscore_vs_pkg_scorecard", filez))
Showing posts with label R. Show all posts
Showing posts with label R. Show all posts
Tuesday, August 21, 2018
Thursday, July 12, 2018
Rcode pdf to text
# Text Mining
eng <- read.table("http://www-01.sil.org/linguistics/wordlists/english/wordlist/wordsEn.txt", stringsAsFactors = FALSE)
library(tidyverse)
library(stringr)
#--------------------------------------------------------------------------------------------------------
# 1. Làm việc với chữ cái trong tiếng anh
#--------------------------------------------------------------------------------------------------------
eng <- eng %>% mutate(n_w = str_count(V1))
theme_set(theme_minimal())
# 1.1. Phân bố số lượng chữ cái trong Tiếng Anh:
eng %>%
group_by(n_w) %>%
count() %>%
ggplot(aes(n_w, n)) + geom_col() +
labs(x = NULL, y = NULL)
# 1.2. Các nguyên âm:
vowels <- c("a", "e", "i", "o", "u")
num_vowels <- vector(mode = "integer", length = 5)
for (j in seq_along(vowels)) {
num_aux = str_count(eng$V1, vowels[j])
num_vowels[j] = sum(num_aux)
}
df1 <- data.frame(N = num_vowels, nguyen_am = vowels)
# 1.3. Tần suất xuất hiện các nguyên âm:
library(hrbrthemes)
df1 %>%
ggplot(aes(reorder(nguyen_am, N), N)) +
geom_col() + labs(x = NULL, y = NULL) + coord_flip() +
scale_y_continuous(breaks = seq(0, 110000, by = 10000)) +
theme_ipsum(grid = "X")
# 1.4. Tần suất xuất hiện của các chữ cái trong tiếng Anh:
u <- strsplit(eng$V1, "")
k <- unlist(u)
let <- eng$V1 %>% strsplit("") %>% unlist()
let <- data.frame(l = let)
let %>% group_by(l) %>% count() %>%
mutate(per = 100*n / nrow(let)) %>%
mutate_if(is.numeric, function(x) round(x, 2)) %>%
ggplot(aes(reorder(l, per), per)) + geom_col() +
coord_flip() +
labs(x = NULL, y = NULL) +
theme_ipsum(grid = "X") +
scale_y_continuous(breaks = seq(1, 12, by = 1))
# Load các gói:
pakg <- c('tm',
'SnowballC',
'wordcloud',
'RColorBrewer')
lapply(pakg, require, character.only = TRUE)
#--------------------------------------------------------------------------------------------------------
# 2. Làm việc với các files pdf
#--------------------------------------------------------------------------------------------------------
# http://data.library.virginia.edu/reading-pdf-files-into-r-for-text-mining/
# 2.1. Đọc các file pdf
setwd("D:/pdftotext/")
files <- list.files(pattern = "pdf$") # lập danh sách file pdf để đọc
Rpdf <- readPDF(control = list(text = "-layout"))
corp2 <- Corpus(URISource(files),
readerControl = list(reader = Rpdf))
# -----------------------------------------------------------------
# So sánh với cách đọc của gói pdftools
library(pdftools)
mk <- lapply(files,pdf_text) # Dùng gói pdftools
corp <- Corpus(VectorSource(mk))
print(corp)
print(corp2)
# -----------------------------------------------------------------
# 2.2. Loại những từ không liên quan
# Bỏ các từ như cengage, learning vì cengage learning là tên của nhà in. Sẽ không hợp lí nếu tính chúng vào phân tích:
corp <- corp %>% tm_map(removeWords, c("cengage", "learning"))
# Xóa tất cả các loại dấu câu như chấm, phẩy
# Sử dụng hàm này tốt hơn so với hàm mặc định
replacePunctuation <- function(x) {
gsub("[[:punct:]]+", " ", x) }
corp <- corp %>% tm_map(replacePunctuation)
# corp <- corp %>% tm_map(removePunctuation) # Do hàm này sẽ không để khoảng trống khi remove .
# Ví dụ:
removePunctuation("hello...world")
#
# Bỏ các Stop Word trong tiếng Anh:
corp <- corp %>% tm_map(removeWords, stopwords("english")) # tùy thuộc stopwords trong từng hàm, số lượng từ bị xóa sẽ khác nhau
# Chuyển hóa tất về chữ in thường:
corp <- corp %>% tm_map(content_transformer(tolower))
# Chuyển động từ về nguyên dạng, không chia, không nên dùng, vì nó bỏ hết cả chữ e cuối từ
corp <- corp %>% tm_map(PlainTextDocument)
corp <- corp %>% tm_map(stemDocument, "english")
# Bỏ các con số:
corp <- corp %>% tm_map(removeNumbers)
# Xóa khoảng trắng
corp <- corp %>% tm_map(stripWhitespace)
# 2.3. Chuyển hóa về Document Matrix: -------------------------------------------------------------
# Nếu có lỗi dùng hàm dưới
# corp <- tm_map(corp, content_transformer(function(x) iconv(enc2utf8(x), sub = "byte")))
tdm <- TermDocumentMatrix(corp)
# Kiểm tra tdm
inspect(tdm[1:10,])
m <- as.matrix(tdm)
v <- sort(rowSums(m), decreasing = TRUE)
d <- data.frame(word = names(v), freq = v)
str(d)
# Chuyển hóa factor về character:
d$word <- as.character(d$word)
# Danh sách của 500 từ xuất hiện nhiều nhất trong
# cuốn sách của Gujarati cùng tần suất tương ứng:
knitr::kable(d %>% slice(1:500))
# 500 từ này chiếm 75.9% tất cả các từ vựng mà tác giả dùng để viết sách:
sum(d$freq[1:500]) / sum(d$freq)
# Trong khi đó 500 từ kế tiếp chỉ chiếm 12.5%
sum(d$freq[1:1000]) / sum(d$freq)
#-----------------------------------------------------
# Dưới đây chúng ta lọc ra hai bộ dữ liệu riêng biệt.
# Bộ thứ nhất là những từ thuộc bộ từ điển tiếng Anh.
# Bộ còn lại không thuộc.
#-----------------------------------------------------
# Bộ thứ nhất chủ yếu là các từ phổ thông:
gu_eng <- d %>% filter(word %in% eng$V1)
# Bộ thứ hai hầu hết là từ chuyên ngành Thống kê - Kinh tế lượng:
gu_non_eng <- dplyr::setdiff(d, gu_eng)
# Tổng số từ vựng sử dụng để viết sách là 9078:
nrow(d)
nrow(gu_eng)
nrow(gu_non_eng)
nrow(gu_non_eng) / nrow(d)
knitr::kable(gu_non_eng %>% filter(freq >= 100))
knitr::kable(head(gu_non_eng, 200))
#--------------------------------------------------------------------------------------------------------
# 3. Vẽ đám mây từ
#--------------------------------------------------------------------------------------------------------
# Cho 100 từ xuất hiện nhiều nhất ở bộ 1:
par(bg = "black")
set.seed(15888)
wordcloud(words = gu_eng$word,
freq = gu_eng$freq,
# Chỉ hiện thị từ nào xuất hiện ít nhất 100 lần:
min.freq = 100,
# Số từ hiển thị trên wordcloud tối đa là 200:
max.words = 200,
# Ngẫu nhiên thứ tự:
random.order = FALSE,
# 35% số từ được hiển thị theo chiều thẳng đứng
rot.per = 0.35,
# Chọn kích cỡ chữ:
font = 2,
# Tô màu cho chữ:
colors = brewer.pal(8, "Dark2"))
# Cho 100 từ xuất hiện ở bộ 2:
set.seed(1409)
wordcloud(words = gu_non_eng$word,
freq = gu_non_eng$freq,
# Chỉ hiện thị từ nào xuất hiện ít nhất 10 lần
min.freq = 10,
# Số từ hiển thị trên wordcloud tối đa là 200:
max.words = 200,
# Ngẫu nhiên thứ tự:
random.order = FALSE,
# 35% số từ được hiển thị theo chiều thẳng đứng
rot.per = 0.35,
# Chọn kích cỡ chữ:
font = 2,
# Tô màu cho chữ:
colors = brewer.pal(8, "Dark2"))
eng <- read.table("http://www-01.sil.org/linguistics/wordlists/english/wordlist/wordsEn.txt", stringsAsFactors = FALSE)
library(tidyverse)
library(stringr)
#--------------------------------------------------------------------------------------------------------
# 1. Làm việc với chữ cái trong tiếng anh
#--------------------------------------------------------------------------------------------------------
eng <- eng %>% mutate(n_w = str_count(V1))
theme_set(theme_minimal())
# 1.1. Phân bố số lượng chữ cái trong Tiếng Anh:
eng %>%
group_by(n_w) %>%
count() %>%
ggplot(aes(n_w, n)) + geom_col() +
labs(x = NULL, y = NULL)
# 1.2. Các nguyên âm:
vowels <- c("a", "e", "i", "o", "u")
num_vowels <- vector(mode = "integer", length = 5)
for (j in seq_along(vowels)) {
num_aux = str_count(eng$V1, vowels[j])
num_vowels[j] = sum(num_aux)
}
df1 <- data.frame(N = num_vowels, nguyen_am = vowels)
# 1.3. Tần suất xuất hiện các nguyên âm:
library(hrbrthemes)
df1 %>%
ggplot(aes(reorder(nguyen_am, N), N)) +
geom_col() + labs(x = NULL, y = NULL) + coord_flip() +
scale_y_continuous(breaks = seq(0, 110000, by = 10000)) +
theme_ipsum(grid = "X")
# 1.4. Tần suất xuất hiện của các chữ cái trong tiếng Anh:
u <- strsplit(eng$V1, "")
k <- unlist(u)
let <- eng$V1 %>% strsplit("") %>% unlist()
let <- data.frame(l = let)
let %>% group_by(l) %>% count() %>%
mutate(per = 100*n / nrow(let)) %>%
mutate_if(is.numeric, function(x) round(x, 2)) %>%
ggplot(aes(reorder(l, per), per)) + geom_col() +
coord_flip() +
labs(x = NULL, y = NULL) +
theme_ipsum(grid = "X") +
scale_y_continuous(breaks = seq(1, 12, by = 1))
# Load các gói:
pakg <- c('tm',
'SnowballC',
'wordcloud',
'RColorBrewer')
lapply(pakg, require, character.only = TRUE)
#--------------------------------------------------------------------------------------------------------
# 2. Làm việc với các files pdf
#--------------------------------------------------------------------------------------------------------
# http://data.library.virginia.edu/reading-pdf-files-into-r-for-text-mining/
# 2.1. Đọc các file pdf
setwd("D:/pdftotext/")
files <- list.files(pattern = "pdf$") # lập danh sách file pdf để đọc
Rpdf <- readPDF(control = list(text = "-layout"))
corp2 <- Corpus(URISource(files),
readerControl = list(reader = Rpdf))
# -----------------------------------------------------------------
# So sánh với cách đọc của gói pdftools
library(pdftools)
mk <- lapply(files,pdf_text) # Dùng gói pdftools
corp <- Corpus(VectorSource(mk))
print(corp)
print(corp2)
# -----------------------------------------------------------------
# 2.2. Loại những từ không liên quan
# Bỏ các từ như cengage, learning vì cengage learning là tên của nhà in. Sẽ không hợp lí nếu tính chúng vào phân tích:
corp <- corp %>% tm_map(removeWords, c("cengage", "learning"))
# Xóa tất cả các loại dấu câu như chấm, phẩy
# Sử dụng hàm này tốt hơn so với hàm mặc định
replacePunctuation <- function(x) {
gsub("[[:punct:]]+", " ", x) }
corp <- corp %>% tm_map(replacePunctuation)
# corp <- corp %>% tm_map(removePunctuation) # Do hàm này sẽ không để khoảng trống khi remove .
# Ví dụ:
removePunctuation("hello...world")
#
# Bỏ các Stop Word trong tiếng Anh:
corp <- corp %>% tm_map(removeWords, stopwords("english")) # tùy thuộc stopwords trong từng hàm, số lượng từ bị xóa sẽ khác nhau
# Chuyển hóa tất về chữ in thường:
corp <- corp %>% tm_map(content_transformer(tolower))
# Chuyển động từ về nguyên dạng, không chia, không nên dùng, vì nó bỏ hết cả chữ e cuối từ
corp <- corp %>% tm_map(PlainTextDocument)
corp <- corp %>% tm_map(stemDocument, "english")
# Bỏ các con số:
corp <- corp %>% tm_map(removeNumbers)
# Xóa khoảng trắng
corp <- corp %>% tm_map(stripWhitespace)
# 2.3. Chuyển hóa về Document Matrix: -------------------------------------------------------------
# Nếu có lỗi dùng hàm dưới
# corp <- tm_map(corp, content_transformer(function(x) iconv(enc2utf8(x), sub = "byte")))
tdm <- TermDocumentMatrix(corp)
# Kiểm tra tdm
inspect(tdm[1:10,])
m <- as.matrix(tdm)
v <- sort(rowSums(m), decreasing = TRUE)
d <- data.frame(word = names(v), freq = v)
str(d)
# Chuyển hóa factor về character:
d$word <- as.character(d$word)
# Danh sách của 500 từ xuất hiện nhiều nhất trong
# cuốn sách của Gujarati cùng tần suất tương ứng:
knitr::kable(d %>% slice(1:500))
# 500 từ này chiếm 75.9% tất cả các từ vựng mà tác giả dùng để viết sách:
sum(d$freq[1:500]) / sum(d$freq)
# Trong khi đó 500 từ kế tiếp chỉ chiếm 12.5%
sum(d$freq[1:1000]) / sum(d$freq)
#-----------------------------------------------------
# Dưới đây chúng ta lọc ra hai bộ dữ liệu riêng biệt.
# Bộ thứ nhất là những từ thuộc bộ từ điển tiếng Anh.
# Bộ còn lại không thuộc.
#-----------------------------------------------------
# Bộ thứ nhất chủ yếu là các từ phổ thông:
gu_eng <- d %>% filter(word %in% eng$V1)
# Bộ thứ hai hầu hết là từ chuyên ngành Thống kê - Kinh tế lượng:
gu_non_eng <- dplyr::setdiff(d, gu_eng)
# Tổng số từ vựng sử dụng để viết sách là 9078:
nrow(d)
nrow(gu_eng)
nrow(gu_non_eng)
nrow(gu_non_eng) / nrow(d)
knitr::kable(gu_non_eng %>% filter(freq >= 100))
knitr::kable(head(gu_non_eng, 200))
#--------------------------------------------------------------------------------------------------------
# 3. Vẽ đám mây từ
#--------------------------------------------------------------------------------------------------------
# Cho 100 từ xuất hiện nhiều nhất ở bộ 1:
par(bg = "black")
set.seed(15888)
wordcloud(words = gu_eng$word,
freq = gu_eng$freq,
# Chỉ hiện thị từ nào xuất hiện ít nhất 100 lần:
min.freq = 100,
# Số từ hiển thị trên wordcloud tối đa là 200:
max.words = 200,
# Ngẫu nhiên thứ tự:
random.order = FALSE,
# 35% số từ được hiển thị theo chiều thẳng đứng
rot.per = 0.35,
# Chọn kích cỡ chữ:
font = 2,
# Tô màu cho chữ:
colors = brewer.pal(8, "Dark2"))
# Cho 100 từ xuất hiện ở bộ 2:
set.seed(1409)
wordcloud(words = gu_non_eng$word,
freq = gu_non_eng$freq,
# Chỉ hiện thị từ nào xuất hiện ít nhất 10 lần
min.freq = 10,
# Số từ hiển thị trên wordcloud tối đa là 200:
max.words = 200,
# Ngẫu nhiên thứ tự:
random.order = FALSE,
# 35% số từ được hiển thị theo chiều thẳng đứng
rot.per = 0.35,
# Chọn kích cỡ chữ:
font = 2,
# Tô màu cho chữ:
colors = brewer.pal(8, "Dark2"))
Tuesday, July 10, 2018
Rcode advanced dplyr
rm(list = ls())
data("starwars")
#
names(starwars)
head(starwars)
# Đối tên biến
starwars %>% rename(sex = gender)
x1 <- starwars %>% slice(1:5) %>% select(hair_color, gender)
x1
x2 <- starwars %>% slice(6:10) %>% select(hair_color, gender)
x2
# Lấy tập giao (có trong cả 2 tập hợp)
x1 %>% intersect(x2)
# Lấy tập khác (chỉ có ở x1 mà ko có ở x2)
x1 %>% setdiff(x2)
# Chỉ có ở x2 mà ko có ở x1
x2 %>% setdiff(x1)
# lấy tập hợp (có ở x1 hoặc x2)
x1 %>% union(x2)
starwars %>% slice(1:5) %>% select(hair_color, gender) %>%
union(starwars %>% slice(6:10) %>% select(hair_color, gender)) # kết quả tương tự
# Tạo biến số thứ tự dòng
x1 %>% mutate(id=row_number())
x1 %>% mutate(id=row_number(gender))
# Lấy hạng bằng giá trị min của nhóm bằng nhau
x1 <- starwars %>% slice(10:20) %>% select(hair_color, gender, height)
x1 %>% mutate(rk = min_rank(gender))
x1 %>% mutate(rk = min_rank(hair_color))
x1 %>% mutate(rk = min_rank(height))
# Lấy hạng bằng dense_rank
x1 %>% mutate(rk = dense_rank(gender))
x1 %>% mutate(rk = dense_rank(hair_color))
# percent_rank,
x1 %>% mutate(prk = percent_rank(height))
x1 %>% mutate(prk = percent_rank(height)) %>% mutate(sprk = sum(prk))
#
x1 %>% mutate(prk = cume_dist(height))
x1 %>% mutate(prk = cume_dist(height)) %>% mutate(sprk = sum(prk))
#
select_if(starwars, funs(is.numeric))
select_at(starwars, vars("name", "height"))
#
starwars %>% rename_all(funs(paste0("sw_", .)))
starwars %>% rename_if(funs(is.numeric), funs(str_to_upper)) # những biến là numeric thì sẽ in hoa
starwars %>% rename_at( vars("name", "height"), funs(str_to_upper))
#
starwars %>% filter_at(vars(contains("color")), all_vars(. == "brown"))
starwars %>% filter_at(vars(contains("color")), any_vars(. == "brown"))
starwars %>% filter_if(is.numeric, all_vars(. > 100))
#
starwars %>% mutate_all(as.character)
starwars %>% mutate_if(funs(is.character), funs(as.factor))
starwars %>% mutate_at(vars("height"), funs(. / 10))
#
starwars %>%
select(1:3) %>%
mutate(sum(height, na.rm=T))
starwars %>%
select(1:3) %>%
mutate(sum(height, mass, na.rm=T)) # công hết cả 2 dãy số vào với nhau
starwars %>%
select(1:3) %>%
group_by_all() %>% # group hết tất cả các biến
mutate(sum(height, mass, na.rm=T))
starwars %>%
select(1:3) %>%
group_by_if(is.character) %>% # group nếu là biến character
count()
group_by_at(starwars, vars("eye_color", "hair_color")) %>% # không cần phải select
count()
starwars %>%
select_if(funs(is.numeric)) %>% # chọn theo điều kiện
summarise_all(funs(mean), na.rm = T)
starwars %>% summarise_if(funs(is.numeric), funs(min, median, mean, sd, max), na.rm = T)
starwars %>%
summarise_if(funs(is.numeric), funs(min, median, mean, sd, max), na.rm = T) %>%
gather() %>% # chuyển sang dạng long
arrange(key)
starwars %>%
summarise_if(funs(is.numeric), funs(min, median, mean, sd, max), na.rm = T) %>%
gather() %>% # chuyển sang dạng long
arrange(key)
starwars %>% summarise_at(vars("height", "mass"), funs(sum, mean), na.rm = T)
starwars %>%
summarise_all(funs(sum(is.na(.)))) %>%
select_if(any_vars(. > 0))
# Tham khảo: http://rpubs.com/hodgeasaurus/397278
Rcode trích diện tích từ đoạn text
load_pkg <- function(pkg){
library(pkg, character.only = T)
return('NNB')
}
pkgs <- c('tidyverse','magrittr', 'stringr', 'stringi', 'readxl', 'writexl', 'tidytext')
sapply(pkgs, load_pkg)
my_path <- 'D:/dt_crawled/'
d3 <- read_excel(paste0(my_path, 'Muaban_All_20June2018.xlsx'), sheet = 3)
head(d3$mb_long)
# Lấy dữ liệu
d3 <- d3 %>% mutate(text_vector = mb_long %>%
as_vector() %>%
str_to_lower() %>% # Chuyển về chữ in thường
str_squish() %>% # Xóa khoảng trống thừa giữa các ký tự
stri_trans_general(id = 'Latin-ASCII') # Xóa dấu của chữ
)
# -------------------------------
## Khoanh vùng liên quan đến m2
# -------------------------------
f1_dt <- function(text_vector){
## Tạo mẫu regrex
match_m2 <- c("[:digit:]+\\s*m2", # vd:30m2, 30 m2
"[:digit:]+(\\.|,|x)[:digit:]+\\s*m2", # vd: 30.06m2, 30x06m2, 30,06m2
"[:digit:]+\\s*x\\s*[:digit:]+\\s*m2"# # vd: 30 x 9 m2
) %>% paste0(collapse = '|')
## Xuất dữ liệu
out <- text_vector %>% as_vector() %>%
str_extract_all(pattern = match_m2, simplify = T)
}
# -------------------------------
# Khoanh vùng liên quan đến dt hoặc diện tích
# -------------------------------
f2_dt <- function(x){
## Tạo mẫu regrex
match_dt <- c("dt\\s*:\\s*\\d+\\s*x\\s*\\d+", # vd: dt: 3 x 5
"dt\\s*:\\s*\\d+(\\.|,)\\d+\\s*x\\s*\\d+(\\.|,)\\d+" , # vd: dt: 3.4 x 5.6,
"dt\\s*:\\s*\\d+\\s*x\\s*\\d+(\\.|,)?\\d*", #, # vd: dt: 3 x 5.6,
"dt\\s*:\\s*\\d+(\\.|,)?\\d*\\s*x\\s*\\d+", #, # vd: dt: 3.4 x 5,
"dien\\s*tich\\s*:\\s*\\d+\\s*x\\s*\\d+", # vd: dt: 3 x 5
"dien\\s*tich\\s*:\\s*\\d+(\\.|,)\\d+\\s*x\\s*\\d+(\\.|,)\\d+" , # vd: dt: 3.4 x 5.6,
"dien\\s*tich\\s*:\\s*\\d+\\s*x\\s*\\d+(\\.|,)?\\d*", #, # vd: dt: 3 x 5.6,
"dien\\s*tich\\s*:\\s*\\d+(\\.|,)?\\d*\\s*x\\s*\\d+" #, # vd: dt: 3.4 x 5,
) %>% paste0(collapse = '|')
## Xuất dữ liệu
out <- text_vector %>% as_vector() %>%
str_extract_all(pattern = match_dt, simplify = T)
}
m2 <- d3 %>%
filter(str_detect(text_vector, 'm2') == T) %>%
select(text_vector)
non_m2 <- d3 %>%
filter(str_detect(text_vector, 'm2') == F) %>%
select(text_vector)
m2 <- f1_dt(m2)
non_m2 <- f2_dt(non_m2)
Thursday, November 19, 2015
Getting Data via twitteR
Source
R package twitteR (by Jeff Gentry)
The simplest and quickest way to get data from twitter is by using the
functions of the R package twitteR (check twitteR vignette for more info)
Some (but not all) of the things you can get with twitteR
public tweets
trending topics
tweets containing a given hashtag
tweets containing a given word / term
tweets from a given user
Let's see different examplesStart: First we need to load the package twitteR
(remember to install it first!)
R package twitteR (by Jeff Gentry)
The simplest and quickest way to get data from twitter is by using the
functions of the R package twitteR (check twitteR vignette for more info)
Some (but not all) of the things you can get with twitteR
public tweets
trending topics
tweets containing a given hashtag
tweets containing a given word / term
tweets from a given user
(remember to install it first!)
Monday, November 9, 2015
Oaxaca with R
setwd ("F:/Dropbox/R/")
#install.packages("oaxaca")
require("oaxaca")
# set random seed
set.seed(08544)
# load data set of Hispanic
workers in Chicago
data("chicago")
# perform Blinder-Oaxaca
Decomposition:
# explain differences in log
real wages across native and foreign-born groups
results <- oaxaca(ln.real.wage ~ age + female + LTHS +
some.college +
college + advanced.degree |
foreign.born,
data = chicago, R = 50)
results$n
results$y
results$threefold$overall
# plot results of the threefold
decomposition, variable-by-variable
# only include educational
variables
# decomposition components along
the left side of the plot
plot(results, component.left = TRUE,
variables = c("LTHS", "some.college",
"college", "advanced.degree"),
variable.labels = c("LTHS" = "less than high
school",
"some.college" =
"some college",
"advanced.degree" =
"advanced degree"))
plot(results, components =
c("endowments","coefficients"))
# plot results of the twofold
decomposition (overall results)
# equal weight for Group A and B
in reference coefficient determinantion (weight = 0.5)
# unexplained portion split into
A and B
plot(results, decomposition = "twofold", type =
"overall",
weight = 0.5, unexplained.split = TRUE,
bar.color = c("limegreen", "hotpink",
"steelblue"))
results$twofold$overall
plot(results, decomposition = "twofold", weight =
-1)
plot(results, decomposition = "twofold", weight =
-1,
unexplained.split = TRUE, components =
c("unexplained A",
"unexplained B"),
component.labels = c("unexplained A" =
"In Favor of Natives",
"unexplained B" = "Against the Foreign-Born"),
variables = c("age",
"female", "college"), variable.labels = c("age" =
"Years of Age",
"female" = "Female", "college" = "College
Education"))
plot(results, decomposition = "twofold", weight =
-1,
unexplained.split = TRUE, components = c("unexplained A",
"unexplained B"), component.labels = c("unexplained
A" =
"In Favor of Natives", "unexplained B" =
"Against the Foreign-Born"),
component.left = TRUE, variables =
c("age","female","college"),
variable.labels = c("age" = "Years of Age",
"female" = "Female",
"college" = "College Education"))
#Specifc numerical values of the
point estimates of the unexplained discrimination components
#can, of course, be obtained
directly from the "oaxaca"-class object:
variables <- c("age", "female",
"college")
columns <- c("weight", "coef(unexplained
A)", "coef(unexplained B)")
results$twofold$variables[[5]][variables, columns]
Bayesian Model Averaging examples
# ############### Bayesian Model Averaging examples ############### # # This script assumes you have worked through all the previous notes from # the web page and you have downloaded, installed, and updated all available # R packages. ### Upload the SAS SEM Example data ("SEMData.sav") which is SIMULATION DATA. library(foreign) exsem <- read.spss("http://www.unt.edu/rss/class/Jon/R_SC/Module10/SEMData.sav", use.value.labels=TRUE, max.value.labels=Inf, to.data.frame=TRUE) summary(exsem) head(exsem) cor(exsem) # The goal of the this example is to choose the best set of predictor variables for a linear (OLS) prediction # model with Extroversion (extro) as the outcome. # Basic linear (OLS) regression model. reg.1 <- lm(extro~abstruse+agree+block+cognitive+common+cultural+open+physical+series+sets+social+vocab, data=exsem) summary(reg.1) # The BMA (Bayesian Model Averaging) package/library was designed specifically to use Bayesian Model # Averaging to address the variable selection problem in the context of several types of models (e.g. # GLM, LM, and Survival Models. library(BMA) # The function for conducting BMA with respect to linear regression is 'bicreg'. # The 'bicreg' function requires a matrix of predictor variables as input. attach(exsem) predictors <- as.matrix(cbind(open, agree, social, cognitive, physical, cultural, vocab, abstruse, block, common, sets, series)) detach(exsem) # Conduct the BMA using the 'bicreg' function by submitting the matrix of predictors (predictors) # and the outcome variable (exsem$extro). bma1 <- bicreg(predictors, exsem$extro) summary(bma1) # Based on the first column of the output we can see that "open", "agree", and "series" are the most # important variables; the column 'p!=0' indicates the percentage/probability that the coefficient # for a given predictor is NOT zero. We can also see that the first model 'model 1' (which includes # only 'open', 'agree', & 'series') is the best because it has the lowest BIC and the largest # posterior probability. # The 'ols' part of the output (not printed by default) gives a matrix, with each model as a row and # each predictor variable as a column; listing the estimated (OLS) coefficient for each variable in # a given model. bma1$ols # Likewise, the 'se' part of the output produces a similar matrix, with the standard errors for each # coefficient (for each variable/model combination). bma1$se # The 'postmean' part of the output (not printed by default) contains the average posterior coefficient # for each predictor. The 'postsd' provides the standard deviation of each average posterior coefficient. bma1$postmean bma1$postsd # The 'which' part of the output (not provided by default) contains a matrix, with each model as a row and # each predictor variable as a column; listing whether a variable was included in each model. bma1$which # The BMA package also contains a plot function for displaying the posterior distributions of the # coefficients. plot(bma1) # For a complete description of the 'bicreg' function: help(bicreg) # Bayesian model averaging can also be conducted when attempting to identify the best set of predictors # for a Generalized Linear Model. The 'bic.glm' function is very similar to 'bicreg'; you must # supply a matrix or data frame of the independent variables (predictors) and the outcome variable. # Results of the following model mirror those above. However, the obvious benefit of the 'bic.glm' function # is the ability to specify non-normal error distributions (i.e. non-Gaussian; e.g. binomial). bma2 <- bic.glm(predictors, exsem$extro, glm.family = "gaussian") summary(bma2) # Notice that when specifying "Gaussian" the estimation of the posterior standard # deviations is slightly off; therefore, it is best to use 'bicreg' when family = # "Gaussian". bma1$postsd bma2$postsd plot(bma2) # For a complete description of the 'bic.glm' function and its arguments: help(bic.glm) ### Example of Binomial Logistic Regression using 'bic.glm'. # Read in the data: logreg <- read.table("http://www.unt.edu/rss/class/Jon/R_SC/Module9/logreg1.txt", header=TRUE, sep="", na.strings="NA", dec=".", strip.white=TRUE) summary(logreg) # Create a matrix of the predictor variables. attach(logreg) predictors.logist <- as.matrix(cbind(x1,x2,x3,x4)) detach(logreg) # Run the 'bic.glm' function specifying the binomial family. bma2 <- bic.glm(predictors.logist, logreg$y, glm.family = "binomial") summary(bma2) plot(bma2) ### Example of Multinomial Logistic Regression using library 'mlogitBMA' and function 'bic.mlogit'. library(mlogitBMA) # Read in the data from the web (data is an SPSS.sav file, so the 'foreign' package is necessary). library(foreign) mdata1 <- read.spss("http://www.unt.edu/rss/class/Jon/R_SC/Module9/MultiNomReg.sav", use.value.labels=TRUE, max.value.labels=Inf, to.data.frame=TRUE) summary(mdata1) # Apply the 'bic.logit' function; supplying the formula in standard format, choices represent # the choices on the outcome variable (i.e. the categories of the outcome). mlog.1 <- bic.mlogit(y ~ x1 + x2 + X3, data = mdata1, choices = 1:3) summary(mlog.1) # To see all the arguments of the 'bic.mlogit' function help(bic.mlogit) # End; Feb, 2011
source
Monday, September 21, 2015
Bài giảng: Phương pháp phân tích dữ liệu với ngôn ngữ R – GS. Nguyễn Văn Tuấn
Loạt bài giảng không chỉ hướng dẫn cách sử dụng R mà còn trình bày rất cô đọng các kiến thức trong Thống kê và Kinh tế lượng.
Danh sách bài giảng
Bài giảng
|
Nội dung
|
Địa chỉ
|
1
|
Giới thiệu R
|
|
2
|
Giao diện và tương tác
|
|
3
|
Cách đọc ASCII file
|
|
4
|
Cách đọc Excel file
|
|
5
|
Biên tập dữ liệu (1)
|
|
6
|
Biên tập dữ liệu (2)
|
|
7
|
Biên tập dữ liệu (3)
|
|
8
|
Phân tích mô tả biến liên tục
|
|
9
|
Phân tích mô tả biến phân nhóm
|
|
10
|
T-test (1)
|
|
11
|
T-test (2)
|
|
12
|
Kiểm định phân bố chuẩn
|
|
13
|
Kiểm định Wilocoxon
|
|
14
|
Phương pháp kiểm định hoán vị
|
|
15
|
Kiểm định 2 biến nhị phân
|
|
16
|
Thông số trong biểu đồ
|
|
17
|
Biểu đồ hộp (box plot)
|
|
18
|
Biểu đồ sai số chuẩn
|
|
19
|
Biểu đồ thanh và phân bố
|
|
20
|
Biểu đồ tương quan đa biến
|
|
21
|
Tỉ số nguy cơ (risk ratio)
|
|
22
|
Tỉ số odss (odds ratio)
|
|
23
|
Giới thiệu phân tích phương sai (ANOVA)
|
|
24
|
Phân tích hậu định (posthoc analysis)
|
|
25
|
Phân tích phương sai phi tham số
|
|
26
|
Mô hình tuyến tính cho phân tích phương sai
|
|
27
|
Giới thiệu phương pháp kiểm định Ki bình phương
|
|
28
|
Kiểm định Ki bình thương (Chi square)
|
|
29
|
Hệ số tương quan
|
|
30
|
Hồi qui tuyến tính: giới thiệu
|
|
31
|
Hồi qui tuyến tính: phân tích phương sai
|
|
32
|
Phân tích dao động dư
|
|
33
|
Giới thiệu mô hình hồi qui tuyến tính đa biến | https://www.youtube.com/watch?v=Uxh7tdg42UQ&list=UU21dOPe-YHO3Gw6BRbyeotQ |
34
|
Hồi qui tuyến tính đa biến (ước tính) | http://www.youtube.com/watch?v=yRj1-J7ZH5Y&list=UU21dOPe-YHO3Gw6BRbyeotQ |
35
|
Ảnh hưởng tương tác trong mô hình hồi qui tuyến tính | https://www.youtube.com/watch?v=i3e2zWKQGAE&list=UU21dOPe-YHO3Gw6BRbyeotQ |
36
|
Vấn đề đa cộng tuyến (multicollinearity) | https://www.youtube.com/watch?v=sjI94HvBfaY&list=UU21dOPe-YHO3Gw6BRbyeotQ |
37
|
Đánh giá tầm quan trọng trong mô hình hồi qui tuyến tính | https://www.youtube.com/watch?v=HsU3cDpQJko&list=UU21dOPe-YHO3Gw6BRbyeotQ |
38
|
Chọn mô hình (model selection) trong phân tích hồi qui tuyến tính đa biến | https://www.youtube.com/watch?v=Q40TFF2Opuc&list=UU21dOPe-YHO3Gw6BRbyeotQ |
39
|
Chọn mô hình hồi qui tuyến tính bằng phương pháp Bayes | https://www.youtube.com/watch?v=eVp0oyKxtrI&index=3&list=UU21dOPe-YHO3Gw6BRbyeotQ |
| 40 | Giới thiệu mô hình hồi qui logistic 1: Odds ratio | https://www.youtube.com/watch?v=AJCmccF3faY&list=UU21dOPe-YHO3Gw6BRbyeotQ |
| 41 | Mô hình hồi qui logistic | https://www.youtube.com/watch?v=0yILsvQZ0Uw&index=4&list=UU21dOPe-YHO3Gw6BRbyeotQ |
| 42 | Diễn giải kết quả phân tích hồi qui logistic | https://www.youtube.com/watch?v=FcxY-Cheb6Y&index=2&list=UU21dOPe-YHO3Gw6BRbyeotQ |
| 43 | Đánh giá mô hình hồi qui logistic | https://www.youtube.com/watch?v=q5M5N66QFBk&list=UU21dOPe-YHO3Gw6BRbyeotQ |
| 44 | Các “thước đo” mô hình hồi qui logistic | https://www.youtube.com/watch?v=6rTAIAM-Vzw |
| 45 | Mô hình hồi qui logistic đa biến | https://www.youtube.com/watch?v=I9JD2fDbcHY&list=UU21dOPe-YHO3Gw6BRbyeotQ |
| 46 | Phương pháp tìm mô hình hồi qui logistic tối ưu | https://www.youtube.com/watch?v=bAUrZqhCNww |
| 47 | Đánh giá độ phân định (discrimination) mô hình tiên lượng | https://www.youtube.com/watch?v=8msZdongyMc |
————-&&————
Subscribe to:
Posts (Atom)