Iterate sequentially over two lists in R

Rather than explicitly iterating over the different datasets and columns by name, you can take advantage of the vectorization built into R. If the dataframes have the same column/variable ordering a function mapped to both dataframes using mapply or purrr::map2 will iterate column by column without the need to specify column names.

Given two input data frames (df_small and df_big) the steps are:

1. Calculate the max of each column in df_small to create df_small_max
2. Apply the pmin function to each column of df_big and each value of df_small_max using mapply (or purr::map2_dfc if you prefer tidyverse mapping)

#set up fake data
df_small <- iris[,1:4]
df_big <- df_small + 2

# find max of each col in df_small
df_small_max <- sapply(df_small, max)

# replace values of df_big which are larger than df_small_max
df_big_fixed <- mapply(pmin, df_big, df_small_max)




# sanity check -- Note the change in Sepal.Width
df_small_max
#> Sepal.Length  Sepal.Width Petal.Length  Petal.Width 
#>          7.9          4.4          6.9          2.5
head(df_big, 3)
#>   Sepal.Length Sepal.Width Petal.Length Petal.Width
#> 1          7.1         5.5          3.4         2.2
#> 2          6.9         5.0          3.4         2.2
#> 3          6.7         5.2          3.3         2.2
head(df_big_fixed, 3)
#>      Sepal.Length Sepal.Width Petal.Length Petal.Width
#> [1,]          7.1         4.4          3.4         2.2
#> [2,]          6.9         4.4          3.4         2.2
#> [3,]          6.7         4.4          3.3         2.2

^{Created on 2021-07-31 by the reprex package (v2.0.0)}

It's likely that your issue is related to the fact that dataframes are themselves lists. Map() expects the non-function arguments to be lists of the same length. Any arguments that are shorter than the longest list are "recycled" to match it's length.

Currently, you have:

final_iris<- Map(fixmax,iris, iris2,lst1,lst2)

This is actually equivalent to:

final_iris<- Map(fixmax,
                 list(iris$Sepal.Length,
                      iris$Sepal.Width,
                      iris$Petal.Length,
                      iris$Petal.Width,
                      iris$Species),
                 list(iris2$Sepal_Length,
                      iris2$Sepal_Width,
                      iris2$Petal_Length,
                      iris2$Petal_Width,
                      iris2$Species),
                 lst1,
                 lst2)

I suspect that you want iris and iris2 to be supplied to each call to fixmax(). In order to have Map() recycle them like this, they need to be single-element lists. That is you probably want:

final_iris<- Map(fixmax, list(iris), list(iris2),lst1,lst2)

To combined a list of dataframes into a single dataframe do

do.call(rbind, final_iris)

Here is a mostly base way. I also renamed the variables because I had some trouble replicating since originally the approach would save over the iris object.

The approach is that instead of mutating a data.frame object, we instead only return the vector of the expected values from our modified function. Then, we re-assign those values back to our original data.frame.

fixmax2 = function(x, y) {
  max_y = max(y, na.rm = TRUE)
  ifelse(x >= max_y, max_y, y)
}
cols = which(sapply(df_plus, is.numeric))
df_plus[cols] = Map(fixmax2, df_plus[cols], df_iris[cols])
df_plus

Raw data:

library(dplyr)
df_plus = iris %>% mutate_at((1:4), ~. + 2) ## let's not save over iris
df_iris = iris
names(df_iris)<-sub(".", "_", names(df_iris), fixed = TRUE)

Is that what you're expecting ?

my_a <- iris %>% mutate_at((1:4),~.+2)
iris2 <- iris
names(iris2)<-sub(".", "_", names(iris2), fixed = TRUE)

my_var <- which(my_a$Sepal.Length >= max(iris2$Sepal_Length) & my_a$Sepal.Width >= max(iris2$Sepal_Width))
if (length(my_var)) {
  my_a <- my_a[my_var,]
}

Your function seems convoluted and hard to read at a first glance. We can tidy up the function to return max(x, max_val) for each value in a column with a quick function

#function to correct max  
adjust_max <- function(x, max_val) {  
  return(ifelse(x >= max_val, max_val, x))  
}  

Finally, we want to apply this automatically and sequentially using the two dataframes. We will use a simple for loop. Code to set up the problem is attached.

#libraries
library(tidyverse)


#set up fake data
iris_big <- iris%>% mutate_at((1:4),~.+2)
iris_small <- iris 
names(iris_small)<- sub(".", "_", names(iris_small), fixed = TRUE)

#check which is the bigger one and the smaller
max(iris_big$Sepal.Length)  #bigger
max(iris_small$Sepal_Length)  #smaller


#function to correct max
adjust_max <- function(x, max_val) {
  return(ifelse(x >= max_val, max_val, x))
}


#apply it to get a final result
iris_final <- iris_big

# iterate over columns, assuming same positions
# you can edit the 1:ncol(iris_final) to only take the columns you want
for (i in 1:ncol(iris_final)) {
  #check numeric
  if (is.numeric(iris_final[,i])) {
    #applies the function - notice we call iris_final and iris_small
    iris_final[,i] <- sapply(iris_final[,i], 
                             adjust_max,
                             max_val = max(iris_small[,i]))
  }
}

#check answer is correct
apply(iris_final[,1:4], 2, max)
apply(iris_small[,1:4], 2, max)

tail(iris_final)

For a tidyverse approach you can use transmute instead of mutate. transmute would return only one column in each iteration whereas mutate would return all the columns every time.

Apart from that to make it more tidyverse friendly I am using .data instead of get. Also using pmin instead of complicated ifelse solution.

library(dplyr)
library(purrr)

fixmax<- function(data,data2,var1,var2) {
  data<- data %>%  transmute("{var1}" := pmin(.data[[var1]], max(data2[[var2]])))
  return(data)
}

To apply the function to each pair of columns you can use map2_dfc which will also combine the results in one dataframe.

lst1 <- names(iris[,1:4])
lst2 <- names(iris2[,1:4])

Compare the max values of two dataframes before applying the function.

map_dbl(iris[lst1], max)
#Sepal.Length  Sepal.Width Petal.Length  Petal.Width 
#         9.9          6.4          8.9          4.5 

map_dbl(iris2[lst2], max)

#Sepal_Length  Sepal_Width Petal_Length  Petal_Width 
#         7.9          4.4          6.9          2.5 

Apply the function -

iris[lst1] <- map2_dfc(lst1, lst2, ~fixmax(iris, iris2, .x, .y))

Compare the max values of two dataframes after applying the function.

map_dbl(iris[lst1], max)

#Sepal.Length  Sepal.Width Petal.Length  Petal.Width 
#         7.9          4.4          6.9          2.5 

map_dbl(iris2[lst2], max)
#Sepal_Length  Sepal_Width Petal_Length  Petal_Width 
#         7.9          4.4          6.9          2.5 

You should consider using column indices; a complete (not including the data-frame construction) base R solution could look like:

# Resolve the indices of the numeric vectors in 
# iris: num_cols => integer vector
num_cols <- which(
  vapply(
      iris, 
      is.numeric, 
      logical(1)
    ),
  arr.ind = TRUE
)

# Map the pmin function over iris to select the
# minimum of the vector element in iris and the 
# maximum values of that vector in iris2: 
# iris => data.frame
iris[,num_cols] <- Map(function(i){
  pmin(
    iris[,i], 
    max(
      iris2[,i],
      na.rm = TRUE
      )
    )
  }, 
  num_cols
)

You can do this by creating a matrix of the max value repeated in each column and use pmin to take the minimum values between the max values in iris2 and the values in the other dataframe. I created a new fixmax function which only takes the two dataframes as arguments.

Preparing the data

library(tidyverse)

initial <- iris %>%  mutate_at(1:4, ~.+2)
iris2 <- iris 
names(iris2)<-sub(".", "_", names(iris2), fixed = TRUE)

print(max(initial$Sepal.Length))
# [1] 9.9
print(max(iris2$Sepal_Length))
# [1] 7.9

Creating the function

fixmax <- function(df, dfmax){
  
  colids <- which(unlist(lapply(dfmax, is.numeric)))
  dfmax <-  apply(dfmax[, colids], 2, max) %>% 
            matrix(nrow=nrow(dfmax), ncol=length(colids), byrow=TRUE) %>% 
            as.data.frame()
  
  df[, colids] <- pmin(df[,colids], dfmax)
  
  return(df)
}

Testing the function

newiris <- fixmax(initial, iris2)

print(max(newiris$Sepal.Length))
# [1] 7.9

assertthat::assert_that(!identical(newiris, iris2))
# [1] TRUE
assertthat::assert_that(all((initial == newiris) || (iris2 == newiris)))
# [1] TRUE
imax = apply(iris2[, 1:4], 2, max) %>% 
       matrix(nrow=nrow(iris2), ncol=4, byrow=TRUE) %>% 
       as.data.frame()
assertthat::assert_that(all(newiris[, 1:4] <= imax))
# [1] TRUE

print(head(newiris))
# Sepal.Length Sepal.Width Petal.Length Petal.Width Species
# 1          7.1         4.4          3.4         2.2  setosa
# 2          6.9         4.4          3.4         2.2  setosa
# 3          6.7         4.4          3.3         2.2  setosa
# 4          6.6         4.4          3.5         2.2  setosa
# 5          7.0         4.4          3.4         2.2  setosa
# 6          7.4         4.4          3.7         2.4  setosa