Прогнозирование изменений валютного курса

library ('rms')

mod1b < - lrm (Z ~ positive + negative + neutral, data = reg)

print (mod1b)

return (q)

}

onlysearch < - function (searchterm) {

access_token < - "2420922668-JMDEnynORwSXe539IqP0XFEa6J1JQDY2bcVLJeh"

access_token_secret < - "1DDNxNdQJIwbrt6GyJx3BCTToPRCJ62oaOFupeWpzUb5W"

api_key < - "eLIc0KRqRqcJzRlPHYis5WYjU"

api_secret < - "aGB7fWofOoagYEBysqKQKKhB4iqOfpfFGFoHgwoQJ62qyG04C2"

setup_twitter_oauth (api_key,api_secret,access_token,access_token_secret)

list < - searchTwitter (searchterm, n=20, since = "2014-01-01")

df < - twListToDF (list)

df < - df [, order (names (df))]

df$created < - strftime (df$created, '%Y-%m-%d')

if (file. exists (paste (searchterm, '_stack. csv')) ==FALSE) write. csv (df, file=paste (searchterm, '_stack. csv'), row. names=F, fileEncoding = "UTF-8")

#merge the last extraction with storage file and remove duplicates

stack < - read. csv (file=paste (searchterm, '_stack. csv'), fileEncoding = "UTF-8")

stack < - rbind (stack, df)

stack < - subset (stack,! duplicated (stack$text))

write. csv (stack, file=paste (searchterm, '_stack. csv'), row. names=F, fileEncoding = "UTF-8")

#tweets evaluation function

}

Приложение 2. Реализация системы анализа настроений сообщений, основанной на машинном обучении.

# Загружаем библиотеки, готовим обучающую выборку #############

library (tm)

library (SnowballC)

library (e1071)

library (caret)

library (randomForest)

setwd ("/Users/sivakova/R/dissertation")

pos_tweets < - read. csv ("positive_tweets. csv", fileEncoding = "utf8", header = T, sep =",")

sentiment < - rep (1, nrow (pos_tweets))

text < - pos_tweets [,2]

pos_tweets < - data. frame (text, sentiment)

neg_tweets < - read. csv ("negative_tweets. csv", fileEncoding = "utf8", header = T, sep =",")

sentiment < - rep (-1, nrow (neg_tweets))

text < - neg_tweets [,2]

neg_tweets < - data. frame (text, sentiment)

neut_tweets < - read. csv ("neut. csv", fileEncoding = "utf8", header = T, sep ="; ")

sentiment < - rep (0, nrow (neut_tweets))

text < - neut_tweets [,2]

neut_tweets < - data. frame (text, sentiment)

training < - rbind (pos_tweets, neg_tweets, neut_tweets)

# Смотрим на данные ##########################################

# Проверяем размерность, инспектируем первое ревю

dim (training)

# Избавляемся от HTML тегов

cleanHTML < - function (x) {

return (gsub ("<. *? >", "", x))

}

# Оставляем только текст, убираем однобуквенные слова и слова нулевой длины

onlyText < - function (x) {

x < - gsub ("'s", "", x)

return (gsub (" [^а-яА-Я]", "", x))

}

# Токенизируем

tokenize < - function (x) {

x < - tolower (x)

x=system ("/Users/Sivakova/r/dissertation/mystem - cl", intern = TRUE, input = x)

x < - gsub (" [{}]", "", x)

x < - gsub (" (\\| [^] +)", "", x)

x < - gsub ("\\?", "", x)

x < - gsub ("\\s+", "", x)

x < - unlist (strsplit (x, split=" "))

}

# Создаем список стоп-слов

#stopWords < - stopwords ('ru')

# Обрабатываем все записи

rwsU < - sapply (1: nrow (training), function (x) {

# Прогресс-индикатор

if (x %% 1000 == 0) print (paste (x, "reviews processed"))

rw < - training [x,1]

rw < - cleanHTML (rw)

rw < - onlyText (rw)

rw < - tokenize (rw)

rw < - rw [nchar (rw) >1]

#rw < - rw [! rw %in% stopWords]

paste (rw, collapse=" ") # Снова склеиваем в текст

})

# Строим "Мешок слов" #######################################

train_vector < - VectorSource (rwsU) # Вектор

train_corpus < - Corpus (train_vector, #? Корпус

readerControl = list (language = "ru"))

train_bag < - DocumentTermMatrix (train_corpus, # Спец. матрица документы/термины

control=list (weight=presence, stemming=F))

# train_bag < - removeSparseTerms (train_bag, 0.9982) # Убираем слишком редкие термины

dim (train_bag)

# Смотрим на перечень наиболее распространенных терминов

hight_freq < - findFreqTerms (train_bag, 5, Inf)

inspect (train_bag [1: 4, hight_freq [1: 10]])

# Из специальной матрицы формируем обучающий датафрейм

l < - train_bag$nrow

train_df < - data. frame (inspect (train_bag [1: l,]))

train_df < - cbind (training$sentiment, train_df)

# Сокращенный датафрейм для статьи

# train_df < - data. frame (inspect (train_bag [1: 1000,hight_freq]))

# train_df < - cbind (training$sentiment [1: 1000], train_df)

names (train_df) [1] < - "sentiment"

vocab < - names (train_df) [-1] # Формируем словарь (для тестовой выборки)

# Убираем ненужное

# Выращиваем Случайный лес ##################################

t_start < - Sys. time ()

set. seed (3113)

####################################################

mat= create_matrix (rws, language="russian",

removeStopwords=FALSE, removeNumbers=F, removePunctuation = F,

stemWords=FALSE,)

container = create_container (mat, sentiment,

trainSize=1: 260, testSize=261: 323,virgin=FALSE)

models = train_models (container, algorithms=c (

"SVM",

"GLMNET",

"BAGGING",

"RF"

))

sentiment < - as. factor (training [,2])

nb<-naiveBayes (as. factor (sentiment) ~., train_df)

s < - predict (nb, newdata = train_df [,261: 323])

table (s, sentiment [261: 323])

###########################

results = classify_models (container, models)

table (as. numeric (as. numeric (sentiment [261: 323])), results [,"FORESTS_LABEL"])

recall_accuracy (as. numeric (as. numeric (sentiment [261: 323])), results [,"FORESTS_LABEL"])

table (as. numeric (as. numeric (sentiment [261: 323])), results [,"SVM_LABEL"])

recall_accuracy (as. numeric (as. numeric (sentiment [261: 323])), results [,"SVM_LABEL"])

table (as. numeric (as. numeric (sentiment [261: 323])), results [,"GLMNET_LABEL"])

recall_accuracy (as. numeric (as. numeric (sentiment [261: 323])), results [,"GLMNET_LABEL"])

table (as. numeric (as. numeric (sentiment [261: 323])), results [,"BAGGING_LABEL"])

recall_accuracy (as. numeric (as. numeric (sentiment [261: 323])), results [,"BAGGING_LABEL"])

control < - trainControl (method="cv", number=5)

# train the LVQ model

set. seed (7)

modelGbm < - train (as. factor (sentiment) ~., data=train_df, method="gbm", trControl=control, verbose=FALSE)

# train the SVM model

set. seed (7)

modelNb < - train (as. factor (sentiment) ~., data=train_df, trControl= control, method="nb")

#modelNb < - train (as. factor (sentiment) ~., data=train_df, method="awnb", trControl=control)

modelKf < - train (as. factor (sentiment) ~., data=train_df, method="rpart",

trControl=trainControl (method="cv", number=10, savePredictions = TRUE))

modelSvm < - train (as. factor (sentiment) ~., data=train_df,

method="svmLinear", trControl=control, scale = FALSE)

forest < - train (as. factor (sentiment) ~., data=train_df,

method="rf",

trControl=trainControl (method="cv",number=5),

prox=TRUE,

ntree=100,do. trace=10,allowParallel=TRUE)

# collect resamples

print (modelGbm)

print (modelSvm)

print (modelKf)

print (modelNb)

print (forest)

results < - resamples (modelGbm$results$Accuracy, modelSvm$results$Accuracy, modelKf$results$Accuracy, forest$results$Accuracy)

# control < - trainControl (method="repeatedcv", number=10, repeats=3)

#

# forest < - train (as. factor (sentiment) ~., data=train_df,

# method="rf",

# trControl=trainControl (method="cv",number=5),

# prox=TRUE,

# ntree=100,# do. trace=10,# allowParallel=TRUE)

#

#

# set. seed (3113)

# modelextraTrees < - train (as. factor (sentiment) ~., data=train_df, method="extraTrees",

# trControl=trainControl (method="cv",number=5),

# prox=TRUE,

# ntree=100,# do. trace=10,# allowParallel=TRUE)

#

#

# # train the GBM model

# set. seed (3113)

# modelGbm < - train (as. factor (sentiment) ~., data=train_df, method="gbm",

# trControl=control, verbose=FALSE)

#

#

# # train the SVM model

# set. seed (3113)

# modelSvm < - train (as. factor (sentiment) ~., data=train_df,

# method="svmRadial", trControl=control)

#

# # collect resamples

# results < - resamples (list (RF = forest, TREE = modelextraTrees, GBM=modelGbm, SVM=modelSvm))

# summarize the distributions

summary (results)

# boxplots of results

bwplot (results)

# dot plots of results

dotplot (results)

t_end < - Sys. time ()

# Смотрим на модель и на время обучения

t_end-t_start

print (forest)

# Загружаем и обрабатываем контрольную выборку ###############

testing < - read. csv ("test. csv", fileEncoding = "utf8", header = T, sep ="; ")

# Проверяем размерность

dim (testing)

# Обрабатываем тестовые ревю

rws < - sapply (1: nrow (testing), function (x) {

if (x %% 1000 == 0) print (paste (x, "tweet processed"))

rw < - testing [x,1]

rw < - cleanHTML (rw)

rw < - onlyText (rw)

rw < - tokenize (rw)

rw < - rw [nchar (rw) >1]

#rw < - rw [! rw %in% stopWords]

paste (rw, collapse=" ")

})

# Формируем вектор ревю, строим корпус, формируем матрицу документы/термины ###

test_vector < - VectorSource (rws)

test_corpus < - Corpus (test_vector,

readerControl = list (language = "ru"))

test_bag < - DocumentTermMatrix (test_corpus,

control=list (stemming=TRUE,

dictionary = vocab))

l < - nrow (test_bag)

test_df < - data. frame (inspect (test_bag [1: l,]))

sentiment < - rep (0, l)

test_df < - cbind (testing [1: l,1], sentiment, test_df [])

names (test_df) [1] < - "text"

# Прогнозируем сентимент ####################################

length (test_df [1,])

test_df [,2] < - predict (modelGbm, newdata = test_df [,-2])

table (test_df [,2], testing [,2])

testing [,2]

test_df [,2] < - predict (forest, newdata = test_df [-1])

# Сохраняем результата в csv

write. csv (test_df [,1: 2], file="Submission. csv",

quote=FALSE,

row. names=FALSE)

# Загружаем и обрабатываем все твиты ##########################

testing < - read. csv ("clean_tweets. csv", fileEncoding = "utf8", header = T, sep =",")

# Проверяем размерность

dim (testing)

# Обрабатываем тестовые ревю

rws1 < - sapply (1: nrow (testing), function (x) {

if (x %% 20 == 0) print (paste (x, "tweet processed"))

rw < - testing [x,2]

rw < - tokenize (rw)

rw < - rw [nchar (rw) >1]

rw < - rw [! rw %in% stopWords]

paste (rw, collapse=" ")

})

rw < - testing [7,2]

rw=system ("/Users/Sivakova/r/dissertation/mystem - cl", intern = TRUE, input = rw)

# Формируем вектор ревю, строим корпус, формируем матрицу документы/термины ###

test_vector < - VectorSource (rws)

test_corpus < - Corpus (test_vector,

readerControl = list (language = "ru"))

test_bag < - DocumentTermMatrix (test_corpus,

control=list (stemming=TRUE,

dictionary = vocab))

l < - nrow (test_bag)

test_df < - data. frame (inspect (test_bag [1: l,]))

sentiment < - rep (0, l)

test_df < - cbind (testing [1: l,2], sentiment, test_df [])

names (test_df) [1] < - "text"

# Прогнозируем сентимент ###################################

length (test_df [1,])

test_df [,2] < - predict (forest, newdata = test_df [,-2])

table (test_df [,2], testing [,2])

testing [,2]

test_df [,2] < - predict (forest, newdata = test_df [-1])

# Сохраняем результата в csv

write. csv (test_df [,1: 2], file="Submission. csv",

quote=FALSE,

row. names=FALSE)

Размещено на Allbest.ru