在 R 中创建数据帧的复制功能 - 可复制代码

Question

目标:发现钻石套装中的钻石相似之处。此外，为每个钻石名称(通过状态集自动填充)创建一行，其中包括每个钻石的相似性列。

Example of desired outcome

工作:下面，我创建了一个函数，该函数使用 dplyr 通过将钻石的名称输入到函数中并过滤相似属性来发现钻石的相似性。

问题:我的功能有效，但一次只能处理一个钻石名称。我被困在如何在整个名称列表中重申我的功能。理想情况下，此迭代将返回每个唯一钻石名称及其相似属性的数据框。我尝试编写第二个函数，该函数使用 for 循环来迭代名称列表，但无济于事。任何建议将不胜感激。

library(tidyverse)
diamonds <- diamonds[1:50,]
# I wanted to give each diamond a unique name, so I am using the states set to populate names.
diamonds$name <- state.name
diamonds

f_comp <- function(df = diamonds, name_insert, name_c = name, carat_c = carat, depth_c = depth, price_c = price){

  name_c <- enquo(name_c)
  carat_c <- enquo(carat_c)
  depth_c <- enquo(depth_c)
  price_c <- enquo(price_c)

  #filter by specifc diamond name)
  n <- df %>%
      filter(name_insert == !! name_c)

  #filtering by carat size, then measuring distance with mutate
  prox <-  df %>%
    filter(!! carat_c <= n$carat +.04 & !! carat_c >= n$carat -.04) %>%
    mutate(scores = abs(!! depth_c - n$depth) + abs(!! price_c - n$price)) %>%
    arrange(scores)

  #return avg scores of top 3 (ascending)
  prox1 <- prox[1:3,] 
  prox1 <- prox1 %>%
    mutate(avg_score = (mean(scores)))

  #format 
  prox1  <- prox1 %>%
    select(name, avg_score) %>%
    mutate(nm1 = name[2], nm2 = name[3]) 

  #Return one row w/ avg score
  prox_db <- prox1[1,]
}

test_alaska <- f_comp(name_insert = "Alaska")

*#Everything works until I try to add the second function that reiterates the name column*

  func2 <- function(d) {
    storage <- data.frame()
    for(i in d) {
      storage[i] <- f_comp(name_insert = i)
      storage
    }  
  }

test_5 <- func2(d = diamonds$name)

Answer 1

该功能需要在 filter 中稍作修改.而不是 enquo + !!一个选项是 {{}}

library(dplyr)
library(purrr)
library(ggplot2)

f_comp <- function(df = diamonds, name_insert,
  name_c = name, carat_c = carat, depth_c = depth, price_c = price){

   name_c <- enquo(name_c)
   carat_c <- enquo(carat_c)
   depth_c <- enquo(depth_c)
   price_c <- enquo(price_c)

   #filter by specifc diamond name)
   n <- df %>%
       filter(!! name_c  == name_insert) # changed here






 #filtering by carat size, then measuring distance with mutate
 prox <-  df %>%
   filter(!! carat_c <= n$carat +.04 & !! carat_c >= n$carat -.04) %>%
   mutate(scores = abs(!! depth_c - n$depth) + abs(!! price_c - n$price)) %>%
   arrange(scores)

 #return avg scores of top 3 (ascending)
 prox1 <- prox[1:3,] 
 prox1 <- prox1 %>%
   mutate(avg_score = (mean(scores)))

 #format 
 prox1  <- prox1 %>%
   select(name, avg_score) %>%
   mutate(nm1 = name[2], nm2 = name[3]) 

 #Return one row w/ avg score
 prox_db <- prox1[1,]
 prox_db

 }

-测试

f_comp(name_insert = "Alaska")
# A tibble: 1 x 4
#  name   avg_score nm1     nm2    
#  <chr>      <dbl> <chr>   <chr>  
#1 Alaska      1.87 Alabama Arizona

带有多个“名称”

map_dfr(unique(diamonds$name), ~ f_comp(name_insert = .x))
# A tibble: 50 x 4
#   name        avg_score nm1         nm2        
# * <chr>           <dbl> <chr>       <chr>      
# 1 Alabama         2.43  Alaska      Arizona    
# 2 Alaska          1.87  Alabama     Arizona    
# 3 Arizona         3.17  Alaska      Alabama    
# 4 Arkansas        1.80  California  Delaware   
# 5 California      2.2   Arkansas    Hawaii     
# 6 Colorado        0.800 Connecticut Delaware   
# 7 Connecticut     0.633 Colorado    Delaware   
# 8 Delaware        1.10  Connecticut Colorado   
# 9 Florida         2.17  Delaware    Colorado   
#10 Georgia         2.80  Delaware    Connecticut
# … with 40 more rows