改变一个小标题中的行数的函数，从另一个小标题中获取行数

Question

我想做一些看起来很简单的事情，但无法得到我想要的输出

我有一堆关于日期、类别和颜色的观察

   observations <- structure(list(date = structure(c(1596585600, 1596585600, 1596585600, 
    1596585600, 1596585600, 1596585600, 1596585600, 1596672000, 1596672000, 
    1596672000, 1596758400, 1596758400, 1596758400, 1596758400, 1596758400
    ), class = c("POSIXct", "POSIXt"), tzone = "UTC"), categorie = c("dog", 
    "dog", "dog", "wolf", "wolf", "wolf", "wolf", "dog", "dog", "wolf", 
    "dog", "wolf", "wolf", "wolf", "wolf"), color = c("blue", "blue", 
    "blue", "blue", "blue", "blue", "blue", "darkred", "darkred", 
    "darkred", "darkred", "darkred", "darkred", "darkred", "darkred"
    )), row.names = c(NA, -15L), class = c("tbl_df", "tbl", "data.frame"
    ))

我想在一个小标题之后更改颜色属性，其中包含我想按天和类别更改的颜色数量

howmanyrainbowsiwant <-structure(list(date = structure(c(1596585600, 1596758400), class = c("POSIXct", 
"POSIXt"), tzone = "UTC"), categorie = c("dog", "wolf"), makeitrainbow = c(2, 
2)), row.names = c(NA, -2L), class = c("tbl_df", "tbl", "data.frame"
))

在这个例子中我想改变：

• 2020 年 5 月 8 日随机选择的两只狗观察到“彩虹”
• 2020 年 7 月 8 日随机选择的两个狼观察到“彩虹”

我尝试了 purr:mappp、purr:walk 和 "

library(dplyr)
library(lubridate)
library(tidyverse)


coloriage<- function(x) {
    
              current <- tibble(x) ## make the row a variable
       tirage<-current$makeitrainbow[1] ## Making the number of rainbow i want a variable
      # I take a sample/slice of the datasource with the number of rainbow i want 
    
      petitsample <- observations %>%
        filter(categorie %in% current$categorie ) %>%
        filter(date %in% current$date ) %>%
         slice_sample(tirage)
      
    ## then i save the lines in the main data but not in the slice
      temp <- setdiff(observations , petitsample)
    
    ## I change the color value of the splice rows
      petitsample<- petitsample %>% mutate(color= "rainbow")
      
    ## I bring back together the non modified rows and the splice modified rows
    # trying with "<<-"
      observations <<- bind_rows(temp, petitsample)
    ## And tryng with return
      return(observations )
    }
    
    ## Using function
     walk(howmanyrainbowsiwant , coloriage) 
    
    ## Checking if it worked (looking for "rainbow " values)
    
    observations %>% count(color)
    
    ## and it fails ...

谢谢！！

ps :看起来我的reprex也可能有错误，但找不到...

Answer 1

我建议采用两步程序。首先计算要更改的行的索引，然后在这些位置更改原始数据帧（使用基础 R - tidyverse 非常适合这种更改）。

library(tidyverse)

## compute rows to be changed
inds_to_change <-
  pmap(howmanyrainbowsiwant,
     function(date, categorie, makeitrainbow)
         sample(
                which(observations$date == date &
                      observations$categorie == categorie),
                makeitrainbow)
     ) %>% 
  unlist()

## change color in these rows
observations$color[inds_to_change] <- "rainbow"
observations

结果（由于行的随机选择，您的计算可能会有所不同）

# A tibble: 15 x 3
   date                categorie color  
   <dttm>              <chr>     <chr>  
 1 2020-08-05 00:00:00 dog       blue   
 2 2020-08-05 00:00:00 dog       rainbow
 3 2020-08-05 00:00:00 dog       rainbow
 4 2020-08-05 00:00:00 wolf      blue   
 5 2020-08-05 00:00:00 wolf      blue   
 6 2020-08-05 00:00:00 wolf      blue   
 7 2020-08-05 00:00:00 wolf      blue   
 8 2020-08-06 00:00:00 dog       darkred
 9 2020-08-06 00:00:00 dog       darkred
10 2020-08-06 00:00:00 wolf      darkred
11 2020-08-07 00:00:00 dog       darkred
12 2020-08-07 00:00:00 wolf      rainbow
13 2020-08-07 00:00:00 wolf      darkred
14 2020-08-07 00:00:00 wolf      darkred
15 2020-08-07 00:00:00 wolf      rainbow