Divide value in each cell by the geometric mean of a specific row across columns and log-transform it

Question

I would like to devide value in each cell by the geometric mean of a specific row across columns and log-transforme it (natural logarithm).

df1
      col1  col2  col3
row1  1     777   6
row2  136   1     665
row3  0     100   97

result

df_new
      col1    col2      col3
row1  -2.81   3.83     
row2           
row3

example of the calculation for the row1

Where does the 789 come from? I get the product of 1, 777 and 6 as 4662. — meenaparam, Feb 04 '20 at 10:58
I get a different answer to Georgery but I think that solution is correct. — meenaparam, Feb 04 '20 at 11:08

Georgery · Accepted Answer · 2020-02-04T11:14:48.087

library(tidyverse)

geometric_mean <- function(x){
    exp(sum(log(x), na.rm = TRUE) / length(x))
}

yourCalculation <- function(x){
    log(x / geometric_mean(x))
}

myMatrix <- tribble(
    ~col1  ,~col2  ,~col3
    , 1     , 777   , 6
    , 136   , 1     , 665
    , 0     , 100   , 97) %>%
    as.matrix()


t(apply(myMatrix, 1, yourCalculation))

          col1      col2      col3
[1,] -2.815733  3.839707 -1.023974
[2,]  1.108508 -3.804147  2.695640
[3,]       NaN       Inf       Inf

Important about geometric means: Don't calculate them like this: prod(x)^(1/length(x)). The problem with this is, that with already medium sized vectors x you are likely to run across your type boundaries when you multiply them all and so it won't compute. The log()-and-exp() way is better.

ThomasIsCoding · Answer 2 · 2020-02-04T12:01:36.647

Maybe you can try the code below using as.matrix to convert data frame to matrix before math operation. Besides, you can use Reduce(*,df1) to achieve the product of columns in df1.

In this case, the one-liner solution is given as:

df_new <- data.frame(log(as.matrix(df1)/Reduce(`*`,df1)**(1/ncol(df1))))

such that

> df_new
          col1      col2      col3
row1 -2.815733  3.839707 -1.023974
row2  1.108508 -3.804147  2.695640
row3       NaN       Inf       Inf

score 0 · Answer 3 · answered Feb 04 '20 at 11:04

Here's an answer to your question. See this discussion for alternative formulae for nth-root calculations.

# set up the data
df <- data.frame(c(1, 777, 6), c(136, 1, 665), c(0, 100, 97))
df <- t(df)
colnames(df) <- c("V1", "V2", "V3")
rownames(df) <- NULL

# define a function to calculate the nth root
nthroot <- function(x, n){
    x^(1/n) 
}

# define a function to do your required transformations
cell_transformer <- function(x) {
    log(x/(nthroot(sapply(apply(df, 1, prod), sum), length(x))))
}

# apply the cell_transformer to your dataframe in a row-wise fashion
apply(df, 1, function(x) cell_transformer(x))    
#>         [,1]      [,2]      [,3]
#> V1 -2.815733  2.096922      -Inf
#> V2  2.851293 -3.804147 0.8010229
#> V3       Inf       Inf       Inf

^{Created on 2020-02-04 by the reprex package (v0.3.0)}

Divide value in each cell by the geometric mean of a specific row across columns and log-transform it

3 Answers3