用于更改小标题中的许多行的功能，以获取另一个小标题中的行数

问题描述

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

我对天，类别和颜色有很多观察

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

我想根据日期和类别更改要更改的颜色数量后再更改颜色属性

howmanyrainbowsiwant <-structure(list(date = structure(c(1596585600,1596758400),makeitrainbow = c(2,2)),-2L),"data.frame"
))

在此示例中，我要更改：

• 两个随机选出的狗的观察结果，日期为05/08/2020“彩虹”
• 两次随机选择的狼观测结果于2020年8月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也可能有错误，但是找不到...

解决方法

我建议分两个步骤进行。首先计算要更改的行的索引，然后在这些位置更改原始数据帧（使用基数R-tidyverse nt非常适合此更改）。

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