Simulação - Índices de dominância

1 Funções para calcular os índices de dominância

\(D_1\)

Índice de dominância \(D_1\): \[D1 = \text{Norm}(HHI) = \frac{k \sum_{i=1}^{k} p_i^2 - 1}{k - 1}\]

D1 <- function(x){
  n <- length(x) # numero total de vendas
  prop <- table(x)/n # participacoes de mercado
  k <- length(prop) # numero de empresas
  
  HHI <- sum(prop^2) # indice de Herfindahl–Hirschman
  
  D1 <- (k*HHI - 1)/(k-1)
  return(D1)
}

\(D_2\)

Índice de Rosenbluth–Hall–Tidemann: \[\begin{align*} I_{\text{Ros}} &= \frac{1}{2\sum_{i=1}^{k} i\,p_{(i)} - 1} \end{align*}\]

Índice de dominância \(D_2\): \[\begin{align*} D_2 &= \frac{I_{\text{Ros}} - 1/k}{1- \frac{1}{k}} \\ &= \frac{k I_{\text{Ros}} - 1}{k - 1}. \end{align*}\]

D2 <- function(x){
  n <- length(x) # total de vendas
  prop <- table(x)/n # participacoes de mercado
  prop_O <- sort(prop, decreasing = T) # participacoes de mercado ordenadas
  pesos <- seq_along(prop_O) # indices das participacoes de mercado ordenadas
  k <- length(prop) # numero de empresas
  
  Iros <- 1/(2*sum(pesos*prop_O) - 1) # indice de Rosenbluth–Hall–Tidemann
  
  D2 <- (k*Iros - 1)/(k - 1)
  return(D2)
}

\(D_3\)

Entropia de Shannon: \[\begin{align*} H_s = -\sum_{i=1}^{k}p_i\ln p_i. \end{align*} \]

Índice de dominância \(D_3\): \[\begin{align*} D_3 &= 1 - \text{Norm}(H_s) \\ &= 1 - \frac{H_s}{\ln k} \end{align*}\]

D3 <- function(x){
  n <- length(x) # total de vendas
  prop <- table(x)/n # participacoes de mercado
  k <- length(prop) # numero de empresas
  
  Hs <- -sum(prop*log(prop)) # entropia de shannon
  HsNorm <- Hs/log(k) # entropia de shannon normalizada
  
  D3 <- 1 - HsNorm
  return(D3)
}

\(D_4\)

Índice de Heip: \[\begin{align*} I_{\text{Heip}} &= \frac{e^{H_S} - 1}{k - 1}, \end{align*}\]

Índice de dominância \(D_4\): \[\begin{align*} D_4 &= 1 - I_{\text{Heip}} \\ &= \frac{k - e^{H_S}}{k - 1} \end{align*}\]

D4 <- function(x){
  n <- length(x) # total de vendas
  prop <- table(x)/n # participacoes de mercado
  k <- length(prop) # numero de empresas
  
  Hs <- -sum(prop*log(prop)) # entropia de shannon
  Iheip <- (exp(Hs) - 1)/(k - 1) # indice de Heip
  
  D4 <- 1 - Iheip
  return(D4)
}

\(D_5\)

Índice de Hannah-Kay: \[\begin{align*} I_{HK}(\alpha) &= \left( \sum_{i=1}^{k} p_i^\alpha \right)^{\frac{1}{1-\alpha}}, \quad \alpha>0, \alpha \neq 1. \end{align*}\]

Índice de dominância \(D_5\): \[\begin{align*} D_5 &= \frac{k - I_{HK}(2)}{k - 1} \end{align*}\]

D5 <- function(x){
  n <- length(x) # total de vendas
  prop <- table(x)/n # participacoes de mercado
  k <- length(prop) # numero de empresas
  
  Ihk <- sum(prop^2)^(-1) # indice de Hannah-Kay
  
  D5 <- (k - Ihk)/(k-1)
  return(D5)
}

\(D_6\)

Estatística \(VA\): \[\begin{align*} VA &= 1 - \frac{\displaystyle \sum_{i=1}^{k} \left(f_i - \frac{n}{k}\right)^2} {n^2 \frac{(k-1)}{k}}, \end{align*}\]

Índice de dominância \(D_6\): \[\begin{align*} D_6 &= 1 - VA\\ &= \frac{k}{k-1} \left( \sum_{i=1}^{k} p_i^2 - \frac{1}{k} \right) \end{align*}\]

D6 <- function(x){
  n <- length(x) # total de vendas
  tab <- table(x) # participacoes de mercado
  k <- length(tab) # numero de empresas
  
  VA <- 1 - ( sum( (tab - (n/k))^2 )/( ( (n^2)*(k-1) )/k ) ) # estatistica VA
  
  D6 <- 1 - VA
  return(D6)
}

\(D_7\)

Estatística \(SDA\): \[\begin{align*} SDA &= 1 - \sqrt{\frac{\displaystyle \sum_{i=1}^{k} \left(f_i - \frac{n}{k}\right)^2} {n^2 \frac{(k-1)}{k}}} \end{align*}\]

Indice de dominância \(D_7\): \[\begin{align*} D_7 &= 1 - SDA \\[6pt] &= \sqrt{\frac{k}{k-1} \left(\sum_{i=1}^{k} p_i^2 - \frac{1}{k}\right)} \end{align*}\]

D7 <- function(x){
  n <- length(x) # total de vendas
  tab <- table(x) # participacoes de mercado
  k <- length(tab) # numero de empresas
  
  SDA <- 1 - sqrt( sum( (tab - (n/k))^2 )/( ( (n^2)*(k-1) )/k ) ) # estatistica SDA
  
  D7 <- 1 - SDA
  return(D7)
}

2 Simulação para os 18 casos

Caso 1

Configuração do primeiro caso com \(n=1000\)

emp <- c("1", "2", "3", "4") # empresas
p <- c(0.24, 0.26, 0.255, 0.245) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 1000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.0003333333 0.005937235 0.0003607556 0.0006666512 0.001332001 0.0003333333 0.01825742

Simulação

# iniciando com n = 1000

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

Teste de normalidade para cada conjunto dos índices calculados:

install.packages("tseries")
library(tseries) # pra fazer o teste de Jarque-Bera

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1    D2    D3    D4    D5    D6    D7   
## [1,] "rej" "rej" "rej" "rej" "rej" "rej" "rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D2, min = 88.5607"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D6, min = 91.9902"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D7, min = 0.3958"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D2, min = 0.4104"

Configuração do primeiro caso com \(n=3000\)

emp <- c("1", "2", "3", "4") # empresas
p <- c(0.24, 0.26, 0.255, 0.245) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 3000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.0003333333 0.005937235 0.0003607556 0.0006666512 0.001332001 0.0003333333 0.01825742

Simulação

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

Teste de normalidade para cada conjunto dos índices calculados:

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1    D2    D3    D4    D5    D6    D7   
## [1,] "rej" "rej" "rej" "rej" "rej" "rej" "rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D2, min = 44.4572"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D6, min = 46.5756"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D7, min = 0.3795"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D2, min = 0.3914"

Caso 2

Configuração do segundo caso com \(n=1000\)

emp <- c("1", "2", "3", "4") # empresas
p <- c(0.85, 0.05, 0.05, 0.05) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 1000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.64 0.5 0.5762077 0.7335047 0.8767123 0.64 0.8

Simulação

# iniciando com n = 1000

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1      D2      D3      D4      D5    D6      D7     
## [1,] "ñ rej" "ñ rej" "ñ rej" "ñ rej" "rej" "ñ rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D5, min = 1.0163"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D6, min = 1.483"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D5, min = 0.0127"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D6, min = 0.0185"

Configuração do segundo caso com \(n=3000\)

emp <- c("1", "2", "3", "4") # empresas
p <- c(0.85, 0.05, 0.05, 0.05) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 3000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.64 0.5 0.5762077 0.7335047 0.8767123 0.64 0.8

Simulação

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

Teste de normalidade para cada conjunto dos índices calculados:

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1      D2      D3      D4      D5      D6      D7     
## [1,] "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D5, min = 0.5898"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D6, min = 0.8616"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D5, min = 0.0075"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D6, min = 0.0109"

Caso 3

Configuração do terceiro caso com \(n=1000\)

emp <- c("1", "2", "3", "4") # empresas
p <- c(0.35, 0.45, 0.1, 0.1) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 1000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.1266667 0.1604938 0.1435562 0.2406123 0.3671498 0.1266667 0.3559026

Simulação

# iniciando com n = 1000

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1      D2      D3      D4      D5    D6      D7   
## [1,] "ñ rej" "ñ rej" "ñ rej" "ñ rej" "rej" "ñ rej" "rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D7, min = 3.353"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D5, min = 4.8542"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D7, min = 0.0418"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D5, min = 0.0604"

Configuração do terceiro caso com \(n=3000\)

emp <- c("1", "2", "3", "4") # empresas
p <- c(0.35, 0.45, 0.1, 0.1) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 3000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.1266667 0.1604938 0.1435562 0.2406123 0.3671498 0.1266667 0.3559026

Simulação

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

Teste de normalidade para cada conjunto dos índices calculados:

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1    D2    D3    D4    D5      D6    D7     
## [1,] "rej" "rej" "rej" "rej" "ñ rej" "rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D7, min = 1.9669"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D5, min = 2.8493"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D7, min = 0.025"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D5, min = 0.0362"

Caso 4

Configuração do quarto caso com \(n=1000\)

emp <- c("1", "2", "3", "4", "5", "6") # empresas
p <- c(0.2, 0.2, 0.2, 0.05, 0.15, 0.2) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 1000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.022 0.03529412 0.03898655 0.08096464 0.1189189 0.022 0.148324

Simulação

# iniciando com n = 1000

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1      D2      D3    D4      D5      D6      D7     
## [1,] "ñ rej" "ñ rej" "rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D7, min = 4.9948"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D5, min = 9.0993"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D7, min = 0.0565"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D2, min = 0.0939"

Configuração do quarto caso com \(n=3000\)

emp <- c("1", "2", "3", "4", "5", "6") # empresas
p <- c(0.2, 0.2, 0.2, 0.05, 0.15, 0.2) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 3000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.022 0.03529412 0.03898655 0.08096464 0.1189189 0.022 0.148324

Simulação

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

Teste de normalidade para cada conjunto dos índices calculados:

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1    D2      D3    D4    D5    D6    D7     
## [1,] "rej" "ñ rej" "rej" "rej" "rej" "rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D7, min = 2.9047"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D5, min = 5.2569"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D7, min = 0.0356"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D2, min = 0.0605"

Caso 5

Configuração do quinto caso com \(n=1000\)

emp <- c("1", "2", "3", "4", "5", "6") # empresas
p <- c(0.01, 0.01, 0.01, 0.01, 0.01, 0.95) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 1000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.8836 0.7230769 0.8442943 0.9356419 0.9785161 0.8836 0.94

Simulação

# iniciando com n = 1000

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1      D2      D3      D4      D5      D6      D7     
## [1,] "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D5, min = 0.2491"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D6, min = 0.675"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D5, min = 0.0031"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D6, min = 0.0084"

Configuração do quinto caso com \(n=3000\)

emp <- c("1", "2", "3", "4", "5", "6") # empresas
p <- c(0.01, 0.01, 0.01, 0.01, 0.01, 0.95) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 3000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.8836 0.7230769 0.8442943 0.9356419 0.9785161 0.8836 0.94

Simulação

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

Teste de normalidade para cada conjunto dos índices calculados:

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1      D2      D3      D4      D5      D6      D7     
## [1,] "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D5, min = 0.149"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D6, min = 0.4037"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D5, min = 0.0019"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D6, min = 0.005"

Caso 6

Configuração do sexto caso com \(n=1000\)

emp <- c("1", "2", "3", "4", "5", "6") # empresas
p <- c(0.01, 0.01, 0.02, 0.02, 0.47, 0.47) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 1000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.33136 0.3172414 0.4651595 0.678545 0.7483288 0.33136 0.5756388

Simulação

# iniciando com n = 1000

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1      D2      D3      D4      D5      D6      D7     
## [1,] "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D5, min = 0.7063"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D6, min = 0.9398"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D5, min = 0.0087"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D6, min = 0.0116"

Configuração do sexto caso com \(n=3000\)

emp <- c("1", "2", "3", "4", "5", "6") # empresas
p <- c(0.01, 0.01, 0.02, 0.02, 0.47, 0.47) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 3000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.33136 0.3172414 0.4651595 0.678545 0.7483288 0.33136 0.5756388

Simulação

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

Teste de normalidade para cada conjunto dos índices calculados:

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1      D2      D3      D4      D5      D6      D7     
## [1,] "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D5, min = 0.4264"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D6, min = 0.5669"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D5, min = 0.0053"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D6, min = 0.007"

Caso 7

Configuração do sétimo caso com \(n=1000\)

emp <- c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10") # empresas
p <- c(0.09, 0.11, 0.09, 0.11, 0.09, 0.11, 0.09, 0.11, 0.09, 0.11) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 1000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.001111111 0.005847953 0.002175106 0.00555094 0.0110011 0.001111111 0.03333333

Simulação

# iniciando com n = 1000

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1    D2      D3    D4    D5    D6    D7     
## [1,] "rej" "ñ rej" "rej" "rej" "rej" "rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D7, min = 37.9476"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D2, min = 56.5749"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D7, min = 0.2024"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D2, min = 0.2227"

Configuração do sétimo caso com \(n=3000\)

emp <- c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10") # empresas
p <- c(0.09, 0.11, 0.09, 0.11, 0.09, 0.11, 0.09, 0.11, 0.09, 0.11) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 3000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.001111111 0.005847953 0.002175106 0.00555094 0.0110011 0.001111111 0.03333333

Simulação

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

Teste de normalidade para cada conjunto dos índices calculados:

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1    D2      D3    D4    D5    D6    D7     
## [1,] "rej" "ñ rej" "rej" "rej" "rej" "rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D7, min = 17.4775"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D2, min = 29.86"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D7, min = 0.1583"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D2, min = 0.1686"

Caso 8

Configuração do oitavo caso com \(n=1000\)

emp <- c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10") # empresas
p <- c(0.91, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 1000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.81 0.4736842 0.7827277 0.9278671 0.9770808 0.81 0.9

Simulação

# iniciando com n = 1000

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1      D2      D3      D4    D5    D6      D7     
## [1,] "ñ rej" "ñ rej" "ñ rej" "rej" "rej" "ñ rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D5, min = 0.2132"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D4, min = 0.644"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D5, min = 0.0027"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D4, min = 0.008"

Configuração do oitavo caso com \(n=3000\)

emp <- c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10") # empresas
p <- c(0.91, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 3000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.81 0.4736842 0.7827277 0.9278671 0.9770808 0.81 0.9

Simulação

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

Teste de normalidade para cada conjunto dos índices calculados:

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1      D2    D3      D4      D5      D6      D7     
## [1,] "ñ rej" "rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D5, min = 0.1219"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D4, min = 0.3658"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D5, min = 0.0015"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D4, min = 0.0046"

Caso 9

Configuração do nono caso com \(n=1000\)

emp <- c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10") # empresas
p <- c(0.45, 0.47, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 1000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.3602222 0.2885691 0.5298316 0.7830718 0.8491802 0.3602222 0.6001852

Simulação

# iniciando com n = 1000

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1      D2      D3      D4      D5      D6      D7     
## [1,] "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D5, min = 0.431"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D6, min = 0.9155"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D5, min = 0.0054"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D6, min = 0.0114"

Configuração do nono caso com \(n=3000\)

emp <- c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10") # empresas
p <- c(0.45, 0.47, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01) # participacoes de mercado
k <- length(emp) # numero de empresas


n <- 3000 # numero de elementos de cada amostra
N <- 1000 # numero de amostras

Cálculo dos índices de dominância teóricos

# Indices de dominancia teoricos:

D1_T <- (k*sum(p^2) -1)/(k-1) # indice de Herfindahl–Hirschmann normalizado

p_O <- sort(p, decreasing = T)
pesos <- seq_along(p_O)
Iros <- 1/(2*sum(pesos*p_O)-1)
D2_T <- (k*Iros - 1)/(k-1) # indice de Rosenbluth–Hall–Tidemann normalizado

Hs <- -sum(p*log(p))
D3_T <- 1 - Hs/log(k) # indice de Shannon normalizado

Iheip <- (exp(Hs) - 1)/(k - 1)
D4_T <- 1 - Iheip # indice de Heip

Ihk <- sum(p^2)^(-1)
D5_T <- (k - Ihk)/(k-1) # indice de Hannah-Kay

VA <- 1 - ( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D6_T <- 1 - VA

SDA <- 1 - sqrt( sum(( (n*p) - (n/k) )^2) / (( (n^2)*(k-1) )/k) )
D7_T <- 1 - SDA

cat(D1_T, D2_T, D3_T, D4_T, D5_T, D6_T, D7_T)

## 0.3602222 0.2885691 0.5298316 0.7830718 0.8491802 0.3602222 0.6001852

Simulação

m1 <- matrix(0, nrow <- n, ncol <- N) # matiz que vai receber as amostras
d1 <- matrix(0, nrow <- N, ncol <- 7) # guarda os indices de dominancia

set.seed(123)
for (i in 1:N){
  a <- sample(emp, size = n, replace = T, prob = p) # gera uma amostra
  m1[,i] <- a # cada coluna da matriz vai ser uma amostra
  
  d1[i, 1] <- D1(a) # cada coluna de d1 recebe um indice de dominancia
  d1[i, 2] <- D2(a)
  d1[i, 3] <- D3(a)
  d1[i, 4] <- D4(a)
  d1[i, 5] <- D5(a)
  d1[i, 6] <- D6(a)
  d1[i, 7] <- D7(a)
}

Teste de Jarque-Bera para normalidade

Teste de normalidade para cada conjunto dos índices calculados:

# Testando normalidade

alpha <- 0.05 # nivel de significancia

result_teste <- matrix(0, ncol = 7, nrow = 1) # vai guardar o resultado dos testes
colnames(result_teste) <- c("D1", "D2", "D3", "D4", "D5", "D6", "D7")

par(mfrow = c(3, 3), mar = c(3, 3, 2, 1))  # margens ajustadas
for (i in 1:7){
  hist(d1[,i], main = paste0("Histograma de D", i), col = i+1,
       xlab = paste0("D", i), ylab = "Frequência")
  teste <- jarque.bera.test(d1[,i]) # teste para normalidade
  result_teste[,i] <-  ifelse(teste$p.value < alpha, "rej", "ñ rej")
}
result_teste

##      D1      D2      D3      D4      D5      D6      D7     
## [1,] "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej" "ñ rej"

Cálculo do MAPE e do CV

# Calculando o MAPE (Erro Percentual Absoluto Médio)
MAPE1 <- mean((abs(D1_T - d1[,1])/D1_T)*100)
MAPE2 <- mean((abs(D2_T - d1[,2])/D2_T)*100)
MAPE3 <- mean((abs(D3_T - d1[,3])/D3_T)*100)
MAPE4 <- mean((abs(D4_T - d1[,4])/D4_T)*100)
MAPE5 <- mean((abs(D5_T - d1[,5])/D5_T)*100)
MAPE6 <- mean((abs(D6_T - d1[,6])/D6_T)*100)
MAPE7 <- mean((abs(D7_T - d1[,7])/D7_T)*100)
MAPE <- c(MAPE1, MAPE2, MAPE3, MAPE4, MAPE5, MAPE6, MAPE7)

paste0("Menor MAPE: D", which.min(MAPE), ", min = ", round(min(MAPE), 4))
## [1] "Menor MAPE: D5, min = 0.2537"
paste0("Segundo menor MAPE: D", which.min(MAPE[-which.min(MAPE)]), ", min = ", round(min(MAPE[-which.min(MAPE)]), 4))
## [1] "Segundo menor MAPE: D6, min = 0.5387"

# Calculando o CV
cv1 <- sd(d1[,1])/mean(d1[,1])
cv2 <- sd(d1[,2])/mean(d1[,2])
cv3 <- sd(d1[,3])/mean(d1[,3])
cv4 <- sd(d1[,4])/mean(d1[,4])
cv5 <- sd(d1[,5])/mean(d1[,5])
cv6 <- sd(d1[,6])/mean(d1[,6])
cv7 <- sd(d1[,7])/mean(d1[,7])
CV <- c(cv1, cv2, cv3, cv4, cv5, cv6, cv7)

paste0("Menor CV: D", which.min(CV), ", min = ", round(min(CV), 4))
## [1] "Menor CV: D5, min = 0.0031"
paste0("Segundo menor CV: D", which.min(CV[-which.min(CV)]), ", min = ", round(min(CV[-which.min(CV)]), 4))
## [1] "Segundo menor CV: D6, min = 0.0067"