How to calculate MODA with bimodal value in a date.frame in R?

Question

I need to calculate the MODA of online values in a data.frame. As in R there is no function already set for FASHION, I used a custom function:

moda = function(x) {
  z = table(as.vector(x))
  names(z)[z == max(z)]
}

teste1 = moda(c(1,2,3,4,5,5,5))

print(teste1)
[1] 5

The function moda works very well by the way, now let’s go to another case:

teste2 = moda(c(1,1,1,2,3,4,5,5,5))

    print(teste2)
    [1] "1" "5"

In teste2, the vector has bimodal value and the function moda displays two values. Now let’s go to the third case using a data.frame:

print(DADOS)

 Linha  A   B   C   D   E
 L1     4   3   2   1   4
 L2     1   11  1   1   1
 L3     0   1   2   2   4
 L4     2   0   0   8   0

In this case I will have to create another column with values of each line calculated by MODA:

DADOS = DADOS %>%
rowwise() %>%
mutate(MODA = moda(c(A,B,C,D,E)))

print(DADOS)

 Linha  A   B   C   D   E  MODA
 L1     4   3   2   1   4   4
 L2     1   11  1   1   1   1
 L3     0   1   2   2   4   2
 L4     2   0   0   8   0   0

It worked perfectly, but we arrived at the "problem situation". In the latter case I will use a different data.frame:

print(DADOS_2)

Linha  A   B   C   D   E
L1     4   3   2   2   4
L2     1   11  1   1   1
L3     0   1   2   3   4
L4     2   0   0   8   0

As in the previous case I will have to create another column with values of each line calculated by MODA:

DADOS_2 = DADOS_2 %>%
rowwise() %>%
mutate(MODA = moda(c(A,B,C,D,E)))

print(DADOS_2)

Error: Column `MODA` must be length 1 (the group size), not 2

The R displays me the error message, because on the basis DADOS_2 the line L1 brings a clear example of bimodal L1 value=(4,3,2,2,4). And because it is a bimodal value, the R cannot assign two values in a single column.

What should I do in this case? How can I calculate MODA in line with bimodal value in a date.frame?

Answer 1

You can solve this problem with tidyverse. Rather, I create a reproducible example:

data <- data.frame(
  a = c(1, 2, 2, 7, 3), 
  b = c(2, 2, 1, 1, 2), 
  d = c(1, 3, 2, 2, 3), 
  e = c(2, 3, 1, 2, 2)
)

I’ll use the function you created:

moda = function(x) {
  z = table(as.vector(x))
  names(z)[z == max(z)]
}

Follows the code:

library(tidyverse)

res <- data %>% 
  mutate(my_mode_1 = pmap(., lift_vd(moda))) %>% 
  mutate_if(is.list, as.character) %>% 
  mutate(my_mode_2 = str_remove_all(string = my_mode_1, pattern = '[(),c"]')) %>% 
  separate(col = my_mode_2, sep = ' ', 
       into = c('mode_1', 'mode_2', 'mode_3'), fill = 'right') %>% 
  mutate_at(c('mode_1', 'mode_2', 'mode_3'), as.numeric) %>% 
  select(- my_mode_1)

res

  a b d e mode_1 mode_2 mode_3
1 1 2 1 2      1      2   <NA>
2 2 2 3 3      2      3   <NA>
3 2 1 2 1      1      2   <NA>
4 7 1 2 2      2     NA   <NA>
5 3 2 3 2      2      3   <NA>

Colon:

• On the line 4 there is only one fashion. Therefore, in mode_2, there is no value.
• Note that I purposely created an additional column. Because, if there were 3 fashions, the third one would be allocated there. But nothing stops you from removing this column with a select.