Resultados descritivos

library(summarytools)

## 
## Attaching package: 'summarytools'

## The following object is masked from 'package:tibble':
## 
##     view

stats <- by(data = base_merge_disc$profitability, INDICES = base_merge_disc$Perfil, FUN = descr, style = 'rmarkdown')
view(stats, method = 'pander') 

## Descriptive Statistics  
## profitability by Perfil  
## Data Frame: base_merge_disc  
## N: 4462  
## 
##                           D         I        S
## ----------------- --------- --------- --------
##              Mean      2.35      3.31     0.93
##          Std.Dev.      4.33      6.83     4.72
##               Min    -19.75    -15.55    -8.84
##                Q1      0.00      0.00     0.00
##            Median      1.71      1.65     0.00
##                Q3      4.70      5.35     6.22
##               Max     17.02     31.09     7.64
##               MAD      2.54      2.94     3.17
##               IQR      4.70      5.35     5.20
##                CV      1.84      2.06     5.06
##          Skewness     -0.01      1.21    -0.63
##       SE.Skewness      0.04      0.03     0.16
##          Kurtosis      5.67      3.39     0.09
##           N.Valid   4462.00   7060.00   230.00
##           % Valid    100.00    100.00   100.00

ANOVA individual por DISC

#Rodar o modelo
prof_disc_individual <- aov(profitability ~ Perfil, data = base_merge_disc)

#Verificar os resultados
anova_stats(car::Anova(prof_disc_individual, type = 3)) %>% kable() %>% kable_styling(bootstrap_options=c('striped','hover', 'condensed','responsive'),position='center', font_size = 12,full_width=F)

Os resultados indicaram que existe efeito significativo do Perfil na Profitabilitu (F(2, 11749) = 47.97, p < 0.01).

Normalidade dos resíduos

#Normalidade dos res?duos
#qqplot
ggplot(prof_disc_individual, aes(sample = rstandard(prof_disc_individual))) + 
  geom_qq() + 
  stat_qq_line()

O gráfico acima apresenta a distribuição teórica e a empírica dos resíduos. A linha diagonal indica o local em que a normalidade residual estaria presente. É possível verificar que em uma única fração do intervalo dos dados, há convergência para normalidade. Outro teste gráfico é feito a partir da densidade da distribuição residual, tal como exposto abaixo.

#densidade
qplot(prof_disc_individual$residuals, geom="density")

Formalmente, o teste de Kolmogorov-Smirnov ou o Shapiro-Wilk são utilizados para testar a hipótese de normalidade dos resíduos. Ambos assumem \(H_0\) na direção da normalidade.

ks.test(prof_disc_individual$resid, pnorm)

## Warning in ks.test(prof_disc_individual$resid, pnorm): ties should not be
## present for the Kolmogorov-Smirnov test

## 
##  One-sample Kolmogorov-Smirnov test
## 
## data:  prof_disc_individual$resid
## D = 0.39939, p-value < 2.2e-16
## alternative hypothesis: two-sided

#shapiro.test(prof_disc_individual$residuals[1:5000])

Tal como observado graficamente, a hipótese nula de normalidade foi rejeitada pela estatística de teste alcancada pelo Kolmogorov-Smirnov (D = 0.4, p < 0.01). Nesse sentido, os resultados apontam para violação da normalidade dos resíduos.

Homogeneidade das variâncias

Tal como anteriormente descrito, tanto técnicas gráficas como testes formais podem ser conduzidos para verificar esse pressuposto. Em relação às técnicas gráficas, o Homogeneity of Variance Plot apresenta os desvios-absolutos da mediana. Já o teste de Levene é frequentemente utilizado para verificar esse pressuposto. Tal como informado previamente, a \(H_0\) desse teste assume homocedasticidade.

car::leveneTest(base_merge_disc$profitability ~ base_merge_disc$Perfil) #homogeneidade dos dados

## Levene's Test for Homogeneity of Variance (center = median)
##          Df F value    Pr(>F)    
## group     2     154 < 2.2e-16 ***
##       11749                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

#bartlett.test(profitability ~ Perfil, data = base_merge_disc)
#fligner.test(profitability ~ Perfil, data = base_merge_disc)

#hov(profitability ~ Perfil, data = base_merge_disc)
hovPlot(profitability ~ Perfil, data = base_merge_disc)

Apesar dos pressupostos da normalidade e homocedasticidade terem sido violados, uma das possíveis sequências analíticas pode ser feita continuando as análises e justificando os resultados a partir do Teorema Central do Limite. Este teorema garante que, independente da distribuição dos valores das observações individuais, a média desses valores irá seguir, aproximdamente uma distribuição normal.

Posto isso, dado que a ANOVA foi significativa, isso significa que a adição do preditor (perfil) teve capacidade de reduzir a variância residual da resposta (profitability). Isso também permite que a comparações de todos os possíveis contrastes gerem valores significativos. Dessa maneira, a realização de testes de comparação das médias entre os grupos foi realizada. Essa etapa é chamada de post-hoc.

Post-hoc

#compara??o entre as m?dias
mmc(prof_disc_individual, linfct = mcp(Perfil = "Tukey"))

## Tukey contrasts
## Fit: aov(formula = profitability ~ Perfil, data = base_merge_disc) 
## Estimated Quantile = 2.284902 
## 95% family-wise confidence level
## $mca
##      estimate    stderr     lower    upper   height
## I-D 0.9571491 0.1140628 0.6965267 1.217771 2.832120
## I-S 2.3775100 0.3996178 1.4644226 3.290598 2.121939
## D-S 1.4203610 0.4032716 0.4989250 2.341797 1.643365
## $none
##    estimate     stderr      lower    upper    height
## I 3.3106944 0.07098147 3.14850876 3.472880 3.3106944
## D 2.3535454 0.08928584 2.14953603 2.557555 2.3535454
## S 0.9331844 0.39326331 0.03461637 1.831752 0.9331844

#TukeyHSD(prof_disc_individual, "Perfil") #post hoc
#emmeans(prof_disc_individual, pairwise ~ Perfil, adjust = "tukey")

adj.means <- effect('Perfil', prof_disc_individual) %>% as.data.frame()

ggplot(adj.means, aes(Perfil,fit, group=1)) +
  geom_line() +
  geom_point() +
  #theme_bw() +
  geom_hline(aes(yintercept = 0), color="blue", linetype="dashed") + 
  geom_text(aes(label = paste(round(fit,2)),y = fit-.3, x = Perfil)) +
  labs(title = "Escolher titulo") + 
  theme(legend.position="bottom")

ANOVA Robusta

Testes robustos são comumeiramente realizados quando os testes tradicionais apresentam violações dos pressupostos. Nesse sentido, a ANOVA robusta verifica o efeito do perfil na profitability considerando as médias aparadas em 20%. Nesse sentido, pontos anômalos/atípicos (outliers) não são considerados na análise. Conforme reportado na tabela a seguir, os resultados são convergentes aos encontrados previamente (F(2, 370.07) = 11.576, p < 0.01).

library(WRS2)

## Warning: package 'WRS2' was built under R version 3.5.3

## 
## Attaching package: 'WRS2'

## The following object is masked from 'package:HH':
## 
##     ancova

prof_disc_individual_rob <- t1way(profitability ~ Perfil, data = base_merge_disc)

A comparação pareada, virtualmnente, alcançou os mesmos resultados.

lincon(profitability ~ Perfil, data = base_merge_disc)

## Call:
## lincon(formula = profitability ~ Perfil, data = base_merge_disc)
## 
##           psihat ci.lower ci.upper p.value
## D vs. I -0.28612 -0.46993 -0.10231 0.00020
## D vs. S  0.74451  0.03980  1.44922 0.01230
## I vs. S  1.03063  0.32634  1.73491 0.00059

Kruskal-Wallis individual por DISC

O KW é, baiscamente, uma ANOVA de uma via após ranquear os resultados da variável dependente (profitability). No entanto, ao fazer isso, ele se desvincula de uma distribuição típica e, portanto, é considerado um teste não-paramétrico. Como pode ser visto na tabela a seguir, os resultados do KW foram virtualmente idênticos aos alcançados pela ANOVA (X2(2) = 24.438, p < 0.01).

prof_disc_individual_kw <- kruskal.test(profitability ~ Perfil, base_merge_disc)
car::Anova(aov(profitability ~ Perfil, base_merge_disc), type=3)

## Anova Table (Type III tests)
## 
## Response: profitability
##             Sum Sq    Df F value    Pr(>F)    
## (Intercept)  24716     1 694.832 < 2.2e-16 ***
## Perfil        3413     2  47.974 < 2.2e-16 ***
## Residuals   417922 11749                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Anova(aov(rank(profitability) ~ Perfil, base_merge_disc), type=3)

A interpretação do KW é, no entanto, algo diferente. Como o que é feito antes da modelagem dos dados é um ranqueamento. Quando os valores são significativos, isso significa que existe uma diferença significativa nos ranqueamentos médios entre os grupos.

Esses resultados foram importantes à pesquisa e permitiram levantar uma investigação exploratória para verificar a possível influência do perfil de personalidade (otido pelo DISC) no rendimento médio obtido após a implementação da base do conhecimento. Isso também permitiu verificar com maior profundidade os GPs que participaram dessa pesquisa.

Para verificar esse novo problema de pesquisa, será necessário ter informações da base projectinfo e da base uso. Para que não haja prejuízos nessa etapa, iremos limpar todas as possíveis inconsistências entre as bases e um novo objeto (base_merge_disc) aglutinará as informações. A esse momento, essas informações serão omitas para preservar a assertividade do relatório.

#vamos contar os PM_ID
projectinfo %>% count(PM_ID)
uso %>% count(PM_ID)

#clean names and remove spaces of each variable (vai deixar lowercase todas as variaveis)
projectinfo$PM_ID <- gsub(" ", "", projectinfo$PM_ID, fixed = TRUE)
uso$PM_ID <- gsub(" ", "", uso$PM_ID, fixed = TRUE)

#Finalmente, unir as bases
base_merge_disc <- left_join(projectinfo, uso, by="PM_ID")

#Transform perfil em fator
base_merge_disc <- base_merge_disc %>% 
  mutate(Perfil = as.factor(Perfil))


O *boxplot* a seguir re?ne o Perfil e a Rentability. ? importante atentar que, formalmente, os testes de hip?teses estimam valores m?dios e n?o medianos. Algumas excessoes ocorrem em vers?es n?o-param?tricas de testes de hip?tese em que as distribui??es dos diferentes grupos s?o sim?tricas em suas formas.

#create a tempdataset to gather median values
base_merge_disc %>% 
  group_by(Perfil) %>% 
  summarise(Median=round(median(profitability),3)) -> med_temp

ggplot(base_merge_disc, aes(x=Perfil, y=profitability)) + 
  geom_boxplot() +
  labs(title = "Relacão entre Profitability em fun??o do Perfil do GP") +
  geom_text(data = med_temp, aes(label = Median, x = Perfil, y = 0),  size=5) #recover median values from specific ds
#remove unused dataset
rm(med_temp)

A distribui??o de cada perfil encontra-se abaixo: **Era essa a VD??**

base_merge_disc %>% 
  dplyr::select(key=Perfil, value=profitability) %>% 
  gather()  -> plot_perfil_density
  
ggplot(plot_perfil_density, aes(x = value, y = key, fill=key)) + 
  geom_density_ridges(
    jittered_points = TRUE,
    position = position_points_jitter(width = 0.05, height = 0),
    point_shape = '|', point_size = 3, point_alpha = 1, alpha = 0.8
  ) +
  theme_ridges() +
  theme(legend.position="none") +
  labs(fill="", x="Profitability", y="")

Nova Hipotese 2

Menu inicial

H2: Existe rela??o entre o perfil de gest?o e o tipo de a??o a ser tomada por problemas em determinados entreg?veis.

o Prova Proposta: Ser? verificado para o deliverable 2_26 as diferentes solu??es tomadas por perfil de GP, uma vez que esse foi o deliverable que representa a maior necessidade de acesso a base. Nesse deliverables precisamos fazer uns testes para verificar Perfil X Solu??o. Ser? apenas utilizada a base USO.

fase_completa %>%  #get datasaet
  filter(F_deliver == "2_26")-> escolha_2_26

source("http://pcwww.liv.ac.uk/~william/R/crosstab.r")
#crosstab(escolha_2_26, row.vars = "Solution", col.vars = "Perfil", type = "f")

Existe uma associa??o significativa entre Perfil e Solu??es (p = chisq.test(4.997501210^{-4}), o que indica que essas duas vari?veis n?o s?o independentes entre si. Uma das formas que se pode verificar se existe uma diferen?a signficativa da utiliza??o de cada solu??o em cada perfil ? pela compara??o dos resultados observados em cada solu??o pelo resultado m?dio de cada perfil. Para esse teste, assumiu-se como Hip?tese nula de que o valor da utiliza??o de cada solu??o seria o valor m?dio alcan?ado em cada Perfil. Jair, fale com o Prof. Barroso, pois essa tomada de decis?o inferencial poder? receber muitas cr?ticas…

#Jair, n?o repare a sintexe... est? bem desorganizada de sentiod l?gico e generaliz?vel
escolha_2_26 %>%  #get datasaet
    group_by(Perfil, Solution) %>%  #grouping variable
    count() %>%  #sum unique
    bind_rows(group_by(.,Perfil) %>% #ADD MEAN
                summarise(n=mean(n) %>% round(.,1)) %>%
                 mutate(Solution='yM?dia')) %>% 
  bind_rows(group_by(.,Perfil) %>% #ADD STANDARD DEVIATION
              filter(Solution != "yM?dia") %>% 
              summarise(n=sd(n) %>% round(.,1)) %>%
              mutate(Solution='z_Desvio')) %>% 
  spread(Perfil, n, fill="0") -> tab_hipotese2


tab_hipotese2 <- tab_hipotese2 %>% 
  mutate_if(is.character, as.numeric)

## `mutate_if()` ignored the following grouping variables:
## Column `Solution`

#D
tab_hipotese2 <- tab_hipotese2 %>% 
  mutate(D_Tvalor = D - tab_hipotese2$D[tab_hipotese2$Solution == "yM?dia"]/
           ((tab_hipotese2$D[tab_hipotese2$Solution == "z_Desvio"])/sqrt(13)),
         D_PValor =  2*pt(D_Tvalor, 12, lower=FALSE))
#I
tab_hipotese2 <- tab_hipotese2 %>% 
  mutate(I_Tvalor = I - tab_hipotese2$I[tab_hipotese2$Solution == "yM?dia"]/
           (tab_hipotese2$I[tab_hipotese2$Solution == "z_Desvio"]/sqrt(13)),
         I_PValor =  2*pt(I_Tvalor, 12, lower=FALSE))
#S
tab_hipotese2 <- tab_hipotese2 %>% 
  mutate(S_Tvalor = S - tab_hipotese2$S[tab_hipotese2$Solution == "yM?dia"]/
           (tab_hipotese2$S[tab_hipotese2$Solution == "z_Desvio"]/sqrt(13)),
         S_PValor =  2*pt(S_Tvalor, 12, lower=FALSE))

#Arrange columns

tab_hipotese2 <- tab_hipotese2 %>% 
  dplyr::select(Solution, D, D_PValor, I, I_PValor, S, S_PValor) %>% 
  mutate_at(vars(-Solution), funs(round(.,2))) %>% 
  filter(Solution != "yM?dia" & Solution != "z_Desvio")

## Warning: funs() is soft deprecated as of dplyr 0.8.0
## please use list() instead
## 
## # Before:
## funs(name = f(.)
## 
## # After: 
## list(name = ~f(.))
## This warning is displayed once per session.

#Display tab
tab_hipotese2 %>% kable() %>% kable_styling()

Uma das formas poss?veis de verificar as chances de uso de cada uma das solu??es em fun??o dos perfil se d? por uma regress?o log?stica multinomial. Esse modelo permite verificar a rela??o funcional de uma vari?vel dependente com mais de dois n?veis sem ordena??o espec?fica e vari?veis independentes tanto cont?nuas quanto discretas.

Nesse caso espec?fico, dado que a categoria de refer?ncia das solu??es ? a Solu??o 17, a modelagem ocorre da seguinte forma:

\(ln(\frac{Solucao 1}{Solucao 17}) = b_0 + b_1(Perfil = I) + b_2(Perfil = S)\)

#Modelo de regressao logistica

escolha_2_26 <- escolha_2_26 %>% 
  mutate(Solution17 = relevel(factor(Solution), ref="Solution 17"))

#Jair, fiz isso s? para fins de cmopara??o
escolha_2_26 <- escolha_2_26 %>% 
  mutate(Perfil_S = relevel(factor(Perfil), ref="S"))


#Change the intercept to solution17

mod_escolha <- multinom(formula = Solution17 ~ factor(Perfil), data = escolha_2_26)

## # weights:  52 (36 variable)
## initial  value 2049.394537 
## iter  10 value 1630.323923
## iter  20 value 1613.598148
## iter  30 value 1612.481155
## iter  40 value 1612.337606
## final  value 1612.334460 
## converged

summary(mod_escolha)

## Call:
## multinom(formula = Solution17 ~ factor(Perfil), data = escolha_2_26)
## 
## Coefficients:
##             (Intercept) factor(Perfil)I factor(Perfil)S
## Solution 1   1.32158998    -2.665132347     -2.01492801
## Solution 10 -0.69327056     1.988655022    -11.71546199
## Solution 11 -0.87561795     0.138040410      1.97408587
## Solution 12 -0.40568325    -0.783842490    -13.39845257
## Solution 2  -0.08713467     1.242158834      0.08692829
## Solution 3  -0.08723530    -1.661922312      0.78024521
## Solution 4  -0.87569394     0.305184543    -12.30143661
## Solution 5   2.23342979    -2.149981427     -2.92627303
## Solution 6   0.45932119     1.442187548     -0.05396141
## Solution 7   0.51065406    -0.701671274      1.50409403
## Solution 8  -0.18247475    -0.008510761     -0.51093743
## Solution 9   1.40673228    -1.977195002    -16.22480954
## 
## Std. Errors:
##             (Intercept) factor(Perfil)I factor(Perfil)S
## Solution 1    0.3248719       0.5618416    1.267096e+00
## Solution 10   0.4999792       0.5525980    3.499289e+02
## Solution 11   0.5322747       0.6463041    9.746369e-01
## Solution 12   0.4564275       0.6282223    5.489690e-04
## Solution 2    0.4174025       0.4810447    1.083602e+00
## Solution 3    0.4174134       0.6838988    9.613363e-01
## Solution 4    0.5322887       0.6354025    1.441610e-03
## Solution 5    0.3037237       0.4191995    1.261644e+00
## Solution 6    0.3687188       0.4311933    9.844847e-01
## Solution 7    0.3651299       0.4789915    8.366123e-01
## Solution 8    0.4281569       0.5286111    1.297453e+00
## Solution 9    0.3220683       0.4734232    1.646268e-04
## 
## Residual Deviance: 3224.669 
## AIC: 3296.669

#Calcular a signific?ncia das variaveis no modelo
z <- summary(mod_escolha)$coefficients/summary(mod_escolha)$standard.errors
#Calcular o que ? significativo nesse modelo via wald test
p <- round((1 - pnorm(abs(z), 0, 1)) * 2,1)
#OR
#exp(coef(mod_escolha))
#p

cbind(coef(mod_escolha),p)

##             (Intercept) factor(Perfil)I factor(Perfil)S (Intercept)
## Solution 1   1.32158998    -2.665132347     -2.01492801         0.0
## Solution 10 -0.69327056     1.988655022    -11.71546199         0.2
## Solution 11 -0.87561795     0.138040410      1.97408587         0.1
## Solution 12 -0.40568325    -0.783842490    -13.39845257         0.4
## Solution 2  -0.08713467     1.242158834      0.08692829         0.8
## Solution 3  -0.08723530    -1.661922312      0.78024521         0.8
## Solution 4  -0.87569394     0.305184543    -12.30143661         0.1
## Solution 5   2.23342979    -2.149981427     -2.92627303         0.0
## Solution 6   0.45932119     1.442187548     -0.05396141         0.2
## Solution 7   0.51065406    -0.701671274      1.50409403         0.2
## Solution 8  -0.18247475    -0.008510761     -0.51093743         0.7
## Solution 9   1.40673228    -1.977195002    -16.22480954         0.0
##             factor(Perfil)I factor(Perfil)S
## Solution 1              0.0             0.1
## Solution 10             0.0             1.0
## Solution 11             0.8             0.0
## Solution 12             0.2             0.0
## Solution 2              0.0             0.9
## Solution 3              0.0             0.4
## Solution 4              0.6             0.0
## Solution 5              0.0             0.0
## Solution 6              0.0             1.0
## Solution 7              0.1             0.1
## Solution 8              1.0             0.7
## Solution 9              0.0             0.0

Nesse sentido, é poss?vel concluir que participantes com o Perfil I estão associados com a diminui??o no log da raz?o de chances ? escolha da Solu??o 1 vs. Solu??o 17 na quantidade de -2.67. Frequentemente, para ganhar facilidade interpretativa, altera-se algebricamente os resultados para conseguir ter a possibilidade de falar sobre Raz?o de chances. Por exemplo, a raz?o de chances do Perfil I usar a Solução 1 vs. Solução 17 ? de \[exp^{-2.66}\]. A Raz?o de chances Perfil S comparado ao Perfil D usar a solu??o 1 em vez da Solução 17 ? \(exp^{-2.01}\).

Hipotese 3

Menu inicial

Ap?s reuni?o em Novembro 5 e e-mail na mesma data, em que: Conclus?o, n?s temos que provar que a frequ?ncia da solu??o 17 ? menor que a m?dia de uso das solu??es na base uso. Das 3449 ocorr?ncias temos 12 solu??es em uso.

H3: O perfil de lideran?a do gerente condiciona sua tend?ncia na tomada de decis?o independente da fase do projeto

Prova Proposta: Precisamos analisar a solu??o S17, que ? uma solu??o n?o existe na base de forma. Fazer alguns testes nessa solu??o e verificar qual perfil usa mais ela e se os resultados apontam alguma relev?ncia do tipo, estamos perdendo conhecimento ou existe um potencial de aquisi??o de novo conhecimento para base
Alguns pontos a ser considerados:
1. Freq_relativa est? em 4.64 2. A m?dia das solu??es ? 7.69 (T?cnicamente, a m?dia das propor??es das solu??es…)
3. Fazer um gr?fico das solu??es em torno da m?dia.
4. Fazer um teste q quadrado entre 4.64 e 7.69 e fazer as an?lises.

uso %>%
  count(Solution) %>% 
  mutate(Props=prop.table(n)) %>% 
  bind_rows(summarise_all(., funs(if(is.numeric(.)) mean(.) else "Media")))

## # A tibble: 14 x 3
##    Solution        n  Props
##    <chr>       <dbl>  <dbl>
##  1 Solution 1   246  0.0713
##  2 Solution 10  405  0.117 
##  3 Solution 11   91  0.0264
##  4 Solution 12   81  0.0235
##  5 Solution 17  160  0.0464
##  6 Solution 2   348  0.101 
##  7 Solution 3    83  0.0241
##  8 Solution 4    78  0.0226
##  9 Solution 5   583  0.169 
## 10 Solution 6   758  0.220 
## 11 Solution 7   175  0.0507
## 12 Solution 8   159  0.0461
## 13 Solution 9   282  0.0818
## 14 Media        265. 0.0769

O gr?fico a seguir apresenta as propor??es das distribui??es das solu??es

uso %>%
  count(Solution) %>% #count frequencies
  mutate(Props=prop.table(n)) %>%  #transform to proportions
  bind_rows(summarise_all(., funs(if(is.numeric(.)) mean(.) else "Media"))) %>% #compute the grand mean
  mutate(Position = fct_reorder(Solution, Props)) %>%  #arrange by props
  mutate(Colorir = if_else(Solution == "Media","purple","grey50")) %>% #get colors
  ggplot(., aes(x=Position, y=Props, fill = Colorir)) +  #plot
  geom_col(colour = "black",show.legend = FALSE) + 
  coord_flip()

#scale_x_discrete(limits=c("Solution 9","Media","Solution 8"))

Formalmente, apesar de bastante controverso, uma forma de verificar se a propor??o de uso da Solu??o 17 ? inferior ao que estamos chamando de propor??o m?dia, ? computar o intervalo de confian?a para cada solu??o, al?m de executar esse procedimento ? m?dia. Essa tarefa anal?tica envolve alguma programa??o externa ?s sintaxes padr?es tidyverse e dplyr.

uso %>%
  count(Solution) %>% #count frequencies
  mutate(Props=prop.table(n)) %>%  #transform to proportions
  bind_rows(summarise_all(., funs(if(is.numeric(.)) mean(.) else "Media"))) %>% #compute the grand mean
  mutate(Position = fct_reorder(Solution, Props)) %>%  #arrange by props
  mutate(Colorir = if_else(Solution == "Media","purple","grey50")) -> j 

  #Crate a new variable in the dataset to gather all looping reuslts
  j <- j %>% mutate(lower = '')  
  
  #looping
  for(i in 1:nrow(j)) { 
    j$lower[i] <- blakerci(j$n[i], 3449, conf.level=0.95)
  }
  
  #row to columns
  j <- separate(data = j, col = lower, into = c("lower", "upper"), sep = ",")
  
  #replace strings
  j <- j %>% mutate(lower = gsub("c(", "", lower, fixed = TRUE),
                    upper = gsub(")", "", upper, fixed = TRUE)) 
  
  #Transform to numeric
  j <- j %>% mutate_at(vars(lower, upper), funs(as.numeric(.)))
  
  #Change string
  j <- j %>% mutate(Solution = gsub("Solution ", "S", .$Solution))

  #change position
  j <- j %>% mutate(Position = fct_reorder(Solution, Props))

De posse dessas informações, a Tabela abaixo apresenta os resultados. Uma vez que a Solution 17 tem intervalos inferiores e fora dos intervalos da m?dia, ? poss?vel concluir que seu uso foi significativamente menor do que o uso m?dio. Visando preven??o de poss?veis erros inferenciais, o IC 95% foi calculado pelo M?todo Exato de Blaker, que ? considerado conservador, uma vez que realiza o intervalo de confian?a a partir de uma fun?ao densidade mesmo em uma vari?vel bin?ria, cujo função de probabilidade é de massa.

j %>% dplyr::select(-c(Position,Colorir)) %>% kable(digits = 3)

O gr?fico a seguir visa a mesma apresenta??o

ggplot(data=j, aes(x=Position, y=Props, colour=Colorir)) + 
  geom_point(cex = 2) + 
  geom_line() +
  #geom_ribbon(aes(ymin=j$lower, ymax=j$upper), linetype=2) +
  geom_errorbar(aes(ymin=lower, ymax=upper), width=.2, size=.7,
                position=position_dodge(.9)) +
  guides(fill=FALSE, color=FALSE) # (supress the legend)

## geom_path: Each group consists of only one observation. Do you need to
## adjust the group aesthetic?

Essa parte embaixo serve como um complemento e ilustro os passos anteriores que fizemos

Resposta: A base fase_completa ser? utilizada e o teste de propor??es ser? calculado para essa finalidade.

fase_completa %>% 
  mutate(n_encontrado = if_else(Solution == "Solution 17","novo","antigo")) %>% 
  group_by(n_encontrado) %>% 
  summarise(n=n()) %>% 
  mutate(sum = prop.table(n)*100) %>%
  bind_rows(summarise_all(., funs(if(is.numeric(.)) sum(.) else "Total")))

## # A tibble: 3 x 3
##   n_encontrado     n    sum
##   <chr>        <int>  <dbl>
## 1 antigo        3289  95.4 
## 2 novo           160   4.64
## 3 Total         3449 100

prop.test(160, 3449, p = 0.05, alternative = "greater")

## 
##  1-sample proportions test with continuity correction
## 
## data:  160 out of 3449, null probability 0.05
## X-squared = 0.87166, df = 1, p-value = 0.8248
## alternative hypothesis: true p is greater than 0.05
## 95 percent confidence interval:
##  0.04071041 1.00000000
## sample estimates:
##          p 
## 0.04639026

Os resultados mostraram que a propor??o das utiliza??es da solution 17 n?o ? igual ou inferior a 5%.

Como o deliverable_2_26 ? o mais utilizado, surgiu a necessidade de verificar a poss?vel exist?ncia entre o perfil de gest?o e o tipo de a??o tomada considerando apenas esse perfil. Novamente, o teste qui-quadrado foi realizado e se mostrou significativo.

#Qui quadrado, uma vez que ha duas variaveis categoricas e voce deseja ver a associacao entre elas 
fase_completa %>% 
  filter(F_deliver == "2_26") %>% 
  do(tidy(chisq.test(.$Solution, .$Perfil, simulate.p.value = TRUE)))

## # A tibble: 1 x 4
##   statistic  p.value parameter method                                      
##       <dbl>    <dbl> <lgl>     <chr>                                       
## 1      463. 0.000500 NA        "Pearson's Chi-squared test with simulated ~

E a tabela abaixo concatena tais resultados.

fase_completa %>%  #get datasaet
    #filter(F_deliver == "2_26") %>% 
  group_by(Perfil, Solution) %>%  #grouping variable
  count() %>%  #sum unique
  bind_rows(group_by(.,Perfil) %>% #create new variable to sum up
              summarise(n=sum(n)) %>%
              mutate(Solution='Total')) %>% 
  bind_rows(group_by(.,Solution) %>% #  #create new variable to sum up
              summarise(n=sum(n)) %>%
              mutate(Perfil='Total')) %>%
  spread(Perfil, n, fill="0") %>%  #spread format
  kable() %>% kable_styling() %>% 
  row_spec(14, bold = T, color = "black", background = "white") %>% 
    footnote(general = "A Legenda a seguir apresenta as defini??es utilizadas na Tabela. ",
           number = c("D: Dominance ", "I: Influence", "S: Steadiness")) #report in a nice style

Formalmente, essa etapa encerra a resposta à hipótese 3.

Veja os resultados do treinamento

round(head(modelrf_CG$importance,4),5)

##                           A        B        C MeanDecreaseAccuracy
## Perfil_DISC        -0.01782  0.00730 -0.02153             -0.00863
## Numero_de_Projetos  0.02778  0.00369  0.07078              0.02951
## QTD_Uso_base        0.00517 -0.00980  0.01489              0.00225
##                    MeanDecreaseGini
## Perfil_DISC                 0.90771
## Numero_de_Projetos          3.34830
## QTD_Uso_base                5.10894

modelrf_CG$confusion

##    A  B  C class.error
## A  8 12 12   0.7500000
## B 11  8 16   0.7714286
## C  2 11 14   0.4814815

# Aplicando o modelo do conjunto de teste
prev <- predict(modelrf_CG, test, type="response")
MC2 <- caret::confusionMatrix(prev, test$Classe_ganho)$table

MC2

##           Reference
## Prediction A B C
##          A 6 0 0
##          B 1 4 3
##          C 1 2 2