library(car)
## Loading required package: carData
## Warning: replacing previous import 'lifecycle::last_warnings' by
## 'rlang::last_warnings' when loading 'hms'
## Warning: replacing previous import 'lifecycle::last_warnings' by
## 'rlang::last_warnings' when loading 'tibble'
## Warning: replacing previous import 'lifecycle::last_warnings' by
## 'rlang::last_warnings' when loading 'pillar'
library(readr)
partners <- read_csv("BSC_proveedores.csv", 
    col_types = cols(Empresa = col_factor(levels = c("Imitadora", 
        "Proactiva", "Innovadora"))))
# partners <- read.table("BSC_proveedores.csv",header=TRUE,sep=",")
summary(partners)
##        PK           Rec_Humano      Tecnologia       Capital     
##  Min.   :  1.00   Min.   :4.300   Min.   :2.000   Min.   :1.000  
##  1st Qu.: 38.25   1st Qu.:5.100   1st Qu.:2.800   1st Qu.:1.600  
##  Median : 75.50   Median :5.800   Median :3.000   Median :4.350  
##  Mean   : 75.50   Mean   :5.843   Mean   :3.057   Mean   :3.758  
##  3rd Qu.:112.75   3rd Qu.:6.400   3rd Qu.:3.300   3rd Qu.:5.100  
##  Max.   :150.00   Max.   :7.900   Max.   :4.400   Max.   :6.900  
##      Equipo            Empresa  
##  Min.   :0.100   Imitadora :50  
##  1st Qu.:0.300   Proactiva :50  
##  Median :1.300   Innovadora:50  
##  Mean   :1.199                  
##  3rd Qu.:1.800                  
##  Max.   :2.500

Matriz de Covarianza

library(scatterPlotMatrix)
scatterPlotMatrix(partners)

Como vemos la columna 1, PK, (primary key) no es parte de los datos. Se trata de un número secuencial que no está relacionado con la muestra.

Entrenamiento de árbol de decisión

Esta técnica utiliza un set de datos representativos de una situaci'on y utilizando recursivamente el teoréma de Bayes puede armar un pronosticador o clasificador de datos. Es una t'ecnica parecida a la de clustering, pero m'as refinada, pues no se basa en reglas sino en parendizaje del set de datos usado como entrenamento. En el paquete party existen dos funciones ctree que se utiliza para entrenar y predict que se usa para pronosticar o generar la regla de decici'on que debemos usar.

library(party)
## Loading required package: grid
## Loading required package: mvtnorm
## Loading required package: modeltools
## Loading required package: stats4
## 
## Attaching package: 'modeltools'
## The following object is masked from 'package:car':
## 
##     Predict
## Loading required package: strucchange
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## Loading required package: sandwich
attach(partners)
str(partners)    
## spec_tbl_df [150 × 6] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ PK        : num [1:150] 1 2 3 4 5 6 7 8 9 10 ...
##  $ Rec_Humano: num [1:150] 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
##  $ Tecnologia: num [1:150] 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
##  $ Capital   : num [1:150] 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
##  $ Equipo    : num [1:150] 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
##  $ Empresa   : Factor w/ 3 levels "Imitadora","Proactiva",..: 1 1 1 1 1 1 1 1 1 1 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   PK = col_double(),
##   ..   Rec_Humano = col_double(),
##   ..   Tecnologia = col_double(),
##   ..   Capital = col_double(),
##   ..   Equipo = col_double(),
##   ..   Empresa = col_factor(levels = c("Imitadora", "Proactiva", "Innovadora"), ordered = FALSE, include_na = FALSE)
##   .. )
# describe al objeto transit y muestras las columna que tiene

ind <- sample(2, nrow(partners), replace=TRUE, prob=c(0.7, 0.3))  
# toma una muestra  
ind  
##   [1] 1 1 1 1 1 1 1 2 2 1 1 1 2 1 2 2 1 1 2 1 2 1 1 2 1 1 2 1 1 1 1 1 1 2 2 1 1
##  [38] 1 1 1 1 1 2 1 2 1 1 1 2 2 1 1 1 1 1 1 1 2 2 1 2 1 1 1 2 2 1 2 2 1 1 1 1 1
##  [75] 1 1 2 1 1 1 2 2 2 1 2 1 1 1 1 2 1 1 2 2 1 2 2 1 1 1 2 1 1 2 1 1 1 2 2 2 1
## [112] 2 2 2 1 1 1 1 2 2 1 1 1 1 2 1 1 1 1 1 1 1 2 1 1 1 2 1 2 1 1 1 1 2 1 1 1 1
## [149] 1 2
# nos imprime la muestra tomada.
trainData <- partners [ind==1,]    
# genero un set de entrenamiento 
testData <- partners [ind==2,]    
# genero un set de datos de prueba
myFormula <- Empresa ~ Rec_Humano + Tecnologia + Capital + Equipo 
transit_ctree <- ctree(myFormula, data=trainData)    
# creo el motor de entrenamiento
# Verificar las prediciones 
table(predict(transit_ctree), trainData$Empresa) 
##             
##              Imitadora Proactiva Innovadora
##   Imitadora         35         0          0
##   Proactiva          0        32          4
##   Innovadora         0         1         30
print(transit_ctree) 
## 
##   Conditional inference tree with 4 terminal nodes
## 
## Response:  Empresa 
## Inputs:  Rec_Humano, Tecnologia, Capital, Equipo 
## Number of observations:  102 
## 
## 1) Capital <= 1.9; criterion = 1, statistic = 95.554
##   2)*  weights = 35 
## 1) Capital > 1.9
##   3) Equipo <= 1.7; criterion = 1, statistic = 43.49
##     4) Capital <= 4.7; criterion = 0.994, statistic = 9.963
##       5)*  weights = 29 
##     4) Capital > 4.7
##       6)*  weights = 7 
##   3) Equipo > 1.7
##     7)*  weights = 31
library(party)
attach(partners)
## The following objects are masked from partners (pos = 3):
## 
##     Capital, Empresa, Equipo, PK, Rec_Humano, Tecnologia
str(partners)    
## spec_tbl_df [150 × 6] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ PK        : num [1:150] 1 2 3 4 5 6 7 8 9 10 ...
##  $ Rec_Humano: num [1:150] 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
##  $ Tecnologia: num [1:150] 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
##  $ Capital   : num [1:150] 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
##  $ Equipo    : num [1:150] 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
##  $ Empresa   : Factor w/ 3 levels "Imitadora","Proactiva",..: 1 1 1 1 1 1 1 1 1 1 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   PK = col_double(),
##   ..   Rec_Humano = col_double(),
##   ..   Tecnologia = col_double(),
##   ..   Capital = col_double(),
##   ..   Equipo = col_double(),
##   ..   Empresa = col_factor(levels = c("Imitadora", "Proactiva", "Innovadora"), ordered = FALSE, include_na = FALSE)
##   .. )
# describe al objeto transit
ind <- sample(2, nrow(partners), replace=TRUE, prob=c(0.7, 0.3))  
# toma una muestra 
ind  
##   [1] 1 1 1 1 1 2 1 1 2 2 1 1 1 1 1 1 1 2 1 2 1 2 1 1 1 2 2 2 1 2 1 1 2 1 1 1 1
##  [38] 1 1 2 2 1 1 1 2 1 1 2 1 2 1 1 2 2 2 1 2 2 1 1 1 1 1 2 2 1 1 2 2 2 2 2 1 1
##  [75] 1 2 2 1 2 1 2 1 2 1 1 1 2 2 2 1 1 1 1 2 1 1 1 1 1 2 1 1 1 1 1 2 2 1 1 1 1
## [112] 2 2 1 2 1 2 1 1 1 1 1 1 2 1 1 1 1 1 1 2 1 1 1 2 2 1 1 1 2 2 1 2 1 1 1 2 2
## [149] 2 1
# nos imprime la muestra tomada.
table(predict(transit_ctree), trainData$Empresa) 
##             
##              Imitadora Proactiva Innovadora
##   Imitadora         35         0          0
##   Proactiva          0        32          4
##   Innovadora         0         1         30

Impresión del Árbol de Decisión

plot(transit_ctree, las=2)

summary(trainData$Empresa)
##  Imitadora  Proactiva Innovadora 
##         35         33         34