Deep Learning with Keras via Artificial Neural Network
Bank Task 1 - Regression Problem for Automatic Pricing of Cars
Alexander Rodionov
02 Апрель 2018
1 Описание проблемы
Один из казахстанских банков предлагает задачу для соискателей на должности аналитиков-программистов. В первой задаче имеются данные по ценам продаж подержанных автомобилей. Набор по автомобилям содержит 6 000 тренировочных наблюдений по 17 характеристикам: 6 интервальных числовых признаков и 10 номинальных признаков, а также искомый числовой признак - цена автомобиля в казахстанских тенге. Также в отдельном листе книги MS Excel содержится 3 249 тестовых наблюдений. Кратко опишем имеющиеся признаки.
- YEAR – возраст авто (год оценки – год выпуска авто)
- VIN – неполный ВИН-код и далее каждый из 17 символов в отдельности
- ENGINE_VOLUME – объем двигателя
- FUEL_TYPE – тип топлива
- BODY_TYPE – тип кузова
- TYPE_OF_DIVE – тип привода
- INTERIOR_TYPE – тип салона
- TRANSM_TYPE – тип КПП
- AUTO_CONDITION – тех. состояние авто
- AVG_COST – средн. рыночная стоимость
1.1 Загрузка данных
Поскольку синтетический признак Идентификационный номер транспортного средства (англ. "Vehicle identification number, VIN") состоит из 17 символов, первые три их которых обозначают Всемирный код изготовителя, а последние три - Серийный номер, то признаки "VIN_15", "VIN_16", "VIN_17" мы исключаем из исследования, а первые три символа объединяем в один - WMI. Также не учитываются порядковые номера автомобилей в наборе данных - ID.
## load packages
library('tidyverse')## -- Attaching packages --------------------------------------------------------------------------------- tidyverse 1.2.1 --## v ggplot2 2.2.1 v purrr 0.2.4
## v tibble 1.4.2 v dplyr 0.7.4
## v tidyr 0.7.2 v stringr 1.2.0
## v readr 1.1.1 v forcats 0.2.0## -- Conflicts ------------------------------------------------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library('caret')## Loading required package: lattice##
## Attaching package: 'caret'## The following object is masked from 'package:purrr':
##
## lift## A data frame containing 17 features: 6 numeric and 10 nominal predictors & continues outcome.
destfile <- "C:/Soft/R/Examples/caret/task1.xlsx"
DF1 <- readxl::read_excel( path = destfile, col_names = TRUE, sheet = "TRAIN" )
DF2 <- readxl::read_excel( path = destfile, col_names = TRUE, sheet = "TEST" )
DF <- bind_rows(DF1, DF2)
DF$WMI <- paste0(DF$VIN_1, DF$VIN_2, DF$VIN_3)
str(DF)## Classes 'tbl_df', 'tbl' and 'data.frame': 9249 obs. of 18 variables:
## $ ID : num 0 1 2 3 4 5 6 7 8 9 ...
## $ YEAR : num 9 10 17 4 17 9 13 8 10 8 ...
## $ VIN_1 : chr "J" "N" "W" "K" ...
## $ VIN_2 : chr "M" "M" "A" "M" ...
## $ VIN_3 : chr "Y" "T" "U" "H" ...
## $ VIN_15 : num 1 1 8 9 4 9 4 9 0 7 ...
## $ VIN_16 : num 0 8 9 1 3 1 1 4 0 8 ...
## $ VIN_17 : num 2 0 7 8 1 5 6 1 5 4 ...
## $ ENGINE_VOLUME : num 3 1.6 2.4 1.6 3 3 2 3 2.4 2 ...
## $ FUEL_TYPE : chr "Бензин-Газ" "Бензин" "Бензин" "Бензин" ...
## $ BODY_TYPE : chr "Внедорожник" "Седан" "Седан" "Седан" ...
## $ TYPE_OF_DRIVE : chr "Полный привод" "Передний привод" "Передний привод" "Передний привод" ...
## $ INTERIOR_TYPE : chr "КОЖА" "ВЕЛЮР" "ВЕЛЮР" "ВЕЛЮР" ...
## $ TRANSM_TYPE : chr "АКПП" "МКПП" "АКПП" "АКПП" ...
## $ AUTO_CONDITION: chr "Удовлетворительное" "Удовлетворительное" "Удовлетворительное" "Отличное" ...
## $ AVG_COST : num 5725926 2211538 1260976 3287778 2028916 ...
## $ ESTIM_COST : num 4688000 1853000 1000000 3150000 1603000 ...
## $ WMI : chr "JMY" "NMT" "WAU" "KMH" ...## To list all columns with missing values you might write:
is.na(DF) %>% colSums() ## ID YEAR VIN_1 VIN_2 VIN_3
## 0 0 1 1 1
## VIN_15 VIN_16 VIN_17 ENGINE_VOLUME FUEL_TYPE
## 9 9 18 0 0
## BODY_TYPE TYPE_OF_DRIVE INTERIOR_TYPE TRANSM_TYPE AUTO_CONDITION
## 0 0 0 0 0
## AVG_COST ESTIM_COST WMI
## 0 3249 0## Transform character features into factor
DF <- DF %>% mutate_if(is.character, as.factor)
X <- select(DF, -one_of(c("ID", "VIN_1", "VIN_2", "VIN_3", "VIN_15", "VIN_16", "VIN_17", "ESTIM_COST")))
Y <- DF$ESTIM_COST
## Accuracy `ESTIM_COST` versus `AVG_COST`
result.df <- cbind(forecast::accuracy((DF1$AVG_COST), (DF1$ESTIM_COST)),
data_frame(APE = abs(DF1$ESTIM_COST - DF1$AVG_COST)/ DF1$ESTIM_COST) %>%
filter(APE < 0.1) %>% dim(.) / dim(DF1)[1] * 100 %>% data_frame() %>% setNames (., "SuccessRate")
)
row.names(result.df) <- c("Training Set before Machine Learning")
## Results before Machine Learning
print(result.df)## ME RMSE MAE MPE
## Training Set before Machine Learning -416776.5 542929.2 441851.1 -14.92305
## MAPE SuccessRate
## Training Set before Machine Learning 15.48488 32.01667Обращаем внимание, что предиктор AVG_COST очень близок исковому значению ESTIM_COST - их корреляция Пирсона равен 0.9873. Но для успешного выполнения задания нужно, чтобы более 78% проставленных оценок в витрине TEST были в диапазоне +/- 10% от фактических значений.
Следует заметить, что на странице Машинное обучение: Прогноз продаж перечислены общепринятые показатели точности прогноза. Пока же сравнение точности AVG_COST с целевым признаком ESTIM_COST в дает низкое качество, например, MAPE - 15% и лишь 32% проставленных оценок в витрине TRAIN были в диапазоне +/- 10% от фактических значений.
Однако при построении любой модели важно избежать переобучения (англ. "overfitted"), при котором переусложненная модель дает хорошие результаты подгонки на обучающем наборе данных, но часто не способна корректно предсказывать, выйдя за рамки обучения, что не преминет снизить аккуратность в дальнейшем. Построение модели сбалансированной сложности, в которой точность уравновешена с устойчивостью предсказанных значений, является важнейшей задачей развития алгоритмов Машинного обучения.
Поэтому рекомендуется использовать контрольный набор данных (англ. "Testing Set"). Это образец данных, которые мы изымаем при построении модели. Однако мы используем его непосредственно в конце нашего анализа, чтобы подтвердить точность нашей финальной модели. Это тест, который позволит нам понять, испорчены ли наша модель и дать нам уверенность в наших оценках точности (англ. accuracy) по неприменявшемся для её построения данным.
Обучающий набор (inTrain) составит 90% полных исходных данных. Кроме этого мы оставляем собственно проблемный набор данных (inProblem), для которые необходимо предсказать значения ESTIM_COST.
## Split datasets: create a list of 90% of the rows in the original dataset we can use for training
seed = 1991
set.seed(seed)
inTrain1 <- runif(nrow(DF1)) <= 9/10
inTrain = c( inTrain1, rep( FALSE, times = dim(DF2)[1] ) )
inTest = c( !inTrain1, rep( FALSE, times = dim(DF2)[1] ) )
inProblem = c( rep( FALSE, times = dim(DF1)[1] ), rep( TRUE, times = dim(DF2)[1] ) )2 Преобразование данных и Разведочный Анализ
2.1 Преобразование данных
Наконец производим инжениринг характеристик следующими шагами:
Заполняем пропущенные значения, приводим исходные интервальные признаки к одинаковым единицам измерения посредством стандартизации.
Разворачиваем все номинальные признаки в дихотомические, а затем в числовые интервальные, удаляя при этом исходные номинальные признаки.
Исключаем все признаки, которые имеют вариацию близкую нулю. Хотя построению нейронной сети это не помещает, но воспрепятствует проведению корреляционнного анализа.
Во избежании мультиколлинеарности убираем признаки, которые имеют между собой уровень корреляции выше 90%.
##
## Remove Redundant Variables
##
## 1. Imputing Missing Value, Centering, Scaling and Transformation, for example "YeoJohnson"
X <- cbind(X %>% select_if(., is.numeric) %>%
predict(preProcess( ., method = c( "knnImpute", "center", "scale" ) ), newdata = . ),
## 2. Convert factor (nominal and ordered) variables into a full set of dummy integer variables without linear dependencies induced between these predictors
X %>% select_if(., is.factor) %>%
data.frame(predict(dummyVars(" ~ .", data = ., fullRank = TRUE), newdata = .)) %>%
select_if(., is.numeric)
)
## 3. Dropping zero variance predictors: the cutoff for the ratio of the first most common value to the second value. See https://www.mql5.com/ru/articles/2029
nzv <- caret::nearZeroVar( X[inTrain, ], freqCut = 999/1 , saveMetrics= TRUE )
nzv[nzv$nzv,]## freqRatio percentUnique zeroVar nzv
## WMI.1HG 5416.000 0.0369208 FALSE TRUE
## WMI.1XN 0.000 0.0184604 TRUE TRUE
## WMI.2HG 2707.500 0.0369208 FALSE TRUE
## WMI.2S3 5416.000 0.0369208 FALSE TRUE
## WMI.2T3 1353.250 0.0369208 FALSE TRUE
## WMI.3N1 1082.400 0.0369208 FALSE TRUE
## WMI.4F2 5416.000 0.0369208 FALSE TRUE
## WMI.4MB 5416.000 0.0369208 FALSE TRUE
## WMI.4P3 5416.000 0.0369208 FALSE TRUE
## WMI.4US 2707.500 0.0369208 FALSE TRUE
## WMI.5J6 1804.667 0.0369208 FALSE TRUE
## WMI.5N1 1082.400 0.0369208 FALSE TRUE
## WMI.5NP 2707.500 0.0369208 FALSE TRUE
## WMI.5XY 5416.000 0.0369208 FALSE TRUE
## WMI.5YF 1353.250 0.0369208 FALSE TRUE
## WMI.ACA 5416.000 0.0369208 FALSE TRUE
## WMI.AHT 1082.400 0.0369208 FALSE TRUE
## WMI.CU2 0.000 0.0184604 TRUE TRUE
## WMI.CW5 0.000 0.0184604 TRUE TRUE
## WMI.HMT 5416.000 0.0369208 FALSE TRUE
## WMI.IN1 5416.000 0.0369208 FALSE TRUE
## WMI.IN2 5416.000 0.0369208 FALSE TRUE
## WMI.JA3 5416.000 0.0369208 FALSE TRUE
## WMI.JL1 5416.000 0.0369208 FALSE TRUE
## WMI.JM7 1082.400 0.0369208 FALSE TRUE
## WMI.JNB 5416.000 0.0369208 FALSE TRUE
## WMI.JNK 0.000 0.0184604 TRUE TRUE
## WMI.JNL 5416.000 0.0369208 FALSE TRUE
## WMI.JS2 0.000 0.0184604 TRUE TRUE
## WMI.JT3 5416.000 0.0369208 FALSE TRUE
## WMI.JTF 5416.000 0.0369208 FALSE TRUE
## WMI.JTK 2707.500 0.0369208 FALSE TRUE
## WMI.KLA 1804.667 0.0369208 FALSE TRUE
## WMI.KLY 1804.667 0.0369208 FALSE TRUE
## WMI.KM8 1082.400 0.0369208 FALSE TRUE
## WMI.KND 1804.667 0.0369208 FALSE TRUE
## WMI.LGB 5416.000 0.0369208 FALSE TRUE
## WMI.LSV 5416.000 0.0369208 FALSE TRUE
## WMI.MCU 5416.000 0.0369208 FALSE TRUE
## WMI.MMB 2707.500 0.0369208 FALSE TRUE
## WMI.MX1 5416.000 0.0369208 FALSE TRUE
## WMI.NAA 0.000 0.0184604 TRUE TRUE
## WMI.NANANA 5416.000 0.0369208 FALSE TRUE
## WMI.NLA 0.000 0.0184604 TRUE TRUE
## WMI.RKL 5416.000 0.0369208 FALSE TRUE
## WMI.THB 0.000 0.0184604 TRUE TRUE
## WMI.TSM 1804.667 0.0369208 FALSE TRUE
## WMI.TWB 0.000 0.0184604 TRUE TRUE
## WMI.VSA 0.000 0.0184604 TRUE TRUE
## WMI.VSK 1804.667 0.0369208 FALSE TRUE
## WMI.VZJ 0.000 0.0184604 TRUE TRUE
## WMI.WA1 1082.400 0.0369208 FALSE TRUE
## WMI.WBX 5416.000 0.0369208 FALSE TRUE
## WMI.WDC 1082.400 0.0369208 FALSE TRUE
## WMI.WDF 1082.400 0.0369208 FALSE TRUE
## WMI.WV1 5416.000 0.0369208 FALSE TRUE
## WMI.WV2 2707.500 0.0369208 FALSE TRUE
## WMI.X7M 2707.500 0.0369208 FALSE TRUE
## WMI.XMC 5416.000 0.0369208 FALSE TRUE
## WMI.XWF 2707.500 0.0369208 FALSE TRUE
## WMI.XWW 0.000 0.0184604 TRUE TRUE
## WMI.Z6F 1804.667 0.0369208 FALSE TRUE
## WMI.ZMZ 5416.000 0.0369208 FALSE TRUEzv_cols = caret::nearZeroVar( X[inTrain, ], freqCut = 999/1, saveMetrics = FALSE )
print( sprintf("Dropping %d zero variance predictors from %d (fraction=%10.6f)",
length(zv_cols), dim(X[inTrain, ])[2], length(zv_cols)/dim(X[inTrain, ])[2]) )## [1] "Dropping 63 zero variance predictors from 170 (fraction= 0.370588)"zv_cols## [1] 22 25 27 28 31 32 35 37 38 44 45 46 47 50 51 53 54
## [18] 55 56 57 58 59 60 66 69 75 76 77 79 84 89 92 96 97
## [35] 98 101 104 105 106 108 113 114 115 116 118 124 127 128 133 134 135
## [52] 137 140 142 144 148 149 154 157 164 165 166 170if ( length(zv_cols) != 0 ) {
X = X[, -zv_cols]
}
## 4. Remove NUMERIC variables with high correlation (> .90) to others (multicollinearity)
cor.matrix <- cor( sapply( X[inTrain, ], function(x)
{ as.numeric(x) } ) )
cor.high <- findCorrelation(cor.matrix, 0.90)
high.cor.remove <- row.names(cor.matrix)[cor.high]
print( sprintf("Dropping %d predictors due to high correlation to others (multicollinearity) %d (fraction=%10.6f)",
length(high.cor.remove), dim(X[inTrain, ])[2], length(high.cor.remove)/dim(X[inTrain, ])[2]) );## [1] "Dropping 0 predictors due to high correlation to others (multicollinearity) 107 (fraction= 0.000000)"high.cor.remove## character(0)if (length(high.cor.remove) != 0) {
X <- X[, -cor.high]
}
## Remove some other features that do not add useful information for Machine Learning
# names( X )В ходе преобразования после развертывания в дихотомические признаки количество характеристик удалось существенно сократить.
2.2 Описательная статистика
Первый шаг в этом процессе лучше понять проблему, ведь после таких преобразований получено 107 характеристик. Кроме размерности набора данных, т.е количества столбцов и строк в нем, полезно оценить основные свойства признаков, которые отобраны предикторами (минимум, максимум, среднее значение и квартили).
# dimensions of dataset
dim(X[inTrain, ])## [1] 5417 107# take a peek at the first 10 rows of the data
head(X[inTrain, ], n = 10)## YEAR ENGINE_VOLUME AVG_COST FUEL_TYPE.Бензин.Газ FUEL_TYPE.Газ
## 1 0.17529359 0.9899620 0.9634271 1 0
## 2 0.39981796 -0.9766272 -0.6944627 0 0
## 3 1.97148854 0.1471380 -1.1428846 0 0
## 4 -0.94732824 -0.9766272 -0.1867537 0 0
## 5 1.97148854 0.9899620 -0.7806138 0 0
## 6 0.17529359 0.9899620 0.7202618 1 0
## 7 1.07339107 -0.4147446 -0.1991756 0 0
## 8 -0.04923077 0.9899620 0.8598274 0 0
## 9 0.39981796 0.1471380 -0.2989238 0 0
## 10 -0.04923077 -0.4147446 -0.1782452 1 0
## FUEL_TYPE.Гибрид FUEL_TYPE.Дизель BODY_TYPE.Кроссовер BODY_TYPE.Минивэн
## 1 0 0 0 0
## 2 0 0 0 0
## 3 0 0 0 0
## 4 0 0 0 0
## 5 0 0 0 0
## 6 0 0 0 0
## 7 0 0 1 0
## 8 0 0 0 0
## 9 0 0 0 0
## 10 0 0 1 0
## BODY_TYPE.Пикап BODY_TYPE.Седан BODY_TYPE.Универсал
## 1 0 0 0
## 2 0 1 0
## 3 0 1 0
## 4 0 1 0
## 5 0 0 0
## 6 0 1 0
## 7 0 0 0
## 8 0 0 0
## 9 0 1 0
## 10 0 0 0
## BODY_TYPE.Хэтчбек.Лифтбек TYPE_OF_DRIVE.Передний.привод
## 1 0 0
## 2 0 1
## 3 0 1
## 4 0 1
## 5 0 0
## 6 0 0
## 7 0 0
## 8 0 0
## 9 0 1
## 10 0 0
## TYPE_OF_DRIVE.Полный.привод INTERIOR_TYPE.КОЖА
## 1 1 1
## 2 0 0
## 3 0 0
## 4 0 0
## 5 1 1
## 6 0 1
## 7 1 1
## 8 1 1
## 9 0 0
## 10 1 0
## INTERIOR_TYPE.КОМБИНИРОВАННЫЙ TRANSM_TYPE.МКПП
## 1 0 0
## 2 0 1
## 3 0 0
## 4 0 0
## 5 0 0
## 6 0 0
## 7 0 0
## 8 0 0
## 9 0 0
## 10 0 0
## AUTO_CONDITION.Удовлетворительное AUTO_CONDITION.Хорошее WMI.1FM
## 1 1 0 0
## 2 1 0 0
## 3 1 0 0
## 4 0 0 0
## 5 1 0 0
## 6 1 0 0
## 7 1 0 0
## 8 0 0 0
## 9 0 1 0
## 10 0 0 0
## WMI.1N4 WMI.1NX WMI.1YV WMI.2T1 WMI.2T2 WMI.3VW WMI.4A3 WMI.4JG WMI.4S3
## 1 0 0 0 0 0 0 0 0 0
## 2 0 0 0 0 0 0 0 0 0
## 3 0 0 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0 0 0
## 5 0 0 0 0 0 0 0 0 0
## 6 0 0 0 0 0 0 0 0 0
## 7 0 0 0 0 0 0 0 0 0
## 8 0 0 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0 0 0
## 10 0 0 0 0 0 0 0 0 0
## WMI.4S4 WMI.4T1 WMI.4T3 WMI.4T4 WMI.5TD WMI.5UX WMI.6T1 WMI.JA4 WMI.JF1
## 1 0 0 0 0 0 0 0 0 0
## 2 0 0 0 0 0 0 0 0 0
## 3 0 0 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0 0 0
## 5 0 0 0 0 0 0 0 1 0
## 6 0 0 0 0 0 0 0 0 0
## 7 0 0 0 0 0 0 0 0 0
## 8 0 0 0 0 0 0 0 0 0
## 9 0 1 0 0 0 0 0 0 0
## 10 0 0 0 0 0 0 0 0 0
## WMI.JF2 WMI.JHL WMI.JHM WMI.JM1 WMI.JM3 WMI.JMB WMI.JMY WMI.JMZ WMI.JN1
## 1 0 0 0 0 0 0 1 0 0
## 2 0 0 0 0 0 0 0 0 0
## 3 0 0 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0 0 0
## 5 0 0 0 0 0 0 0 0 0
## 6 0 0 0 0 0 0 0 0 0
## 7 0 1 0 0 0 0 0 0 0
## 8 0 0 0 0 0 0 1 0 0
## 9 0 0 0 0 0 0 0 0 0
## 10 0 0 0 0 0 0 0 0 0
## WMI.JN8 WMI.JNR WMI.JS3 WMI.JSA WMI.JT1 WMI.JT2 WMI.JT6 WMI.JT8 WMI.JTD
## 1 0 0 0 0 0 0 0 0 0
## 2 0 0 0 0 0 0 0 0 0
## 3 0 0 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0 0 0
## 5 0 0 0 0 0 0 0 0 0
## 6 0 0 0 0 0 0 0 0 0
## 7 0 0 0 0 0 0 0 0 0
## 8 0 0 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0 0 0
## 10 0 0 0 0 0 0 0 0 0
## WMI.JTE WMI.JTH WMI.JTJ WMI.JTM WMI.JTN WMI.KL1 WMI.KMH WMI.KNA WMI.KNE
## 1 0 0 0 0 0 0 0 0 0
## 2 0 0 0 0 0 0 0 0 0
## 3 0 0 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 1 0 0
## 5 0 0 0 0 0 0 0 0 0
## 6 0 1 0 0 0 0 0 0 0
## 7 0 0 0 0 0 0 0 0 0
## 8 0 0 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0 0 0
## 10 0 0 0 0 0 0 1 0 0
## WMI.KNM WMI.MHF WMI.MMC WMI.MR0 WMI.MR1 WMI.MRO WMI.NMT WMI.SAL WMI.SB1
## 1 0 0 0 0 0 0 0 0 0
## 2 0 0 0 0 0 0 1 0 0
## 3 0 0 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0 0 0
## 5 0 0 0 0 0 0 0 0 0
## 6 0 0 0 0 0 0 0 0 0
## 7 0 0 0 0 0 0 0 0 0
## 8 0 0 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0 0 0
## 10 0 0 0 0 0 0 0 0 0
## WMI.SHH WMI.SHS WMI.SJN WMI.TMA WMI.TMB WMI.U5Y WMI.VF1 WMI.VF3 WMI.VNK
## 1 0 0 0 0 0 0 0 0 0
## 2 0 0 0 0 0 0 0 0 0
## 3 0 0 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0 0 0
## 5 0 0 0 0 0 0 0 0 0
## 6 0 0 0 0 0 0 0 0 0
## 7 0 0 0 0 0 0 0 0 0
## 8 0 0 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0 0 0
## 10 0 0 0 0 0 0 0 0 0
## WMI.W0L WMI.WAU WMI.WBA WMI.WDB WMI.WDD WMI.WF0 WMI.WFO WMI.WOL WMI.WVG
## 1 0 0 0 0 0 0 0 0 0
## 2 0 0 0 0 0 0 0 0 0
## 3 0 1 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0 0 0
## 5 0 0 0 0 0 0 0 0 0
## 6 0 0 0 0 0 0 0 0 0
## 7 0 0 0 0 0 0 0 0 0
## 8 0 0 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0 0 0
## 10 0 0 0 0 0 0 0 0 0
## WMI.WVW WMI.X4X WMI.X7L WMI.X9F WMI.X9L WMI.XUF WMI.XUU WMI.XW7 WMI.XW8
## 1 0 0 0 0 0 0 0 0 0
## 2 0 0 0 0 0 0 0 0 0
## 3 0 0 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0 0 0
## 5 0 0 0 0 0 0 0 0 0
## 6 0 0 0 0 0 0 0 0 0
## 7 0 0 0 0 0 0 0 0 0
## 8 0 0 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0 0 0
## 10 0 0 0 0 0 0 0 0 0
## WMI.XWB WMI.XWE WMI.Z8N WMI.Z8T WMI.Z94
## 1 0 0 0 0 0
## 2 0 0 0 0 0
## 3 0 0 0 0 0
## 4 0 0 0 0 0
## 5 0 0 0 0 0
## 6 0 0 0 0 0
## 7 0 0 0 0 0
## 8 0 0 0 0 0
## 9 0 0 0 0 0
## 10 0 0 0 0 0# summarize attribute distributions of the first 10 rows of the data
summary(X[inTrain, 1:10])## YEAR ENGINE_VOLUME AVG_COST
## Min. :-1.845426 Min. :-1.819451 Min. :-1.444795
## 1st Qu.:-0.947328 1st Qu.:-0.976627 1st Qu.:-0.561793
## Median : 0.175294 Median : 0.147138 Median :-0.245654
## Mean :-0.005835 Mean : 0.004904 Mean : 0.005093
## 3rd Qu.: 0.624342 3rd Qu.: 0.568550 3rd Qu.: 0.293175
## Max. : 2.420537 Max. : 4.782670 Max. : 8.954249
## FUEL_TYPE.Бензин.Газ FUEL_TYPE.Газ FUEL_TYPE.Гибрид
## Min. :0.0000 Min. :0.000000 Min. :0.000000
## 1st Qu.:0.0000 1st Qu.:0.000000 1st Qu.:0.000000
## Median :0.0000 Median :0.000000 Median :0.000000
## Mean :0.1218 Mean :0.002215 Mean :0.005353
## 3rd Qu.:0.0000 3rd Qu.:0.000000 3rd Qu.:0.000000
## Max. :1.0000 Max. :1.000000 Max. :1.000000
## FUEL_TYPE.Дизель BODY_TYPE.Кроссовер BODY_TYPE.Минивэн
## Min. :0.00000 Min. :0.0000 Min. :0.00000
## 1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.00000
## Median :0.00000 Median :0.0000 Median :0.00000
## Mean :0.02658 Mean :0.1839 Mean :0.01643
## 3rd Qu.:0.00000 3rd Qu.:0.0000 3rd Qu.:0.00000
## Max. :1.00000 Max. :1.0000 Max. :1.00000
## BODY_TYPE.Пикап
## Min. :0.000000
## 1st Qu.:0.000000
## Median :0.000000
## Mean :0.008307
## 3rd Qu.:0.000000
## Max. :1.0000002.3 Correlation Matrix
Перед построением модели полезно изучить корреляционную матрицу отобранных предикторов, в которой они сгруппированы во взаимосвязанные блоки.
## Correlation Matrix Heatmap for Feartures Visualization
## http://www.sthda.com/english/wiki/ggplot2-quick-correlation-matrix-heatmap-r-software-and-data-visualization
library('reshape2')##
## Attaching package: 'reshape2'## The following object is masked from 'package:tidyr':
##
## smithslibrary('scales')##
## Attaching package: 'scales'## The following object is masked from 'package:purrr':
##
## discard## The following object is masked from 'package:readr':
##
## col_factor## Get lower triangle of the correlation matrix
get_lower_tri<-function(cormat){
cormat[upper.tri(cormat)] <- NA
return(cormat)
}
## Get upper triangle of the correlation matrix
get_upper_tri <- function(cormat){
cormat[lower.tri(cormat)] <- NA
return(cormat)
}
## Use correlation between variables as distance
reorder_cormat <- function(cormat){
dd <- as.dist((1 - cormat) / 2)
hc <- hclust(dd)
cormat <-cormat[hc$order, hc$order]
}
cormat <- round(cor(X[inTrain, ]), 2)
## Reorder the correlation matrix
cormat <- reorder_cormat(cormat)
upper_tri <- get_upper_tri(cormat)
# Melt the correlation matrix
melted_cormat <- melt(upper_tri, na.rm = TRUE)
plot <- ggplot(melted_cormat, aes(x = Var1, y = Var2, fill = value)) +
geom_tile() +
scale_x_discrete() +
scale_y_discrete() +
coord_fixed() +
theme(legend.title = element_text(size = 8),
legend.position = "top", legend.direction = "horizontal",
legend.key.width = unit(1.25, "cm"), legend.key.height = unit(0.25, "cm"),
legend.spacing = unit(0, "cm"), # panel.margin = element_blank(),
axis.text.x = element_text(angle = -90, vjust = 0.5, hjust = 0),
axis.title.y = element_blank(), axis.title.x = element_blank(),
plot.title = element_text(hjust = 1, size = 12)) +
scale_fill_gradient2(high = "#2ecc71", low = "#e74c3c", mid = "white",
midpoint = 0, limit = c(-1.0, 1.0),
name = "Pearson\nCorrelation", breaks = pretty_breaks(8)) +
labs(title = sprintf("Correlation Matrix of %s Features", dim(X)[2]))
## Output Plot as PNG file
png(paste("C:/Soft/R/Examples/caret/Correlation.Matrix1", "png", sep="."), units = "px", width = 910, height = 970)
plot(plot)
garbage <- dev.off()
## Positive and negative predictors associated with `AVG_COST`
melted_cormat %>% filter(Var1 == 'AVG_COST') %>% arrange(desc(value)) %>% slice(2:8)## # A tibble: 7 x 3
## Var1 Var2 value
## <fct> <fct> <dbl>
## 1 AVG_COST ENGINE_VOLUME 0.510
## 2 AVG_COST WMI.JTM 0.340
## 3 AVG_COST INTERIOR_TYPE.КОЖА 0.320
## 4 AVG_COST WMI.5TD 0.120
## 5 AVG_COST WMI.WDD 0.0900
## 6 AVG_COST WMI.5UX 0.0700
## 7 AVG_COST WMI.2T2 0.0700melted_cormat %>% filter(Var1 == 'AVG_COST') %>% arrange(value) %>% slice(2:8)## # A tibble: 7 x 3
## Var1 Var2 value
## <fct> <fct> <dbl>
## 1 AVG_COST TYPE_OF_DRIVE.Передний.привод -0.350
## 2 AVG_COST BODY_TYPE.Седан -0.230
## 3 AVG_COST AUTO_CONDITION.Удовлетворительное -0.180
## 4 AVG_COST WMI.4T1 -0.0700
## 5 AVG_COST WMI.WDB -0.0700
## 6 AVG_COST WMI.JTD -0.0700
## 7 AVG_COST WMI.VF3 -0.0600
На графике заметно, что предикторы слабо взаимосвязаны между собой - основной цвет корреляционной матрицы белый, т.е. нейтральный. Это заметно отличается от ярче раскрашенной корреляционной матрицы из второй задачи, где больше проявлений мультиколлинеарность признаков. При этом количество отрицательных пар признаков (красный цвет) несколько больше, чем число положительных (зеленый цвет). Обращает внимание, что большие значения AVG_COST положительно коррелирует с значительными объемами двигателя ENGINE_VOLUME и кодом WMI.JTM - TOYOTA Япония Truck, но отрицательно с продолжительностью эксплутатации YEAR, а также TYPE_OF_DRIVE.Передний.привод и AUTO_CONDITION.Удовлетворительное.
3 Построение модели Глубокого обучения
Следующий шаг в процессе построения модели переход от обычных наборов данных к тензорам (в нашей задаче - матрицы и вектора), которые являются исходной информацией для нейросетевого глубокого обучения.
3.1 Подготовка тензоров для обучения и контроля нейронной сети
Перед построением структуры нейронной сети необходимо задать условия процесса оптимизации параметров модели. Применим однократное разбиение полной обучающей выборки на собственно обучающую и проверочную выборки. Последнюю возмем в размере 20% от полной обучающей выборки.
После этого надо преобразовать полный обучающий и контрольний наборы предикторов X в две матрицы (двухмерные тензоры), а целевой признак Y в два вектора (одномерные тензоры).
## create a list of 20% of the rows in the full train dataset we can use for validating
set.seed(seed)
val_indices <- runif(dim(X[inTrain, ])[1]) <= .2
## Turn dataset into a matrix
## Split the dataset
X.training <- as.matrix(X[inTrain, ])
X.testing <- as.matrix(X[inTest, ])
## Set dataset `dimnames` to `NULL`
dimnames(X.training) <- NULL
dimnames(X.testing) <- NULL
## Redefine dimension of tensor inputs
input_shape <- ncol(X.training)
num_classes <- 1 # Scaler Regression
## Split the class attribute
Y.trainingtarget <- as.array(Y[inTrain])
Y.testingtarget <- as.array(Y[inTest])3.2 Формирование нейронной сети посредством библиотеки Keras
Мы обращаемся к открытой библиотеке Keras [last month’s downloads]http://cranlogs.r-pkg.org/badges/keras, написанной на языке Python. Эта высокоуровневая библиотека для быстрой реализации алгоритмов нейронных сетей - каркас для обращения к нескольким открытым библиотекам Глубокого Машинного Обучения. В Апрель 2018 таковыми являлись:
• основной движок Tensorflow от Google,
• инструментарий Microsoft Cognitive Toolkit на C++ (CNTK) с версии не младше 2,
• проект 2007-2017 гг. Монреальского Университета Theano, и наконец
• относительно молодая нейросетевой библиотека “для всех устройств” PlaidML.
Благодаря такой гибкости можно проводить глубокое обучение нейронных сетей разнообразной структуры и сложности. Keras довольно универсален и позволяет решать скалярные и векторные регрессионные задачи, а также классификационные задачи как с двумя, так и с множеством классов.
Сравнительный обзор TensorFlow и CNTK от двух ведущих мировых IT компаний показывает, что в ряде случае продукт Microsoft оказывается быстрее, однако примеров с числовыми данными, например, классической регрессионной задачи по Boston housing price regression dataset, автор обзора не предоставил. Поэтому в качестве движка в нашей задаче будет применен Tensorflow, хотя другие библиотека также показывали хороший результат глубокого обучения.
Для этой регрессионной задачи будет обучаться довольно простая разновидность нейронной сети, называемая многослойный перцептрон (англ. "Multilayer perceptron, MLP"). Он составлен стеком из трех Dense слоев, который соответствует полносвязному MLP, где все выходы одного слоя связаны со всеми входами последующего. Будем применять активацию ReLU для нейронов первых двух скрытых слоев, а для последнего - выходного слоя нейронной сети будет заканчивать без активирования (это будет линейный слой) с одним выходом. Это типичная установка для скалярной регрессии (регрессия, которую мы строим предсказания помещаются в один вектор Y).
The typical Artificial Neural Network
Source: Xenon Stack
Применение функции активации будет ограничивать диапазон, который может принимать выходной сигнал; например, если бы мы применили к последнему слою сигмоидную функцию активации sigmoid, то нейронная сеть могла научиться прогнозировать только значения между 0 и 1, что подходит для бинарной классификации, как в классификационной задаче от того же банка. Здесь, поскольку последний слой является чисто линейным, нейронная сеть может прогнозировать значения в широком диапазоне.
Количество нейронов в первом из двух скрытых слоев MLP установим в 512, а во втором уже в несколько раз меньше - 32. После каждого скрытого слоя во избежании переобучения введем слои отсева (англ. "dropout"). Они будут отключать нейроны сети с вероятностью 10%, предотвращая взаимоадаптацию нейронов при обучении.
Теперь определим алгоритм оптимизации, функцию потерь и метрики, которые мы будет собирать. Подробный обзор алгоритмов оптимизации дан Sebastian Ruder. Для этой задачи будет использован оптимизатор Адама ('adam'), который обычно показывает хорошую производительность.
Выберет в качестве функции потерь англ. "loss" Среднее квадратичное логарифмическое отклонение (англ. "Mean Squared Logarithmic Error, MSLE"), так как доля проставленных оценок в обучающем наборе в диапазоне +/- 10% от фактических значений (назовем её Success Rate) первые сотни итераций имеет нулевое значение. Однако Success Rate можно взять в качестве пользовательской метрики.
library('keras')
# reticulate::py_config()
keras:::keras_version() ## 'keras' version 2.1.5## [1] '2.1.5'keras::use_backend(backend = 'tensorflow') ## 'tensorflow' version 1.5.0
# keras::use_backend(backend = 'theano') ## 'theano' version 1.0.1
# keras::use_backend(backend = 'cntk') ## 'cntk' version 2.5
## Use a session with a random seed
tensorflow::use_session_with_seed(seed, disable_gpu = TRUE, disable_parallel_cpu = TRUE, quiet = FALSE)## Set session seed to 1991 (disabled GPU, CPU parallelism)K <- keras::backend() # for using `K$` in keras's object
damnum <- 'msle'
# metrum <- 'mape'
init_units <- as.numeric(!val_indices) %>% sum() ## Numers of observations
metric_success_rate <- function(y_true, y_pred) {
## The proportion of observations whose absolute deviation is less than 10% from train set
success_y <- K$sum(K$cast(K$less(K$abs(y_pred - y_true) / y_true, .1), 'int32'))
count_y <- K$sum(K$cast((y_true + 1) / (y_true + 1), 'int32'))
metric <- success_y / count_y * 100
return( metric )
}
model_keras <- keras_model_sequential()
model_keras %>%
# (1) 1st Hidden Layer-------------------------------------------------
layer_dense (units = 512, ## The number of nodes is a multiple of two
kernel_initializer = 'uniform',
activation = 'relu',
input_shape = input_shape) %>%
layer_dropout (rate = 0.10) %>% ## Dropout Below 10%: Prevent overfitting
# (2) 2nd Hidden Layer-------------------------------------------------
layer_dense (units = 32,
kernel_initializer = 'uniform',
activation = 'relu') %>%
layer_dropout (rate = 0.10) %>% ## Dropout Below 10%: Prevent overfitting
# (3) Output Layer-----------------------------------------------------
layer_dense (units = num_classes, ## to predict a single continuous value for scalar regression
name = "Car_Price") ## An optional name string for the layer.
# (4) Compile Model-----------------------------------------------------
model_keras %>% compile ('adam', ## Most Popular for Optimization Algoritm
## Scalar Regression
loss = damnum, ## Mean Squared Logarithmic Error
metrics = list(success_rate = metric_success_rate)) ## Train/Validation - Custom Metric Function
# Check of Neural Network Model
summary(model_keras)## ___________________________________________________________________________
## Layer (type) Output Shape Param #
## ===========================================================================
## dense_1 (Dense) (None, 512) 55296
## ___________________________________________________________________________
## dropout_1 (Dropout) (None, 512) 0
## ___________________________________________________________________________
## dense_2 (Dense) (None, 32) 16416
## ___________________________________________________________________________
## dropout_2 (Dropout) (None, 32) 0
## ___________________________________________________________________________
## Car_Price (Dense) (None, 1) 33
## ===========================================================================
## Total params: 71,745
## Trainable params: 71,745
## Non-trainable params: 0
## ___________________________________________________________________________3.3 Глубокое обучение нейронных сетей с библиотекой Keras
Для настройки глубокого обучения нейронной сети существует множество параметров. При этом возможны разные способы формирования проверочной выборки (англ. validation set). В данной задаче мы предварительно сформируем проверочные наблюдения и ограничимся заданием только двух параметров для обучения:
• batch_size — количество обучающих образцов, обрабатываемых одновременно за одну итерацию алгоритма градиентного спуска. При его увеличение обычно снижаются потери при каждом обучающем цикле (epoch), но продолжительность цикла возрастает.
• epochs — количество итераций алгоритмов из выбранной нейросетевой библиотеки по обучающему набору.
## Deep Learning of Model
x_val <- X.training[val_indices, ]
partial_x_train <- X.training[!val_indices, ]
y_val <- Y.trainingtarget[val_indices]
partial_y_train <- Y.trainingtarget[!val_indices]
history <- model_keras %>% fit (
x = partial_x_train, ## Matrix of Features
y = partial_y_train, ## Numeric Vector
batch_size = 128, ## Of Samples/gradient update in each epoch
verbose = 0, ## Verbosity mode (0 = silent, 1 = progress bar, 2 = by epoch)
epochs = 3000, ## Control Training Сycles
validation_data = list(x_val, y_val) ## Include 20% data for Validating Model
)
## Deep Learning Training Results
print (history)## Trained on 4,279 samples, validated on 1,138 samples (batch_size=128, epochs=3,000)
## Final epoch (plot to see history):
## val_loss: 0.007079
## val_success_rate: 82.95
## loss: 0.01216
## success_rate: 66.58plot(history)
На графике процесса обучения видно, что заметное улучшения качества регрессионной модели началось c 250 итерации и перешло на плавное плато улучшения качества нейронной сети после 800-й итерации.
3.4 Апробирование модели
После обучения нейронной сети проведем её апробирование на контрольном наборе данных (inTest), который не принимал участие в построение модели. Точность на нём будем сравнивать с проверочными наблюдениями данной задачи.
## Predict for Valuation & Testing Sets:
fitted <- model_keras %>% predict(x_val) %>% as.vector()
preds <- model_keras %>% predict(X.testing) %>% as.vector()
## output Result of Validation and Testing Sets
# apeLearning <- data.frame(APE = abs((y_val) - (fitted))/ (y_val))
# ape <- data.frame(APE = abs((Y.testingtarget) - (preds))/ (Y.testingtarget))
#
# SuccRateLearning <- dim(subset(apeLearning, APE < 0.1))[1] / length(y_val) * 100
# SuccRateTesting <- dim(subset(ape, APE < 0.1))[1] / length(Y.testingtarget) * 100
y_true_i <- k_sum(k_cast(y_val / y_val, 'int32'))
y_pred_i <- k_sum(k_cast(k_less(k_abs(fitted - y_val) / y_val, .1), 'int32'))
SuccRateLearning <- k_eval(y_pred_i / y_true_i * 100)
y_true_i <- k_sum(k_cast(Y.testingtarget / Y.testingtarget, 'int32'))
y_pred_i <- k_sum(k_cast(k_less(k_abs(preds - Y.testingtarget) / Y.testingtarget, .1), 'int32'))
SuccRateTesting <- k_eval(y_pred_i / y_true_i * 100)
result.df <- rbind(cbind(forecast::accuracy((fitted), (y_val)),
SuccessRate = SuccRateLearning),
cbind(forecast::accuracy((preds), (Y.testingtarget)),
SuccRateTesting))
row.names(result.df) <- c("Valuation Set", "Testing Set")
## Results by Validation and Testing Sets from Regression `keras` models
print(result.df)## ME RMSE MAE MPE MAPE SuccessRate
## Valuation Set -15172.665 257706.1 174683.3 -1.1536937 6.126065 82.95255
## Testing Set -2505.713 265084.9 181976.3 -0.8677583 6.193453 82.50429Глубокое обучение позволило существенно улучшить точность предсказания цены подержанных автомобилей, так показатель аккуратности MAPE на контрольной выборке inTest довольно низкий, т.е. хороший - 6%, а целевой критерий задачи Success Rate превысил требуемый нижний порог в 78% достигнув 83%.
4 Завершение модели
Полученные результаты обученной нейронной сети для предсказаний цен автомобилей являются довольно точными. Давайте завершим моделирование, создав целевой признак ESTIM_COST с параметрами, настроенными на обученной модели, с использованием набор данных inProblem. Полученные результаты выведем в MS Excel файл.
## Solution of a Regression Problem
problem.df <- data.frame(ID = DF2$ID, # c(10000:13248),
ESTIM_COST = model_keras %>% predict( as.matrix(X[inProblem, ]) ))
## Open workbook into temporary file
openxlsx::addWorksheet(wb0 <- openxlsx::createWorkbook(), sheetName = "Results", gridLines = FALSE)
openxlsx::writeData(wb0, sheet = 1, x = result.df, withFilter = FALSE)
openxlsx::addWorksheet(wb0, "Regression")
openxlsx::writeDataTable(wb0, sheet = "Regression", x = problem.df, colNames = TRUE,
tableStyle = "TableStyleMedium5", withFilter = FALSE)
openxlsx::openXL(wb0)5 Итоги
В этом задании мы провели глубокое обучение скалярной регрессионной модели при помощи открытой нейросетевой библиотеки Keras на движке TensorFlow от начала до конца, используя язык программирования для статистической обработки данных R. В частности, описанные шаги были следующими:
Определение типа Проблемы (данные по мошенничеству клиентов).
Разведочный анализ данных (поиск неоднородных вариативности значений и высоких коррелляций ряда признаков).
Превращение номинальных признаков в набор числовых переменных.
Отбор предикторов для предсказания (удаление признаков с минимальной вариацией и избавление от пар тесно взаимосвязанных признаков).
Преобразование предикторов (заполнение пропусков, шкалирование и нормирование).
Построение тензоров и формирование структуры нейронной сети по задаче скалярной регресии.
Глубокое обучение регрессионной модели.
Оценка полученной модели на контрольной выборке и вывод предсказанных значений.