如何进行双循环和“否则”操作?

时间:2019-12-07 14:07:39

标签: r

作为R的新手,我很难设置适当的代码(我仍然会说它必须包含if / else命令和循环)。

具体来说,我想比较两条信息(请参见简化的示例,因为我的实际数据库相当长):“ Monthly_category”和“ Ref_category”。由于使用了模式公式,因此每个元素(Element_id)的“ Ref_category”仅在每个元素的第5个周期进行计算(因为然后我们移至下一个元素)。

Months  Element_Id  Monthly_Category  Ref_Category  Expected_output
 1	      1	          3	                NA	         0
 2	      1	          2	                NA	         0
 3 	      1	          2	                NA	         1
 4	      1	          1	                NA	         1
 5	      1	          3	                3	         0
 1	      2	          6	                2	         0
 2	      2	          6	                6	         1
 3	      2	          NA	                1	         0
 4	      2	          NA	                6	         0
 5	      2	          1	                1	         0
 

更准确地说,我希望一旦“ Monthly_category”与所选的“ Ref_category”连续2个周期相差2个周期(每5个观察值计算一次),就输入1。否则,设置为0。

此外,我希望这些行或Monthly_category = NA直接给出0,因为最后,我将只考虑我有1的行(而NA对我不感兴趣)。

对于每个元素(1个元素= 5行),使用该模式在5个周期的末尾计算参考类别。但是,通过扩展公式,我们在每行中都有值,而我每次都仅考虑最后一个值(因此每5行)。这就是为什么我认为我们需要两个循环:一个循环检查每月类别的每一行,一个循环每五行检查参考类别。

您对允许我执行此操作的代码有任何想法吗?

非常感谢您能启发我,

范妮

1 个答案:

答案 0 :(得分:2)

首先,请看一下@John Coleman和我问您的问题,因为我的解决方案可能会根据您的要求而更改。

无论如何,您不需要显式的for循环或显式的if循环即可完成工作。

在R中,通常不希望直接编写任何for循环。您最好使用类似lapply的功能。在这种情况下,dplyr包负责所有隐式循环。

df <-  tibble::tribble(~Months,  ~Element_Id,  ~Monthly_Category,  ~Ref_Category,  ~Expected_output,
                       1      ,            1,                  3,             NA,                 0,
                       2      ,            1,                  2,             NA,                 0,
                       3      ,            1,                  2,             NA,                 1,
                       4      ,            1,                  1,             NA,                 1,
                       5      ,            1,                  3,              3,                 0,

                       1      ,            2,                  6,              2,                 0,
                       2      ,            2,                  6,              6,                 1,
                       3      ,            2,                  1,              1,                 0,
                       4      ,            2,                  1,              6,                 0,
                       5      ,            2,                  1,              1,                 0)


library(dplyr)
library(purrr)

df %>%

  # check if elements are equal
  mutate(Real_Expected_output = !map2_lgl(Monthly_Category, Ref_Category, identical)) %>% 

  # sort by Element_Id and Months just in case your data is messy
  arrange(Element_Id, Months) %>% 

  # For each Element_Id ...
  group_by(Element_Id) %>% 

  #  ... define your Expected Output
  mutate(Real_Expected_output = as.integer(lag(Real_Expected_output, default = FALSE) & 
                                             lag(Real_Expected_output, 2, default = FALSE))) %>% 
  ungroup()


#   Months Element_Id Monthly_Category Ref_Category Expected_output Real_Expected_output
#   <dbl>      <dbl>            <dbl>        <dbl>           <dbl>                <int>
#       1          1                3           NA               0                    0
#       2          1                2           NA               0                    0
#       3          1                2           NA               1                    1
#       4          1                1           NA               1                    1
#       5          1                3            3               0                    1
#       1          2                6            2               0                    0
#       2          2                6            6               1                    0
#       3          2                1            1               0                    0
#       4          2                1            6               0                    0
#       5          2                1            1               0                    0

Real_Expected_output与您的Expected_output不同,只是因为我确实相信您的预期结果与我在其中一条评论中所说的书面要求相抵触。

编辑:

根据您的评论,我想这就是您想要的。 再说一次:没有循环,您只需要明智地使用dplyr软件包已经提供的工具,即lastgroup_bymutate

df %>%

  # sort by Element_Id and Months just in case your data is messy
  arrange(Element_Id, Months) %>% 

  # For each Element_Id ...
  group_by(Element_Id) %>% 

  # ... check if Monthly Category is equal to the last Ref_Category
  mutate(Real_Expected_output = !map2_lgl(Monthly_Category, last(Ref_Category), identical)) %>% 


  #  ... and define your Expected Output
  mutate(Real_Expected_output = as.integer(Real_Expected_output & 
                                             lag(Real_Expected_output, default = FALSE))) %>% 

  ungroup()

#   Months Element_Id Monthly_Category Ref_Category Expected_output Real_Expected_output
#   <dbl>      <dbl>            <dbl>        <dbl>           <dbl>                 <int>
#       1          1                3           NA               0                     0
#       2          1                2           NA               0                     0
#       3          1                2           NA               1                     1
#       4          1                1           NA               1                     1
#       5          1                3            3               0                     0
#       1          2                6            2               0                     0
#       2          2                6            6               1                     1
#       3          2                1            1               0                     0
#       4          2                1            6               0                     0
#       5          2                1            1               0                     0

编辑2:

我将根据您的要求再次对其进行编辑。在这一点上,我建议您创建一个外部函数来处理您的问题。看起来更干净。


df <-  tibble::tribble(~Months,  ~Element_Id,  ~Monthly_Category,  ~Ref_Category,  ~Expected_output,
                       1      ,            1,                  3,             NA,                 0,
                       2      ,            1,                  2,             NA,                 0,
                       3      ,            1,                  2,             NA,                 1,
                       4      ,            1,                  1,             NA,                 1,
                       5      ,            1,                  3,              3,                 0,

                       1      ,            2,                  6,              2,                 0,
                       2      ,            2,                  6,              6,                 1,
                       3      ,            2,                 NA,              1,                 0,
                       4      ,            2,                 NA,              6,                 0,
                       5      ,            2,                  1,              1,                 0)


library(dplyr)
library(purrr)


get_output <- function(mon, ref){

  # set here your condition
  exp <- !is.na(mon) & !map2_lgl(mon, last(ref), identical)

  # check exp and lag(exp), then convert to integer
  as.integer(exp & lag(exp, default = FALSE))

}


df %>%

  # sort by Element_Id and Months just in case your data is messy
  arrange(Element_Id, Months) %>% 

  # For each Element_Id ...
  group_by(Element_Id) %>% 

  # ... launch your function
  mutate(Real_Expected_output = get_output(Monthly_Category, Ref_Category)) %>% 

  ungroup()



# # A tibble: 10 x 6
#     Months Element_Id Monthly_Category Ref_Category Expected_output Real_Expected_output
#     <dbl>      <dbl>            <dbl>        <dbl>           <dbl>                <int>
#  1      1          1                3           NA               0                    0
#  2      2          1                2           NA               0                    0
#  3      3          1                2           NA               1                    1
#  4      4          1                1           NA               1                    1
#  5      5          1                3            3               0                    0
#  6      1          2                6            2               0                    0
#  7      2          2                6            6               1                    1
#  8      3          2               NA            1               0                    0
#  9      4          2               NA            6               0                    0
# 10      5          2                1            1               0                    0