使用 purrr 按向量中的值过滤

Question

I want to write a function that accepts two arguments: a data.frame and a vector (here, called id_var ). Then it filters the data.frame by a value that is in id_var (eg. the first value in the vector), adds the resulting data.frame to a variable called data_filt_by_var .

If the number of rows in data_filt_by_var is bigger than one... It takes that same initial data.frame , filter by the same id_var value and select the distinct end (end is a the name of that is present in the data.frame), and get its number of rows. If the number of rows is >= 1 , returns 1 , else 0 .

The problem is, it has to do this to each value in id_var. I cannot make this iteration work without using loops, which are not desirable. I wrote the following function, but its not working.

is_this_unique = function(data, id_var) {
  data_filt_by_var = nrow(data[data$id == id_var, ])

  if (data_filt_by_var >= 1) {
    if (nrow(data[data$id == id_var, ] %>% 
             distinct(full_address)) == 1) {
      return(1)
    }
  } else {
    return(0)
  }
}

sample_data = (tibble::tribble(~id, ~full_address,
          1,'abc',
          1,'bcd',
          1,'abc',
          2,'qaa',
          2,'xcv',
          2,'qaa'))

id_var = c(1,2)

I was hoping to use map_dbl in this function.

The expected output would be:

input:

>is_this_unique(sample_data, id_var)

desired output:

[1] 0 1 0 1 0 1

The first 0 is because the first id and full_address pair ( 1 and abc ) are not unique, and so on...

Answer 1

The function can be written in tidyverse without using any loops with purrr . This seems to be group_by count the frequency after filter ing for the 'id's passed into the function. In this case, we group by 'id', and the column that is needed (inside the curly-curly - {{}} ), create a logical column by checking the number of rows ( n() ) equal to 1. If we pass an 'idvar' that is not in the dataset, it would usually return integer(0) , which can be changed to 0 with a if/else condition at the end

library(dplyr)   
is_this_unique <- function(data, id_var, colNm) {
     out <-  data %>%
         filter(id %in% id_var) %>%
          group_by(id, {{colNm}}) %>%
          transmute(n = +(n() == 1)) %>%
          pull(n)
      if(length(out) > 0) out else 0


         }

is_this_unique(sample_data, 1:2, full_address)
#[1] 0 1 0 0 1 0

is_this_unique(sample_data, 1, full_address)
#[1] 0 1 0


is_this_unique(sample_data, 0, full_address)
#[1] 0

Answer 2

IMO using purrr here isn't suitable, you can try this function.

library(dplyr)  

is_this_unique <- function(data, id_var) {
   temp_data <- data %>% filter(id %in% id_var)
   if (nrow(temp_data) > 0) 
      temp_data %>% 
         add_count(id, full_address) %>%
         mutate(n = +(n == 1)) %>%
         pull(n)
   else return(0)
}

is_this_unique(sample_data, 1:2)
#[1] 0 1 0 0 1 0

is_this_unique(sample_data, 1)
#[1] 0 1 0

is_this_unique(sample_data, 0)
#[1] 0