Prestadores
Tarssio Barreto
24 de dezembro de 2018
Transformando os dados
datatable(dados)## Warning in instance$preRenderHook(instance): It seems your data is too
## big for client-side DataTables. You may consider server-side processing:
## https://rstudio.github.io/DT/server.htmlRealizando algumas transformações como médias e ajustando as siglas para a natureza do prestador, temos :
datatable(dados)Boxplots geral
dados %>%
select(4:8) %>%
melt() %>%
ggplot(aes(y = value)) +
geom_boxplot() +
facet_wrap(~variable, scales = "free")
Filtros adotados (Podem ser sugeridos novos filtros) :
dados_1 <- dados %>%
na.omit() %>%
filter(Tarif < 20) %>%
filter(Desemp < 800) %>%
filter(Sufic < 1000) %>%
filter(Receita < 1000) %>%
filter(Invest < 1500) %>%
filter(Invest >= 0)Boxplot dos dados filtrados
dados_1 %>%
select(4:8) %>%
melt() %>%
ggplot(aes(y = value)) +
geom_boxplot() +
facet_wrap(~variable, scales = "free")
Boxplots para cada variável relacionada a natureza do seu prestador
all_plots## [[1]]
## [[1]][[1]]
##
##
## [[2]]
## [[2]][[1]]
##
##
## [[3]]
## [[3]][[1]]
##
##
## [[4]]
## [[4]][[1]]
##
##
## [[5]]
## [[5]][[1]]
Separando possíveis outliers
Z-scores
data <- dados_1 %>%
select(4:9) %>%
group_by(Nat_jur) %>%
mutate(tarifa = scores(Tarif,type = "z", prob = 0.95)) %>%
mutate(desemp_fin = scores(Desemp,type = "z", prob = 0.95)) %>%
mutate(suf_caixa = scores(Sufic,type = "z", prob = 0.95)) %>%
mutate(receita_capita = scores(Receita,type = "z", prob = 0.95)) %>%
mutate(invest_capita = scores(Invest,type = "z", prob = 0.95)) %>%
mutate(invest_capita = ifelse(is.na(invest_capita), FALSE, invest_capita)) %>%
mutate(outlier = if_else(tarifa == FALSE & desemp_fin == FALSE &
suf_caixa == FALSE & receita_capita == FALSE &
invest_capita == FALSE, 0 , 1)) %>%
ungroup()
datatable(data)Boxplot para o grupo A (não Outlier) e grupo B (Outlier)
Grupo A
data %>%
filter(outlier == 0) %>%
group_by(Nat_jur) %>%
melt() %>%
filter(variable != "outlier") %>%
ungroup() %>%
group_by(Nat_jur) %>%
ggplot(aes(x = Nat_jur, y = value)) +
geom_boxplot() +
facet_wrap(~variable, ncol = 2, scales = "free") +
labs(title = "Grupo A", y = "Valor do indicador", x = "Tipo de prestador") +
opt## Using Nat_jur, tarifa, desemp_fin, suf_caixa, receita_capita, invest_capita as id variables
Grupo B
data %>%
filter(outlier == 1) %>%
group_by(Nat_jur) %>%
melt() %>%
filter(variable != "outlier") %>%
ungroup() %>%
group_by(Nat_jur) %>%
ggplot(aes(x = Nat_jur, y = value)) +
geom_boxplot() +
facet_wrap(~variable, ncol = 2, scales = "free") +
labs(title = "Grupo B", y = "Valor do indicador", x = "Tipo de prestador") +
opt## Using Nat_jur, tarifa, desemp_fin, suf_caixa, receita_capita, invest_capita as id variables
Classificando com Random Forest
Floresta Aleatória (random forest) é um algoritmo de aprendizagem supervisionada, ou seja, temos previamente a classificação final desejada. A “floresta” criada é uma combinação de árvores de decisão, na maioria dos casos treinados com o método de bagging. A idéia principal deste método é que as árvores aleátorias “votam” no modelo mais adequado, criando então uma combinação final mais eficiente e estável do que o modelo de árvores de decisão.
Uma grande vantagem do algoritmo de random forest é que ele pode ser utilizado tanto para tarefas de classificação quanto para regressão, o que representa a maioria dos sistemas de aprendizagem de máquina atuais
Para grupo A
O grupo A será aquele onde o modelo será treinado, testado e validado, para isto fracionaremos os dados em dois grupos: Treino e Teste. Além disto, utilizaremos o método k-fold para a validação cruzada do modelo durante o treino, desta forma queremos reduzir a possibilidade de overfitting deste.
data_full <- data %>%
filter(outlier == 0) %>%
select(c(1:6))
seed <- 7
metric <- "Accuracy"
set.seed(seed)
indxTrain <- createDataPartition(y = data_full$Nat_jur,p = 0.75,list = FALSE)
training <- data_full[indxTrain,]
testing <- data_full[-indxTrain,]
#Preprocessing
trainX <- training[,names(training) != "Nat_jur"]
preProcValues <- preProcess(x = trainX,method = c("center", "scale"))
#Training and train control
control <- trainControl(method="repeatedcv", number=10, repeats=3)Random Forest
# rf_default <- train(Nat_jur ~ ., data = training, method="rf",
# metric=metric, trControl=control)
load("C:/Users/tarss/Desktop/Trabalhos em andamento/cbesa/Paty/rf.RData")
rf_default## Random Forest
##
## 2619 samples
## 5 predictor
## 4 classes: 'AUT', 'PRE', 'PRI', 'REG'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 2357, 2358, 2356, 2357, 2357, 2357, ...
## Resampling results across tuning parameters:
##
## mtry Accuracy Kappa
## 2 0.8620400 0.6844970
## 3 0.8625499 0.6852125
## 5 0.8601296 0.6794393
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 3.# Temos uma acurácia de 86,5% um bom resultado, porém, o que determina a qualidade de um algoritmo de aprendizado é a qualidade do teste.
# mtry = 3, ou seja, o número de variáveis amostradas aleatoriamente para serem candidatas nos ramos das árvores.
# Vemos que a ordem de importância das variáveis para classificação é:
importance(rf_default$finalModel)## MeanDecreaseGini
## Tarif 436.7746
## Desemp 160.3248
## Sufic 216.9506
## Receita 190.2522
## Invest 177.6986testX <- testing[,names(testing) != "Nat_jur"]
rpartPred <- predict(rf_default, testX) Precisão do modelo
# 89% de precisão no teste, um bom resultado, porém para as naturezas juridicas: Autarquia e Privada as precisões são mais baixas, deve-se ponderar também que há um desequilibrio entre os numéros de observação de cada uma das features.
confusionMatrix(rpartPred, as.factor(testing$Nat_jur))## Confusion Matrix and Statistics
##
## Reference
## Prediction AUT PRE PRI REG
## AUT 53 4 9 4
## PRE 12 102 1 2
## PRI 8 0 27 2
## REG 27 3 4 612
##
## Overall Statistics
##
## Accuracy : 0.9126
## 95% CI : (0.8919, 0.9306)
## No Information Rate : 0.7126
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.8027
## Mcnemar's Test P-Value : 0.0007998
##
## Statistics by Class:
##
## Class: AUT Class: PRE Class: PRI Class: REG
## Sensitivity 0.53000 0.9358 0.65854 0.9871
## Specificity 0.97792 0.9803 0.98794 0.8640
## Pos Pred Value 0.75714 0.8718 0.72973 0.9474
## Neg Pred Value 0.94125 0.9907 0.98319 0.9643
## Prevalence 0.11494 0.1253 0.04713 0.7126
## Detection Rate 0.06092 0.1172 0.03103 0.7034
## Detection Prevalence 0.08046 0.1345 0.04253 0.7425
## Balanced Accuracy 0.75396 0.9580 0.82324 0.9255Testando os outliers
new <- data %>%
filter(outlier == 1) %>%
select(c(1:5))
out <- data %>%
filter(outlier == 1)
rf_b <- predict(rf_default,newdata = new)
# A matriz abaixo exibe como seriam reclassificados os "outliers":
#confusionMatrix(rf_b, as.factor(testing$Nat_jur))
load("B.RData")
aux## Confusion Matrix and Statistics
##
## Reference
## Prediction AUT PRE PRI REG
## AUT 11 11 3 34
## PRE 7 43 2 22
## PRI 57 14 29 145
## REG 38 38 14 463
##
## Overall Statistics
##
## Accuracy : 0.5865
## 95% CI : (0.5541, 0.6183)
## No Information Rate : 0.7132
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.2427
## Mcnemar's Test P-Value : <2e-16
##
## Statistics by Class:
##
## Class: AUT Class: PRE Class: PRI Class: REG
## Sensitivity 0.09735 0.40566 0.60417 0.6973
## Specificity 0.94132 0.96242 0.75538 0.6629
## Pos Pred Value 0.18644 0.58108 0.11837 0.8373
## Neg Pred Value 0.88303 0.92649 0.97230 0.4683
## Prevalence 0.12137 0.11386 0.05156 0.7132
## Detection Rate 0.01182 0.04619 0.03115 0.4973
## Detection Prevalence 0.06337 0.07948 0.26316 0.5940
## Balanced Accuracy 0.51933 0.68404 0.67977 0.6801A partir dos dados obtidos, pode-se pensar a cerca da relação dos outliers. Para as Autarquias temos reclassificações associadas, principalmente, a empresas de prestação de saneamento com a natureza jurídica privada ou regional.
Para as prefeituras, temos como principais reclassificações a própria prefeitura ou empresas regionais. Quanto a reclassificação ser, majoritariamente, igual a classificação original, pode-se inferir que existe uma grande variabilidade dos indicadores financeiros das prestoras de saneamento com a natureza juridica relacionada a prestação pela própria prefeitura. Criando, assim, indicadores com valores distintos dos outros tipos de prestadores, mas com grande variabilidade interna.
As empresas privadas, também, não são na sua maioria reclassificadas, ou seja mantem a feature original. Pode-se pensar que este fato é correlacionado a sua natureza própria que visa o lucro, tendo, assim, indicadores que são bastante distintos quanto as demais. Salienta-se, também, que a tarifa é a variável mais importante, fato que corrobora com o apresentado acima.
Para as prestadoras regionais, observa-se um grande indice de não reclassificação, demonstrando uma grande variabilidade dos seus indicadores, fato este que é decorrência da grande abrangência dos municípios atentidos por estas (de grandes centros economicos a pequenas cidades do interior com menos de 20 mil habitantes).