Введение
Классификация документов по определенному списку категорий может дать ценную информацию и, возможно, сделать документы более управляемыми. Классификация документов — одна из областей применения машинного обучения. Обработка естественного языка (NLP) и методы машинного обучения могут использоваться для автоматизации классификации документов, таких как электронные письма (категории ветчины/спама), статьи, книги, ответы на вопросы опроса, настроения, обзоры продуктов (отрицательные/положительные) и т. д.
Есть несколько очень хороших алгоритмов, которые могут автоматически обрабатывать текстовые данные. В этом сообщении блога я хотел бы поэкспериментировать с моделями машинного обучения регуляризованной логистической регрессии для классификации рефератов.
Меня интересует предсказание рефератов, которые попадут в категории «SARS_2003» и «COVID_19». Для этой задачи я буду использовать те же наборы данных, которые я использовал в своих предыдущих сообщениях в блоге. Я сохранил справочные файлы в Excel из моего предыдущего поста. Я просто загружу этот файл Excel и поиграю с рефератом, используя пакеты qunateda и glmnet. 😍
Данные
Я загружаю данные и вижу сводку по количеству символов, использованных для написания тезисов. Для этого анализа я буду использовать только тезисы, имеющие 200 символов. Я просто отфильтрую абстракции на нижней стороне экстремума.
Проверьте количество документов covid/sars
Рефераты covid изначально были помечены как «включенные», а рефераты sars — как «исключенные». Я просто создам переменную категории и изменю метки на «covid» или «sars». Около 52% тезисов имеют пометку «covid», остальные — «sars».
covid_sars$category <- covid_sars$Include covid_sars$category[covid_sars$category=="included"]<-"covid" covid_sars$category[covid_sars$category=="not included"]<-"sars"table(covid_sars$category)covid sars 506 464round(table(covid_sars$category) %>% prop.table()*100, 1)covid sars 52.2 47.8
Разделить данные
Прежде чем мы предпримем какие-либо шаги в текстовом анализе, рекомендуется разделить данные. Разделение данных после токенизации — не лучший подход. Итак, вместо этого мы разделим данные на обучающие и тестовые наборы, токенизируем обучающие и тестовые наборы отдельно, построим модели, сопоставим переменные тестового набора данных с поездом. Наконец, мы предскажем тестовые данные, а затем оценим наши прогнозы.
library(caret) #For splittingset.seed(1234)trainIndex <- createDataPartition(covid_sars$category, p = .8, list = FALSE, times = 1)train <- covid_sars[trainIndex,] test <- covid_sars[-trainIndex,]table(train$category)covid sars 405 372table(test$category)covid sars 101 92nrow(train)[1] 777
Текстовый анализ
Если вас интересует текстовый анализ, рекомендую посетить сайт Quanteda. Quanteda — отличный пакет для анализа текста. Одним из больших преимуществ Quanteda является то, что он очень быстрый и имеет так много мощных функций. Я пробовал пять разных пакетов R для текстовых данных. Основываясь на личном вкусе, я бы расположил их следующим образом: Quanteda, txt2vec, tidytext, tm.
Создать корпус
require(quanteda)#Train data tr <- train[, 6] # the sixth variable is unique label. I will use it as identifier. traincorpus <- corpus(train$abstract, docvars = data.frame(trainvars=names(tr))) #Test data ts <- test[, 6]testcorpus <- corpus(test$abstract, docvars = data.frame(testvars=names(ts))) summary(traincorpus,2)Corpus consisting of 777 documents, showing 2 documents:Text Types Tokens Sentences trainvars text1 165 337 11 label text2 94 164 5 label# Connect the labels with the corpuses docid_train <- train$labeldocnames(traincorpus) <- docid_train head(traincorpus,1)Corpus consisting of 1 document and 1 docvar. Ataguba2020 : "The coronavirus disease 2019 (COVID-19) pandemic has affecte..."docid_test <- test$label docnames(testcorpus) <- docid_testsummary(testcorpus, 2)Corpus consisting of 193 documents, showing 2 documents:Text Types Tokens Sentences testvars Coccia2020 264 782 12 label Cagliani2020 182 337 16 labelsummary(traincorpus, 4)Corpus consisting of 777 documents, showing 4 documents:Text Types Tokens Sentences trainvars Ataguba2020 165 337 11 label Sigala2020 94 164 5 label Lechner2020 103 160 7 label Okba2020 118 176 6 label
Токенизировать
traintokens <- tokens(traincorpus, remove_punct = TRUE, remove_url = TRUE, remove_numbers = TRUE)traintokens <- tokens_remove(traintokens, pattern=stopwords('en'))testtokens <- tokens(testcorpus, remove_punct = TRUE, remove_url = TRUE, remove_numbers = TRUE)testtokens <- tokens_remove(testtokens, pattern=stopwords('en'))
Построить объекты DFM
dfmat_train <- dfm(traintokens)dfmat_test <- dfm(testtokens)head(dfmat_train,2)Document-feature matrix of: 2 documents, 12,119 features (99.2% sparse) and 1 docvar. features docs coronavirus disease covid-19 pandemic affected many Ataguba2020 2 2 6 3 1 7 Sigala2020 0 0 4 1 0 0 features docs countries increasing morbidity mortality Ataguba2020 7 1 2 1 Sigala2020 0 0 0 0 [ reached max_nfeat ... 12,109 more features ]head(dfmat_test,2)Document-feature matrix of: 2 documents, 5,484 features (97.0% sparse) and 1 docvar. features docs study two goals first explain geo-environmental Coccia2020 3 1 1 1 1 1 Cagliani2020 0 0 0 0 0 0 features docs determinants accelerated diffusion covid-19 Coccia2020 1 3 3 9 Cagliani2020 0 0 0 0 [ reached max_nfeat ... 5,474 more features ]
Обучающие данные содержат 12 119 признаков и разреженность 99,2%, в то время как тестовые данные содержат 5484 признака и разреженность 97%. Я не буду делать ничего, чтобы уменьшить разреженность. Но, возможно, вам придется это сделать, если у вас есть большое количество наблюдений. dfm_trim() от Quanteda может сделать это за вас.
Известно, что взвешивание TF-IDF улучшает эффективность прогнозирования. Я буду использовать это и здесь.
dfmat_train_tfidf <- dfm_tfidf(dfmat_train)
dfmat_test_tfidf <- dfm_tfidf(dfmat_test)Давайте проверим два данных tfidf, которые были созданы выше.
head(dfmat_train_tfidf, 2)Document-feature matrix of: 2 documents, 12,119 features (99.2% sparse) and 1 docvar. features docs coronavirus disease covid-19 pandemic affected Ataguba2020 0.86811 0.8990239 2.287311 1.8627242 1.182851 Sigala2020 0 0 1.524874 0.6209081 0 features docs many countries increasing morbidity mortality Ataguba2020 7.450424 6.911317 1.475448 3.319944 1.126993 Sigala2020 0 0 0 0 0 [ reached max_nfeat ... 12,109 more features ]head(dfmat_test_tfidf,2)Document-feature matrix of: 2 documents, 5,484 features (97.0% sparse) and 1 docvar. features docs study two goals first explain Coccia2020 1.659491 0.870584 1.808436 0.7057737 1.984527 Cagliani2020 0 0 0 0 0 features docs geo-environmental determinants accelerated diffusion Coccia2020 2.285557 2.285557 5.953582 5.425308 Cagliani2020 0 0 0 0 features docs covid-19 Coccia2020 3.642693 Cagliani2020 0 [ reached max_nfeat ... 5,474 more features ]
Построение модели
Почему не логистическая регрессия?
Мои данные имеют две метки классов (covid vs sars) и все числовые характеристики. Тогда почему бы не логистическая регрессия? Что ж, линейные модели обеспечивают отличные подходы к прогнозному моделированию при условии, что предположения выполняются! Эти предположения (например, гемоцидность дисперсии) нарушаются, когда у нас больше признаков, чем наблюдений (например, в генетических исследованиях и анализе текста это часто бывает). Применение линейных моделей к таким данным приводит к смещенным коэффициентам, более слабым показателям эффективности прогнозирования, переобучению или проблемам с высокой ошибкой прогнозирования вне выборки. Следовательно, было разработано наложение штрафа на оценочные коэффициенты модели. Этот метод наказания линейных моделей называется «Регуляризация». Существует три наиболее часто используемых подхода к регуляризации для логистической регрессии: Ridge, LASSO и Elastic Net.
В штрафе по хребту оценочные коэффициенты модели штрафуются добавлением следующего параметра. ССЭ
SSE=∑i=1n(yi−y^i)2 SSE=∑i=1n(yi−y^i)2
ССЭ+λ∑j=1pβ2j ССЭ+λ∑j=1pβj2
Это называется нормой L². Из приведенного выше уравнения, если лямбда равна 0, модель будет равна обычной модели наименьших квадратов. По мере приближения к бесконечности штраф заставит коэффициенты модели быть ближе к нулю, но не полностью к 0. Известно, что штраф за гребень систематически обрабатывает сильно коррелированные признаки. В штрафе Лассо коэффициенты модели штрафуются по норме L1 следующим образом.
SSE+λ∑j=1p|βj|SSE+λ∑j=1p|βj|
Штраф лассо, в отличие от гребня, сводит все коэффициенты к нулю. Преимущество Lasso заключается в том, что он повышает производительность модели, а также автоматизирует выбор функций. Только важные функции будут сохранены в окончательной модели.
Эластичная сетка сочетает в себе параметры штрафа Lasso и Ridge. Эластичная сеть использует преимущества как штрафа Лассо, так и штрафа Риджа: эффективная регуляризация за счет автоматического выбора признаков, а также эффективная обработка коррелирующих признаков.
Реализации
Вероятно, самым популярным пакетом для реализации регуляризованных моделей является пакет glmnet. Этот пакет молниеносно настраивает модели с перекрестной проверкой. Я посмотрел один очень хороший обучающий вебинар от доктора Тревора Хасти (одного из авторов этого пакета). Он упомянул, что он быстрый, потому что он запрограммирован на Фортране. Я приглашаю вас посмотреть этот отличный вебинар здесь, который я возглавлял, я слышал, что есть и другие пакеты, такие как H2O и elastic net. Я никогда не пробовал ни один из них.
Для регуляризованных моделей у нас есть два основных параметра настройки: альфа и лямбда. В ridge и Lasso лямбда является единственным параметром настройки, но альфа устанавливается на 0 и 1 соответственно. Для настройки лямбда функция cv.glmnet() предоставляет 100 различных значений лямбда, управляемых данными, и больше ничего делать не нужно. Поскольку эластичная сеть сочетает в себе как штраф Лассо, так и Ридж, у нас будет два параметра настройки: альфа и лямбда. Альфа может принимать числовые значения от 0 до 1, в то время как лямбда может иметь 100 различных значений лямбда, управляемых данными, просто используя функцию cv.glmnet().
Все модели требуют, чтобы данные были в матричной форме. Хорошая вещь с Quanteda заключается в том, что матрица признаков документа уже является матричным объектом, и нам не нужно менять структуру наших данных. Обратите внимание на время, необходимое для настройки алгоритмов перекрестной проверки.
хребет
# Ridge regression library(glmnet) ridge_1 <- glmnet(x = dfmat_train, y = train$category, alpha = 0, family = "binomial") #tfidf ridge_1_tfidf <- glmnet(x = dfmat_train_tfidf, y = train$category, alpha = 0, family = "binomial")par(mfrow = c(1, 2)) plot(ridge_1, xvar="lambda", main="Ridge penalty\n\n") plot(ridge_1_tfidf, xvar="lambda", main="Ridge penalty tfidf\n\n")
x <- Sys.time()set.seed(123) ridge_min <- cv.glmnet(x=dfmat_train, y=train$category, family="binomial", alpha=0, # alpha = 0 for ridge regression parallel=TRUE, intercept=TRUE)
Снова используя взвешенные данные tf-idf
set.seed(123) ridge_min_tfidf <- cv.glmnet(x=dfmat_train_tfidf, y=train$category, family="binomial", alpha=0, # alpha = 0 for ridge regression parallel=TRUE, intercept=TRUE)par(mfrow = c(1, 2)) plot(ridge_min, main="Ridge penalty\n\n") plot(ridge_min_tfidf, main="Ridge penalty_tfidf\n\n")
Sys.time() - xTime difference of 25.16045 secs
Давайте построим результаты
par(mfrow = c(1, 2)) plot(ridge_1, xvar = "lambda", main = "Ridge penalty\n\n") abline(v=log(ridge_min$lambda.min), col = "red", lty = "dashed") abline(v=log(ridge_min$lambda.1se), col = "blue", lty = "dashed")plot(ridge_1_tfidf, xvar = "lambda", main = "Ridge penalty tfidf\n\n") abline(v=log(ridge_min_tfidf$lambda.min), col = "red", lty = "dashed") abline(v=log(ridge_min_tfidf$lambda.1se), col = "blue", lty = "dashed")
Предсказать наборы тестовых данных
Прежде чем мы предскажем тестовые данные, нам нужно сделать один очень важный шаг. Мы будем прогнозировать тестовые данные на основе данных, на которых обучалась модель. Таким образом, функции тестовых данных должны совпадать с функциями обучающих данных. В противном случае предсказание не сработает. Модель ничего не может понять, кроме тех признаков, которые были в обучающих данных. Это очень важный шаг в прогнозировании текста. Quanteda предоставляет для этого замечательную функцию: dfm_match(). Он подмножает функции тестовых данных, которые были частью обучающих данных.
dfmat_matched <- dfm_match(dfmat_test,
features = featnames(dfmat_train))
# Match the tfi-idf
dfmat_matched_tfidf <- dfm_match(dfmat_test_tfidf,
features = featnames(dfmat_train_tfidf))Для предсказания я буду использовать лучшую модель из моделей с перекрестной проверкой. Наилучшая модель находится между моделью, имеющей минимальное значение лямбда, и моделью, имеющей значение лямбда в пределах 1 с. Здесь я буду использовать минимальное значение лямбды.
# Predict ridge_minCall: cv.glmnet(x = dfmat_train, y = train$category, parallel = TRUE, family = "binomial", alpha = 0, intercept = TRUE)Measure: Binomial DevianceLambda Measure SE Nonzero min 3.060 1.023 0.01754 12119 1se 3.518 1.040 0.01666 12119ridge_min$lambda.1se[1] 3.518117ridge_min$lambda.min[1] 3.059879actual_class <- as.factor(test$category) predicted_class.ridge <- predict(ridge_min, newx=dfmat_matched,s="lambda.min", type="class")tab_class.ridge <- table(predicted_class.ridge, actual_class)confusionmatrix_ridge <- confusionMatrix(tab_class.ridge, mode="everything", positive="covid")##tfidf ridge_min_tfidfCall: cv.glmnet(x = dfmat_train_tfidf, y = train$category, parallel = TRUE, family = "binomial", alpha = 0, intercept = TRUE)Measure: Binomial DevianceLambda Measure SE Nonzero min 3.060 1.023 0.01754 12119 1se 3.518 1.040 0.01666 12119ridge_min_tfidf$lambda.1se[1] 3.518117ridge_min_tfidf$lambda.min[1] 3.059879actual_class_tfidf <- as.factor(test$category) predicted_class.ridge_tfidf <- predict(ridge_min_tfidf, newx=dfmat_matched_tfidf, s="lambda.min", type="class")tab_class.ridge_tfidf <- table(predicted_class.ridge_tfidf, actual_class)confusionmatrix_ridge_tfidf <- confusionMatrix(tab_class.ridge_tfidf, mode="everything", positive="covid")confusionmatrix_ridgeConfusion Matrix and Statisticsactual_class predicted_class.ridge covid sars covid 85 17 sars 16 75 Accuracy : 0.829 95% CI : (0.7683, 0.8793) No Information Rate : 0.5233 P-Value [Acc > NIR] : <2e-16 Kappa : 0.6571 Mcnemar's Test P-Value : 1 Sensitivity : 0.8416 Specificity : 0.8152 Pos Pred Value : 0.8333 Neg Pred Value : 0.8242 Precision : 0.8333 Recall : 0.8416 F1 : 0.8374 Prevalence : 0.5233 Detection Rate : 0.4404 Detection Prevalence : 0.5285 Balanced Accuracy : 0.8284 'Positive' Class : covidconfusionmatrix_ridge_tfidfConfusion Matrix and Statisticsactual_class predicted_class.ridge_tfidf covid sars covid 86 17 sars 15 75 Accuracy : 0.8342 95% CI : (0.7741, 0.8837) No Information Rate : 0.5233 P-Value [Acc > NIR] : <2e-16 Kappa : 0.6673 Mcnemar's Test P-Value : 0.8597 Sensitivity : 0.8515 Specificity : 0.8152 Pos Pred Value : 0.8350 Neg Pred Value : 0.8333 Precision : 0.8350 Recall : 0.8515 F1 : 0.8431 Prevalence : 0.5233 Detection Rate : 0.4456 Detection Prevalence : 0.5337 Balanced Accuracy : 0.8334 'Positive' Class : covid
Видите ли, все функции сохранены в окончательных моделях. Глядя на характеристики прогнозирования двух, мы видим, что данные, взвешенные по tfidf, имеют лучшую производительность. Мы попробуем Lasso, если сможем это улучшить.
Лассо пенальти
## Lasso model lasso_1 <- glmnet(x = dfmat_train, y = train$category, alpha = 1, family = "binomial", type.measure="class")lasso_1_tfidf <- glmnet(x = dfmat_train, y = train$category, alpha = 1, family = "binomial", type.measure="class")par(mfrow=c(1,2))plot(lasso_1, xvar="lambda", main="Lasso penalty\n\n") plot(lasso_1_tfidf, xvar="lambda", main="Lasso penalty tfidf\n\n")
x <- Sys.time() #registerDoMC(cores=2) # parallelize to speed up set.seed(123) lasso <- cv.glmnet(x=dfmat_train, y=train$category, family="binomial", alpha=1, # alpha = 1: LASSO parallel=TRUE, nfolds = 10, intercept=TRUE)# tfidf set.seed(123) lasso_tfidf <- cv.glmnet(x=dfmat_train_tfidf, y=train$category, family="binomial", alpha=1, # alpha = 1: LASSO parallel=TRUE, nfolds = 10, intercept=TRUE)Sys.time() -xTime difference of 8.289953 secslassoCall: cv.glmnet(x = dfmat_train, y = train$category, nfolds = 10, parallel = TRUE, family = "binomial", alpha = 1, intercept = TRUE)Measure: Binomial DevianceLambda Measure SE Nonzero min 0.02369 0.4939 0.02139 65 1se 0.03132 0.5107 0.01893 16lasso_tfidfCall: cv.glmnet(x = dfmat_train_tfidf, y = train$category, nfolds = 10, parallel = TRUE, family = "binomial", alpha = 1, intercept = TRUE)Measure: Binomial DevianceLambda Measure SE Nonzero min 0.02369 0.4939 0.02139 69 1se 0.03132 0.5107 0.01893 16# Plot lasso without cv and with cv to mark lamda.min and lamda.1separ(mfrow=c(1,2)) plot(lasso_1, xvar="lambda", main="Lasso penalty \n\n") abline(v=log(lasso$lambda.min), col="red", lty="dashed") abline(v=log(lasso$lambda.1se), col="blue", lty="dashed")plot(lasso_1_tfidf, xvar="lambda", main="Lasso penalty tfidf \n\n") abline(v=log(lasso_tfidf$lambda.min), col="red", lty="dashed") abline(v=log(lasso_tfidf$lambda.1se), col="blue", lty="dashed")
par(mfrow=c(1,2))
plot(lasso,main="Lasso penalty\n\n")
plot(lasso_tfidf,main="Lasso penalty tfidf\n\n")
# Predict lassoCall: cv.glmnet(x = dfmat_train, y = train$category, nfolds = 10, parallel = TRUE, family = "binomial", alpha = 1, intercept = TRUE)Measure: Binomial DevianceLambda Measure SE Nonzero min 0.02369 0.4939 0.02139 65 1se 0.03132 0.5107 0.01893 16lasso_tfidfCall: cv.glmnet(x = dfmat_train_tfidf, y = train$category, nfolds = 10, parallel = TRUE, family = "binomial", alpha = 1, intercept = TRUE)Measure: Binomial DevianceLambda Measure SE Nonzero min 0.02369 0.4939 0.02139 69 1se 0.03132 0.5107 0.01893 16lasso$lambda.1se[1] 0.03131881lasso$lambda.min[1] 0.02369153actual_class <- as.factor(test$category) predicted_class.lasso <- predict(lasso, newx=dfmat_matched,s="lambda.min", type="class")tab_class.lasso <- table(predicted_class.lasso, actual_class)confusion_matrix_lasso <- confusionMatrix(tab_class.lasso, mode="everything", positive="covid")##tfidf lasso_tfidf$lambda.1se[1] 0.03131881lasso_tfidf$lambda.min[1] 0.02369153actual_class_tfidf <- as.factor(test$category) predicted_class.lasso_tfidf <- predict(lasso_tfidf, newx=dfmat_matched_tfidf,s="lambda.min", type="class")tab_class.lasso_tfidf <- table(predicted_class.lasso_tfidf, actual_class)confusion_matrix_lasso_tfidf <- confusionMatrix(tab_class.lasso_tfidf, mode="everything", positive="covid")confusion_matrix_lassoConfusion Matrix and Statisticsactual_class predicted_class.lasso covid sars covid 100 11 sars 1 81 Accuracy : 0.9378 95% CI : (0.8939, 0.9675) No Information Rate : 0.5233 P-Value [Acc > NIR] : < 2.2e-16 Kappa : 0.8748 Mcnemar's Test P-Value : 0.009375 Sensitivity : 0.9901 Specificity : 0.8804 Pos Pred Value : 0.9009 Neg Pred Value : 0.9878 Precision : 0.9009 Recall : 0.9901 F1 : 0.9434 Prevalence : 0.5233 Detection Rate : 0.5181 Detection Prevalence : 0.5751 Balanced Accuracy : 0.9353 'Positive' Class : covidconfusion_matrix_lasso_tfidfConfusion Matrix and Statisticsactual_class predicted_class.lasso_tfidf covid sars covid 100 11 sars 1 81 Accuracy : 0.9378 95% CI : (0.8939, 0.9675) No Information Rate : 0.5233 P-Value [Acc > NIR] : < 2.2e-16 Kappa : 0.8748 Mcnemar's Test P-Value : 0.009375 Sensitivity : 0.9901 Specificity : 0.8804 Pos Pred Value : 0.9009 Neg Pred Value : 0.9878 Precision : 0.9009 Recall : 0.9901 F1 : 0.9434 Prevalence : 0.5233 Detection Rate : 0.5181 Detection Prevalence : 0.5751 Balanced Accuracy : 0.9353 'Positive' Class : covid
В итоге лучшая модель сохраняет 65 переменных. Если бы мы использовали взвешивание tf-idf, лучшая модель сохранила бы 69 из 1219 переменных. Это отличный способ уменьшить нерелевантные функции. Мы можем взглянуть на некоторые из этих переменных, используя файл vippackage. VIP-ранги на основе их показателей важности.
library(vip)
vip(lasso_tfidf, 10)
Давайте посмотрим, являются ли эти переменные также основными функциями в модели хребта.
vip(ridge_min_tfidf, 10)
Эластичная сетка
В своем опыте работы с текстовыми данными я обнаружил, что регрессия эластичной сети имеет проблемы с матричным форматом объектов dfm, полученных в результате Quanteda. Мне придется преобразовать матричные форматы в фреймы данных.
da_train <- cbind(category=train$category, convert(dfmat_train, to="data.frame"))da_train_tfidf <- cbind(category=train$category, convert(dfmat_train_tfidf, to="data.frame"))ncol(dfmat_train)[1] 12119ncol(da_train)[1] 12121da_train <- da_train[,-2] #the document identifier variable should be removed ncol(da_train)[1] 12120## The tfidf version ncol(dfmat_train_tfidf)[1] 12119ncol(da_train_tfidf)[1] 12121da_train_tfidf <- da_train_tfidf[,-2] #the document identifier variable should be removed ncol(da_train_tfidf)[1] 12120da_train_xmatrix <- da_train[,-1] %>% as.data.frame() %>% as.matrix() da_train_xdf <- da_train %>% as.data.frame()#for the tf-idf pre-processed datada_train_xmatrix_tfidf <- da_train_tfidf[,-1] %>% as.data.frame() %>% as.matrix()da_train_xdf_tfidf <- da_train_tfidf %>% as.data.frame()da_test_match <- cbind(category=test$category, convert(dfmat_matched, to="data.frame"))da_test_match <- da_test_match[,-2] ncol(da_test_match)[1] 12120da_test_xmatrix <- da_test_match[,-1] %>% as.data.frame() %>% as.matrix() ncol(dfmat_matched)[1] 12119ncol(da_test_xmatrix)[1] 12119# Do the same for the tfidf datada_test_match_tfidf <- cbind(category=test$category, convert(dfmat_matched_tfidf, to="data.frame"))da_test_match_tfidf <- da_test_match_tfidf[,-2] #the document identifier variable should be removed ncol(da_test_match_tfidf)[1] 12120da_test_xmatrix_tfidf <- da_test_match_tfidf[,-1] %>% as.data.frame() %>% as.matrix() # remove the dependent variablencol(dfmat_matched_tfidf)[1] 12119ncol(da_test_xmatrix_tfidf)[1] 12119# Fit elastic net regression with 10 different alpha values from 0 to 1x <- Sys.time()set.seed(223) y=ifelse(da_train_xdf$category=="covid", "1", "0") # convert to numeric labels cv_glmnet_10_roc <- train(x = da_train_xdf[,-1], y = y, type.measure="auc", method="glmnet", family="binomial", traControl=trainControl(method="cv", number=10), parallel=TRUE, tuneLength=10) # I will use 10 different alpha values between 0 and 1x-Sys.time()Time difference of -15.31797 mins#tfidf x <- Sys.time()set.seed(223) cv_glmnet_10_roc_tfidf <- train(x = da_train_xdf_tfidf[,-1], y = y, type.measure="auc", method="glmnet", family="binomial", traControl=trainControl(method="cv",number=10), parallel=TRUE, tuneLength=10)x-Sys.time()Time difference of -30.67438 mins
Давайте визуализируем две модели
library(ggplot2)ggplot(cv_glmnet_10_roc)
#Tf-idf
ggplot(cv_glmnet_10_roc_tfidf)
## Predict using the belastic model cv_glmnet_50 predicted_class.elastic_10 <- predict(cv_glmnet_10_roc, da_test_xmatrix, cv_glmnet_10_roc$lamda.min, type="raw")predicted_class.elastic_10 <- as.factor(ifelse(predicted_class.elastic_10==0, "sars", "covid"))confusion_mat_elastic_net <- confusionMatrix(predicted_class.elastic_10, actual_class, mode="everything", positive="covid")#Predict the tfidf weighted datapredicted_class.elastic_10_tfidf <- predict(cv_glmnet_10_roc_tfidf, da_test_xmatrix_tfidf, cv_glmnet_10_tfidf$lamda.min, type="raw")predicted_class.elastic_10_tfidf <- as.factor(ifelse(predicted_class.elastic_10_tfidf==0, "sars", "covid")) confusion_mat_elastic_net_tfidf <- confusionMatrix(predicted_class.elastic_10_tfidf, actual_class, mode="everything", positive="covid")confusion_mat_elastic_netConfusion Matrix and StatisticsReference Prediction covid sars covid 100 11 sars 1 81 Accuracy : 0.9378 95% CI : (0.8939, 0.9675) No Information Rate : 0.5233 P-Value [Acc > NIR] : < 2.2e-16 Kappa : 0.8748 Mcnemar's Test P-Value : 0.009375 Sensitivity : 0.9901 Specificity : 0.8804 Pos Pred Value : 0.9009 Neg Pred Value : 0.9878 Precision : 0.9009 Recall : 0.9901 F1 : 0.9434 Prevalence : 0.5233 Detection Rate : 0.5181 Detection Prevalence : 0.5751 Balanced Accuracy : 0.9353 'Positive' Class : covidconfusion_mat_elastic_net_tfidfConfusion Matrix and StatisticsReference Prediction covid sars covid 100 11 sars 1 81 Accuracy : 0.9378 95% CI : (0.8939, 0.9675) No Information Rate : 0.5233 P-Value [Acc > NIR] : < 2.2e-16 Kappa : 0.8748 Mcnemar's Test P-Value : 0.009375 Sensitivity : 0.9901 Specificity : 0.8804 Pos Pred Value : 0.9009 Neg Pred Value : 0.9878 Precision : 0.9009 Recall : 0.9901 F1 : 0.9434 Prevalence : 0.5233 Detection Rate : 0.5181 Detection Prevalence : 0.5751 Balanced Accuracy : 0.9353 'Positive' Class : covid
Заключительные замечания
Обратите внимание, модели Lasso и Elastic net дали нам превосходные результаты прогнозирования. Модель с чувствительностью 99 %, специфичностью 88 % и точностью более 90 % превосходит меня! Распространенность не влияет на чувствительность и специфичность. Но точность (положительная прогностическая ценность) и отрицательная прогностическая ценность зависят от распространенности. Можно рассчитать доверительные интервалы для чувствительности и специфичности. Но я не буду этого делать здесь. Поскольку распространенность рефератов covid высока (52%), точность всех моих прогностических моделей высока. Это может быть не так, если ваша модель имеет дело с редкими случаями.
Эта книга Брэдли Бёмке и Брэндона Гринвелла — хороший справочник по машинному обучению. Он находится в свободном доступе. Но вы также можете купить печатную копию. Это одна из моих любимых книг по машинному обучению.
Спасибо, за то что прочитали эту статью. Я надеюсь, что вы найдете это полезным. Чтобы узнать больше, подпишитесь на мой канал YouTube и следите за мной в Твиттере @RPy_DataScience. Вы также можете подписаться на меня, поставив лайк странице Facebook R_Py Data Science.
Контакт
Пожалуйста, укажите @RPy_DataScience, если вы твитите этот пост.
