r/r.github.com

r.github.com's Issues

update readme

BOM

NEED BOM

test

test

Скрипт R

library(readr)
data <- read_csv("D:/data.csv")
data<-data[,-c(1)]

####Квалификации####

library(hcandersenr)
library(tidyverse)
library(tidytext)
library(SnowballC)
library(hunspell)
library(dplyr)

#токенизация и удаление стоп-слов
A<-unnest_tokens(data,word,X39)
library(stopwords)
D <- data.frame(stopwords = stopwords('Russian'))
library(stringr)
A_tidy<- anti_join(A, D, by = c("word"="stopwords"),
copy = FALSE, na_matches = c("na", "never"))%>%
filter(!str_detect(word, pattern = "[[:digit:]]"), # removes any words with numeric digits
!str_detect(word, pattern = "[[:punct:]]"), # removes any remaining punctuations
!str_detect(word, pattern = "(.)\1{2,}"), # removes any words with 3 or more repeated letters
!str_detect(word, pattern = "\b(.)\b"))

#превращение всех слов в исходное через алгоритм
A_stem<-A_tidy %>%
mutate(word, stem = wordStem(word,language = c('russian','english')))

A_stem1<-A_stem[A_stem$word=='опыт' & A_stem$stem =='оп' , ]
A_stem1['stem'][A_stem1['stem'] == 'оп'] <- 'опыт'

A_stem2<-A_stem[A_stem$word!='опыт' & A_stem$stem !='оп' , ]

A_stem3<-rbind(A_stem1,A_stem2)
View(A_stem3)

AA<-A_stem3%>%
count(stem, sort = TRUE)

AA1<-AA[-c(1,3,4,6:12,16,18,20,24,29,31,33,34,35,37,39,40,43,47,48),]

data_AA1 <- AA1 %>%
filter(n > 8600) %>%
mutate(stem = reorder(stem, n))

data_AA1['stem'] <- c('опыт','образование', 'техническое',
'высшее', 'техника', 'профессиональное',
'ответственность', 'специальность',
'организация', 'язык', 'медицинская','норм',
'нормативные', 'оборудование', 'навык',
'среднее', 'устройство','программа',
'аккуратность', 'внимательность', 'технология',
'исполнительность', 'сертификат',
'английский', 'документы')
View(data_AA1)

library(ggplot2)
ggplot(data_AA1, aes(stem, n)) +
geom_col() +
xlab(NULL) +
coord_flip() + theme_bw()

облако слов

library(wordcloud)
library(RColorBrewer)
library(wordcloud2)

wordcloud2(data_AA1, size=0.8, color='random-dark')

Биграммы

A_n2 <- unnest_tokens(data, bigram, X39, token = "ngrams", n = 2)
View(A_n2)

B_n2<- A_n2 %>% count(bigram, sort = TRUE)#наиболее часто встречающиеся биграммы
View(B_n2)

head(B_n2)

library(tidyr)

BB<-separate(B_n2,bigram,into=c("word1", "word2"), sep=' ')

разделила столбец биграммы на два столбца, чтобы убрать можно было стоп-слова из пары слов

w1<-anti_join(BB, D, by = c("word1"="stopwords"),
copy = FALSE, na_matches = c("na", "never"))

w2<-anti_join(w1, D, by = c("word2"="stopwords"),
copy = FALSE, na_matches = c("na", "never"))

B1_n2 <- w2

B1_n2$bigram <- paste (B1_n2$word1, B1_n2$word2, sep=" ")

B2_n2 <- B1_n2[c("bigram", "n")]

B2n2 <- B2_n2[-c(2,4,5,7,10,14,15,16,17,21,23,25,26,29,31,32,33,34,36,37,38,42,43,45,46,47,49,51,52,53,54,55,56,59),]

data_B2n2 <- B2n2 %>%
filter(n > 2300) %>%
mutate(bigram = reorder(bigram, n))

ggplot(data_B2n2, aes(bigram, n)) +
geom_col() +
xlab(NULL) +
coord_flip() + theme_bw()

облако слов

wordcloud2(data_B2n2, size=0.8, color='random-dark')

####Должноcтные обязанности####

#токенизация и удаление стоп-слов
С<-unnest_tokens(data,word,X41)
D <- data.frame(stopwords = stopwords('Russian'))
library(stringr)
С_tidy<- anti_join(С, D, by = c("word"="stopwords"),
copy = FALSE, na_matches = c("na", "never"))%>%
filter(!str_detect(word, pattern = "[[:digit:]]"), # removes any words with numeric digits
!str_detect(word, pattern = "[[:punct:]]"), # removes any remaining punctuations
!str_detect(word, pattern = "(.)\1{2,}"), # removes any words with 3 or more repeated letters
!str_detect(word, pattern = "\b(.)\b"))

#превращение всех слов в исходное через алгоритм
С_stem<-С_tidy %>%
mutate(word, stem = wordStem(word,language = c('russian','english')))

СС<-С_stem%>%
count(stem, sort = TRUE)

СС1<-СС[-c(1,7,13,19,25,30),]

data_СС1 <- СС1 %>%
filter(n > 15570) %>%
mutate(stem = reorder(stem, n))

data_СС1['stem'] <- c('выполнение', 'контроль','организация',
'техническое','оборудование','проведение',
'осуществлять','ремонт','подготовка',
'обеспечение','разработка','документация',
'товар','ведение','обслуживание','клиент',
'продукция','предприятие','средства',
'учет','уборка','производственная',
'соблюдение','материалы','участие')
View(data_СС1)

library(ggplot2)
ggplot(data_СС1, aes(stem, n)) +
geom_col() +
xlab(NULL) +
coord_flip() + theme_bw()

облако слов

library(wordcloud)
library(RColorBrewer)
library(wordcloud2)

wordcloud2(data_СС1, size=0.8, color='random-dark')

Биграммы

C_n2 <- unnest_tokens(data, bigram, X41, token = "ngrams", n = 2)
View(C_n2)

D_n2<- C_n2 %>% count(bigram, sort = TRUE)#наиболее часто встречающиеся биграммы
View(D_n2)

library(tidyr)

DD<-separate(D_n2,bigram,into=c("word1", "word2"), sep=' ')

разделила столбец биграммы на два столбца, чтобы убрать можно было стоп-слова из пары слов

w3<-anti_join(DD, D, by = c("word1"="stopwords"),
copy = FALSE, na_matches = c("na", "never"))

w4<-anti_join(w3, D, by = c("word2"="stopwords"),
copy = FALSE, na_matches = c("na", "never"))

D1_n2 <- w4

D1_n2$bigram <- paste (D1_n2$word1, D1_n2$word2, sep=" ")

D2_n2 <- D1_n2[c("bigram", "n")]

D2n2 <- D2_n2[-c(1,2,4,11,12,14,19,21,25,26,27,28,32,33,35,36,38,40),]

data_D2n2 <- D2n2 %>%
filter(n > 1630) %>%
mutate(bigram = reorder(bigram, n))

ggplot(data_D2n2, aes(bigram, n)) +
geom_col() +
xlab(NULL) +
coord_flip() + theme_bw()

облако слов

wordcloud2(data_D2n2, size=0.2, color='random-dark')

####Дополнительная информация####

#токенизация и удаление стоп-слов
E<-unnest_tokens(data,word,X1)
D <- data.frame(stopwords = stopwords('Russian'))
library(stringr)
E_tidy<- anti_join(E, D, by = c("word"="stopwords"),
copy = FALSE, na_matches = c("na", "never"))%>%
filter(!str_detect(word, pattern = "[[:digit:]]"), # removes any words with numeric digits
!str_detect(word, pattern = "[[:punct:]]"), # removes any remaining punctuations
!str_detect(word, pattern = "(.)\1{2,}"), # removes any words with 3 or more repeated letters
!str_detect(word, pattern = "\b(.)\b"))

#превращение всех слов в исходное через алгоритм
E_stem<-E_tidy %>%
mutate(word, stem = wordStem(word,language = c('russian','english')))

EE<-E_stem%>%
count(stem, sort = TRUE)

EE1<-EE[-c(3,5,7,9,10,14,15,17,18,22,25,27,28,29,30,32,33,38,39),]

data_EE1 <- EE1 %>%
filter(n > 2700) %>%
mutate(stem = reorder(stem, n))

data_EE1['stem'] <- c('ответственность','дисциплинированность',
'компьютер','команда','коммуникабельность',
'квотируемое','специалист','пунктуальность',
'квалифицированный','обучаемость','английский',
'водительское','инициативный','целеустремленность',
'строительство','командировки','китайский','тяжелые',
'вредные','инженер','делопроизводство','менеджер',
'управление','производство','продажи')
View(data_EE1)

library(ggplot2)
ggplot(data_EE1, aes(stem, n)) +
geom_col() +
xlab(NULL) +
coord_flip() + theme_bw()

облако слов

library(wordcloud)
library(RColorBrewer)
library(wordcloud2)

wordcloud2(data_EE1, size=0.75, color='random-dark')

Биграммы

E_n2 <- unnest_tokens(data, bigram, X1, token = "ngrams", n = 2)
View(E_n2)

F_n2<- E_n2 %>% count(bigram, sort = TRUE)#наиболее часто встречающиеся биграммы

library(tidyr)

FF<-separate(F_n2,bigram,into=c("word1", "word2"), sep=' ')

разделила столбец биграммы на два столбца, чтобы убрать можно было стоп-слова из пары слов

w5<-anti_join(FF, D, by = c("word1"="stopwords"),
copy = FALSE, na_matches = c("na", "never"))

w6<-anti_join(w5, D, by = c("word2"="stopwords"),
copy = FALSE, na_matches = c("na", "never"))

F1_n2 <- w6

F1_n2$bigram <- paste (F1_n2$word1, F1_n2$word2, sep=" ")

F2_n2 <- F1_n2[c("bigram", "n")]

F2n2 <- F2_n2[-c(1,2,4,6,10,11,13,15,16,17,20,22,23,24,25,27,28,29,31,32,33,34,36,37,38,39,40,41,43,45,46,49,50,51,52,55,56,57,58,59,60,61,62,63,65,66,67,68,70,71,72,73,75,76,78,79,82,83,84),]

data_F2n2 <- F2n2 %>%
filter(n > 1090) %>%
mutate(bigram = reorder(bigram, n))

ggplot(data_F2n2, aes(bigram, n)) +
geom_col() +
xlab(NULL) +
coord_flip() + theme_bw()

облако слов

wordcloud2(data_F2n2, size=0.5, color='random-dark')

Описательные

data$X3<-as.numeric(data$X3)
data$X4<-as.numeric(data$X4)
data$X21<-as.numeric(data$X21)

data$mean_salary <- (data$X3+data$X4)/2
n<-na.omit(data$mean_salary)
length(n)/200144 #0.9545078
k <-na.omit(as.numeric(data$X3>data$X4))
sum(k)/191039

m<-as.numeric(data$X3==data$X4)
sum(m)/191039

x<-log(na.omit(data$mean_salary))

plot(density(x[x > quantile(x,prob=0.005) & x < quantile(x,prob=0.995)],
bw=0.07),
main = "Функция плотности", lwd = 2)

hist(x[x > quantile(x,prob=0.005) & x < quantile(x,prob=0.995)],
breaks = 10,
freq = FALSE,
col = "lightblue",
xlab = "Логарифм заработной платы",
ylab = "Плотность вероятности",
main = "Гистограмма, совмещенная с кривой плотности")
lines(density(x[x > quantile(x,prob=0.005) & x < quantile(x,prob=0.995)],
bw=0.07), col = "blue", lwd = 2)

mean(na.omit(data$mean_salary))# 40733.56
median(na.omit(data$mean_salary))# 36870
sd(na.omit(data$mean_salary))# 21095.87
quantile(na.omit(data$mean_salary),p = seq(0, 1, 0.1))

0% 10% 20% 30% 40% 50% 60% 70% 80% 90% 100%

0 21000 25000 30000 32500 36870 40000 45000 50000 62000 700000

62000/21000 #p9/p1=2.952381
data1<-na.omit(data$mean_salary)#191039 наблюдений
191039/200144 #0.9545078

install.packages('DescTools')

library(DescTools)
Gini(na.omit(data$mean_salary))# 0.2480899

доля вакансий, запрашивающих высшее образование

sum(na.omit(as.numeric(data$X18=='Высшее')))#73698
73698/200144 #0.3682249

доля вакансий, запрашивающих среднее профессиональное

sum(na.omit(as.numeric(data$X18=='Среднее профессиональное')))#74184
74184/200144 #0.3706531

доля вакансий, запрашивающих среднее

sum(na.omit(as.numeric(data$X18=='Среднее')))#47909
47909/200144 #0.2393727

доля вакансий, запрашивающих незаконченное высшее

sum(na.omit(as.numeric(data$X18=='Незаконченное высшее')))#7
7/200144 #0.000035

требуемый опыт работы

hist(na.omit(data$X21),
#breaks = pretty(30),
col = "steelblue",
xlab = "Требуемый опыт работы (количество лет)",
ylab = "Частота",
main = "Требуемый опыт работы")

гистограммы по подгруппам. Пакет lattice

library(lattice)
histogram(~experience[experience<20] | X18,
filter(data,X18!='Незаконченное высшее'),
col="steelblue",
breaks = pretty(c(0,20),n=20),
xlab = "Требуемый опыт работы (количество лет)",
ylab = "Процент от общего числа")

доля вакансий, без опыта (опыт=0)

sum(na.omit(data$experience==0))#74285
74285/200144 #0.3711578

#с опытом
sum(na.omit(data$experience!=0))#124230
124230/200144 #0.6207031

#1-3 года опыта
sum(na.omit(data$experience>0 & data$experience<=3 ))#89303
89303/200144 #0.4461937

#3-5 года опыта
sum(na.omit(data$experience>3 & data$experience<=5 ))#27367
27367/200144 #0.1367365

#Тип занятости
sum(na.omit(as.numeric(data$X20=='Полная занятость')))#187204
187204/200144 #0.9353466

sum(na.omit(as.numeric(data$X20=='Сезонная')))#1045
1045/200144 #0.005221241

sum(na.omit(as.numeric(data$X20=='Удаленная')))#14
14/200144 #6.994964e-05

sum(na.omit(as.numeric(data$X20=='Временная')))#9595
9595/200144 #0.04794048

sum(na.omit(as.numeric(data$X20=='Частичная занятость')))#1627
1627/200144 #0.008129147

sum(na.omit(as.numeric(data$X20=='Стажировка')))#655
655/200144 #0.003272644

График работы

sum(na.omit(as.numeric(data$X46=='Полный рабочий день')))#124476
124476/200144 #0.6219322

sum(na.omit(as.numeric(data$X46=='Гибкий график')))#7544
7544/200144 #0.03769286

sum(na.omit(as.numeric(data$X46=='Сменный график')))#45039
45039/200144 #0.225033

sum(na.omit(as.numeric(data$X46=='Неполный рабочий день')))#5383
5383/200144 #0.02689564

sum(na.omit(as.numeric(data$X46=='Ненормированный рабочий день')))#4954
4954/200144 #0.02475218

sum(na.omit(as.numeric(data$X46=='Вахтовый метод')))#11020
11020/200144 #0.05506036

data2<-data %>%
group_by(X25) %>%
summarise(MeanSalary=mean(na.omit(mean_salary)),
Sd=sd(na.omit(mean_salary)),
count=n())
data3<-data2[-c(3,34),]
colnames(data3) <- c("Сфера деятельности",
"Средняя заработная плата",
"Стандартное отклонение",
"Количество вакансий")
htmlTable(data3)

data$experience<-data$X21
data$high_education <- ifelse (data$X18=='Высшее',1,0)
data$sec_prof_education <- ifelse (data$X18=='Среднее профессиональное',1,0)

data2<-data[, -c(1:14,16,17,19:30,32)]
data2[is.na(data2) | data2=="Inf"] = NA
data2<-data2[ complete.cases(data2), ]
data2$Industry<-data2$X25
data2$EmploymentType<- data2$X20
data2$WorkSchedule <- data2$X46
data2<-data2[,-c(1:3)]

Социальный пакет (X28)

library(tidytext)
S<-unnest_tokens(data,word,X28)# разделим на слова
O<- S %>% count(word, sort = TRUE)#наиболее часто встречающиеся слова
View(O)

удалим стоп-слова

library(stopwords)

D <- data.frame(stopwords = stopwords('Russian'))
library(stringr)
O1<- anti_join(O, D, by = c("word"="stopwords"),
copy = FALSE, na_matches = c("na", "never"))%>%
filter(!str_detect(word, pattern = "[[:digit:]]"), # removes any words with numeric digits
!str_detect(word, pattern = "[[:punct:]]"), # removes any remaining punctuations
!str_detect(word, pattern = "(.)\1{2,}"), # removes any words with 3 or more repeated letters
!str_detect(word, pattern = "\b(.)\b")) # removes any remaining single letter words

View(O1)

Биграммы

S_n2 <- unnest_tokens(data, bigram, X28, token = "ngrams", n = 2)
View(S_n2)

O_n2<- S_n2 %>% count(bigram, sort = TRUE)#наиболее часто встречающиеся биграммы
View(O_n2)

head(O_n2)

library(tidyr)

OO<-separate(O_n2,bigram,into=c("word1", "word2"), sep=' ')

разделила столбец биграммы на два столбца, чтобы убрать можно было стоп-слова из пары слов

w1<-anti_join(OO, D, by = c("word1"="stopwords"),
copy = FALSE, na_matches = c("na", "never"))

w2<-anti_join(w1, D, by = c("word2"="stopwords"),
copy = FALSE, na_matches = c("na", "never"))

O1_n2 <- w2

O1_n2$bigram <- paste (O1_n2$word1, O1_n2$word2, sep=" ")

O2_n2 <- O1_n2[c("bigram", "n")]

head(O2_n2)

#визуализация частот
#оставим только те, которые больше 5200

data_O1 <- O1 %>% filter(n > 5200) %>%
mutate(word = reorder(word, n))
View(data_O1)

library(ggplot2)
ggplot(data_O1, aes(word, n)) +
geom_col() +
xlab(NULL) +
coord_flip() + theme_bw()

для биграмм

data_O2_n2 <- O2_n2[-c(11,13,14,16,20),] %>% filter(n > 5100) %>%
mutate(bigram = reorder(bigram, n))
View(data_O2_n2)
library(ggplot2)
ggplot(data_O2_n2, aes(bigram, n)) +
geom_col() +
xlab(NULL) +
coord_flip() + theme_bw()

####Latent Dirichlet Allocation####
A<-unnest_tokens(data,word,X39)# разделим на слова
library(stopwords)
D <- data.frame(stopwords = stopwords('Russian'))

#вычислим частоты
W<- A %>% filter(word!='работы' &
word!='работ' &
word!='работать' &
word!='опыт' &
word!='знание' &
word!='знать' &
word!='должен' &
word!='наличие' &
word!='образование'&
word!='лет' &
word!='умение' &
word!='способы' &
word!='правил' &
word!='правила'&
word!='области' &
word!='ответственности' &
word!='ответственность' &
word!='техники' &
word!='высшее' &
word!='обязательно' &
word!='менее' &
word!='безопасности' &
word!='противопожарной' &
word!='охраны' &
word!='труда' &
word!='работе' &
word!='профессиональное' &
word!='навыки' &
word!='года' &
word!='1' &
word!='деятельности' &
word!='трудовой' &
word!='обязателен' &
word!='соблюдение' &
word!='приветствуется' &
word!='медицинской' &
word!='должности' &
word!='желательно' &
word!='5' &
word!='3')
word_counts <- W %>% anti_join(D, by = c("word"="stopwords")) %>%
count(vac_number, word, sort = TRUE) %>% ungroup()

#преобразуем в необходимый для модели формат
chapters_dtm <- word_counts %>%
cast_dtm(vac_number, word, n)

library(topicmodels)
#построим модель
chapters_lda <- LDA(chapters_dtm, k = 4, control = list(seed = 1234))

#оценка коэффициентов
chapter_topics <- tidy(chapters_lda, matrix = "beta")
chapter_topics

top_terms <- chapter_topics %>%
group_by(topic) %>%
top_n(30, beta) %>%
ungroup() %>%
arrange(topic, -beta)

top_terms2 <- chapter_topics %>%
filter (term!='норм'&
term!='нормативных'&
term!='материалов' ) %>%
group_by(topic) %>%
top_n(15, beta) %>%
ungroup() %>%
arrange(topic, -beta)

#визуализируем
top_terms2 %>%
mutate(term = reorder(term, beta)) %>%
ggplot(aes(term, beta, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") + coord_flip()

#вероятности отнесения содержания к топику
chapters_gamma <- tidy(chapters_lda, matrix = "gamma")
chapters_gamma
#chapters_gamma <- chapters_gamma %>%
separate(document, c("title", "chapter"), sep = "_", convert = TRUE)

Модель

data2<-data[, -c(1:14,16,17,19:30,32)]
data2[is.na(data2) | data2=="Inf"] = NA
data2<-data2[ complete.cases(data2), ]
data2$Industry<-data2$X25
data2$EmploymentType<- data2$X20
data2$WorkSchedule <- data2$X46
data2<-data2[,-c(1:3)] #8 столбцов 184763 вакансий
data2$document<-data2$vac_number
data2<-data2[,-c(2)]

chapters_gamma$document<-as.integer(chapters_gamma$document)
chapters_gamma$topic<-as.factor(chapters_gamma$topic)

chapters_gamma$topic1<-ifelse(chapters_gamma$topic==1,1,0)
chapters_gamma$topic2<-ifelse(chapters_gamma$topic==2,1,0)
chapters_gamma$topic3<-ifelse(chapters_gamma$topic==3,1,0)
chapters_gamma$topic4<-ifelse(chapters_gamma$topic==4,1,0)

chapters_gamma$t1<-(chapters_gamma$topic1chapters_gamma$gamma)
chapters_gamma$t2<-(chapters_gamma$topic2chapters_gamma$gamma)
chapters_gamma$t3<-(chapters_gamma$topic3chapters_gamma$gamma)
chapters_gamma$t4<-(chapters_gamma$topic4chapters_gamma$gamma)

gamma<-chapters_gamma[,-c(2:7)]

gamma1 <- gamma %>% group_by(document) %>%
summarise(topic1=sum(t1),
topic2=sum(t2),
topic3=sum(t3),
topic4=sum(t4),
.groups = 'drop')

data_m<-inner_join(data2,gamma1,by='document')

mod1 <- lm(log(mean_salary+1) ~ high_education +
sec_prof_education+
experience + I(experience^2)+
as.factor(Industry)+
as.factor(EmploymentType)+as.factor(WorkSchedule),
data=data_m)
summary(mod1)

library(stargazer)
library(MASS)
library(car)
library(lmtest)
library(sandwich)

stargazer(mod1, type = "text", median = TRUE, digits = 2,
font.size = "tiny", title = "Модель 1", out = "mod1.html")

mod11<-stepAIC(mod1)
summary(mod11)

vif(mod1)#меньше 5, нет мультиколлинераности

bptest(mod1) # есть гетероскедастичность

cse = function(reg) {
rob = sqrt(diag(vcovHC(reg, type = "HC1")))
return(rob)
}

stargazer(mod1,
se=cse(mod1),
type = "text", median = TRUE, digits = 2,
font.size = "tiny", title = "Модель 01", out = "mod01.html")

добавим группы навыков

mod2 <- lm(log(mean_salary+1) ~ high_education +
sec_prof_education+
experience + I(experience^2)+
topic1+topic2+topic4+
as.factor(Industry)+
as.factor(EmploymentType)+as.factor(WorkSchedule),
data=data_m)
summary(mod2)

linearHypothesis(mod2, "topic1 = topic2")#H0-равны, p-value<alpha H1, ок

stargazer(mod2, type = "text", median = TRUE, digits = 2,
font.size = "tiny", title = "Модель 2", out = "mod2.html")

mod22<-stepAIC(mod2)
summary(mod22)
stargazer(mod33, type = "text", median = TRUE, digits = 2,
font.size = "tiny", title = "Модель 33", out = "mod33.html")

vif(mod2)#меньше 5, нет мультиколлинераности

bptest(mod2) # есть гетероскедастичность

cse = function(reg) {
rob = sqrt(diag(vcovHC(reg, type = "HC1")))
return(rob)
}

stargazer(mod2,
se=cse(mod2),
type = "text", median = TRUE, digits = 2,
font.size = "tiny", title = "Модель 02", out = "mod02.html")

SVM и Случайный лес

library(tidyverse)
library(ggplot2)
library(tidymodels)
library(textrecipes)
library(LiblineaR)
library(ranger)
library(spacyr)
library(rlang)
library(text2vec)
library(generics)
library(rsample)
library(recipes)
library(textrecipes)
library(workflows)
library(parsnip)
library(LiblineaR)
library(tune)
library(ranger)

#разделение на выборку обучения и тестовую
data3<-data[, -c(1:14,16,17,19:25,27:30,32)]
data3[is.na(data3) | data3=="Inf"] = NA
data3<-data3[ complete.cases(data3), ]
data3$Industry<-data3$X25
data3$EmploymentType<- data3$X20
data3$RequiredQualification<- data3$X39
data3$WorkSchedule <- data3$X46
data3<-data3[,-c(1:4)] #9 столбцов 183962 вакансий

set.seed(1234)
scotus_split <- data3 %>%
mutate(salary = mean_salary,
text = str_remove_all(RequiredQualification, "'")) %>%
initial_split()

scotus_train <- training(scotus_split)
scotus_test <- testing(scotus_split)

#разделим на токены, выберем 100 наиболее часто встречающихся
#вычислим tf-idf и нормализуем эту величину
scotus_rec <- recipe(salary ~ text, data = scotus_train) %>%
step_tokenize(text) %>%
step_tokenfilter(text, max_tokens = 100) %>%
step_tfidf(text) %>%
step_normalize(all_predictors())
scotus_rec

#пустая модель
scotus_wf <- workflow() %>%
add_recipe(scotus_rec)
scotus_wf

#SVM
svm_spec <- svm_linear() %>%
set_mode("regression") %>%
set_engine("LiblineaR")

#обучим
svm_fit <- scotus_wf %>%
add_model(svm_spec) %>%
generics::fit(data = scotus_train)

#прогнозы
svm_fit %>%
extract_fit_parsnip() %>%
tidy() %>%
arrange(-estimate)
#bias - константа, вариант по умолчанию

#10-кратная кросс-валидация
set.seed(123)
scotus_folds <- vfold_cv(scotus_train)
scotus_folds

#прогноз
set.seed(123)
svm_rs <- fit_resamples(
scotus_wf %>% add_model(svm_spec),
scotus_folds,
control = control_resamples(save_pred = TRUE)
)

#визуализируем
collect_metrics(svm_rs)
svm_rs %>%
collect_predictions() %>%
ggplot(aes(salary, .pred, color = id)) +
geom_abline(lty = 2, color = "gray80", size = 1.5) +
geom_point(alpha = 0.3) +
labs(
x = "Truth",
y = "Predicted salary",
color = NULL,
title = "Predicted and true salary",
subtitle = "Each cross-validation fold is shown in a different color"
)

#случайный лес
rf_spec <- rand_forest(trees = 1000) %>%
set_engine("ranger") %>%
set_mode("regression")

rf_spec

rf_rs <- fit_resamples(
scotus_wf %>% add_model(rf_spec),
scotus_folds,
control = control_resamples(save_pred = TRUE)
)
collect_metrics(rf_rs)

#визуализация леса
collect_predictions(rf_rs) %>%
ggplot(aes(salary, .pred, color = id)) +
geom_abline(lty = 2, color = "gray80", size = 1.5) +
geom_point(alpha = 0.3) +
labs(
x = "Truth",
y = "Predicted salary",
color = NULL,
title = paste("Predicted and true salary using",
"a random forest model", sep = "\n"),
subtitle = "Each cross-validation fold is shown in a different color"
)

#удалим стоп-слова
stopword_rec <- function(stopword_name) {
recipe(salary ~ text, data = scotus_train) %>%
step_tokenize(text) %>%
step_stopwords(text, language='russian', stopword_source = stopword_name) %>%
step_tokenfilter(text, max_tokens = 1e3) %>%
step_tfidf(text) %>%
step_normalize(all_predictors())
}

#создадим пустую модель
svm_wf <- workflow() %>%
add_model(svm_spec)

svm_wf

#разные способы удаления стоп-слов
set.seed(123)
snowball_rs <- fit_resamples(
svm_wf %>% add_recipe(stopword_rec("snowball")),
scotus_folds
)

#set.seed(234)
smart_rs <- fit_resamples(
svm_wf %>% add_recipe(stopword_rec("smart")),
scotus_folds
)

set.seed(345)
stopwords_iso_rs <- fit_resamples(
svm_wf %>% add_recipe(stopword_rec("stopwords-iso")),
scotus_folds
)

#сравним качество моделей
#collect_metrics(smart_rs)
word_counts <- tibble(name = c("snowball", "stopwords-iso")) %>%
mutate(words = map_int(name, ~length(stopwords::stopwords(source = .))))

list(snowball = snowball_rs,
#smart = smart_rs,
stopwords-iso = stopwords_iso_rs) %>%
map_dfr(show_best, "rmse", .id = "name") %>%
left_join(word_counts, by = "name") %>%
mutate(name = paste0(name, " (", words, " words)"),
name = fct_reorder(name, words)) %>%
ggplot(aes(name, mean, color = name)) +
geom_crossbar(aes(ymin = mean - std_err, ymax = mean + std_err), alpha = 0.6) +
geom_point(size = 3, alpha = 0.8) +
theme(legend.position = "none") +
labs(x = NULL, y = "RMSE",
title = "Model performance for three stop word lexicons",
subtitle = "For this data set, the Snowball lexicon performed best") +
theme_bw()

#визуализируем
scotus_fit <- extract_fit_parsnip(svm_fit)

scotus_fit %>%
tidy() %>%
filter(term != "Bias") %>%
mutate(
sign = case_when(estimate > 0 ~ "Выше средней заработной платы",
TRUE ~ "Ниже средней заработной платы"),
estimate = abs(estimate),
term = str_remove_all(term, "tfidf_text_")
) %>%
group_by(sign) %>%
filter( term!='при'&
term!='без'&
term!='за'&
term!='и'&
term!='в'&
term!='с'&
term!='или'&
term!='рф'&
term!='на'&
term!='навыки'&
term!='опыта'&
term!='умение'&
term!='работе'&
term!='правил'&
term!='знать'&
term!='наличие'&
term!='работать'&
term!='работы'&
term!='труда'&
term!='способы'&
term!='лет'&
term!='области'&
term!='приветствуется'&
term!='назначение'&
term!='требования'&
term!='соблюдение'&
term!='норм'&
term!='не'&
term!='о'&
term!='методы'&
term!='должен'&
term!='трудового'&
term!='организации'&
term!='к'&
term!='по'&
term!='должен'&
term!='года'&
term!='а'&
term!='знание'&
term!='владение'&
term!='предприятия'&
term!='менее'&
term!='нормы'&
term!='их'&
term!='защиты'&
term!='до'&
term!='обязателен'&
term!='обязательно'&
term!='от'&
term!='готовность'&
term!='деятельности'&
term!='желание'&
term!='требований'&
term!='для'&
term!='безопасности'&
term!='основы'&
term!='устройство'&
term!='охраны'&
term!='противопожарной'&
term!='правила'&
term!='материалов'&
term!='дополнительных'&
term!='должности'&
term!='работ'&
term!='систем'&
term!='образование'&
term!='сфере'&
term!='1'&
term!='2'&
term!='техники'&
term!='желательно')%>%
top_n(15, estimate) %>%
ungroup() %>%
ggplot(aes(x = estimate,
y = fct_reorder(term, estimate),
fill = sign)) +
geom_col(show.legend = FALSE) +
scale_x_continuous(expand = c(0, 0)) +
facet_wrap(~sign, scales = "free") +
labs(
y = NULL,
title = paste("Variable importance for predicting salary",
"Vacancy"),
subtitle = paste("These features are the most importance",
"in predicting the salary of an vacancy")
)

REF

need REF

GCB

r a gcb

for while in loop