能否帮我将sas代码转换为r，得到每个月与减肥相关的预期输出

Question

这是 sas 代码，我们要在其中检查个人在多少个月内减轻了体重

1 ******************************************************************
2 *  Creating the dataset by using do loops and if then do statement  *
3 ******************************************************************;
4 Data New;
5  input Name$ Weight;
6  datalines;
7 Rajesh  92
8 Ramesh  85
9 Kumar   76
10 Ajeeth  78
11 Saran   60
12 Senthil 54
13 ;
14 run;

15 ******************************************************************
16 *   Predicted weight category and group for the competition        *
17 ******************************************************************;
18 Data Gym;
19  Set New;
20       if Weight >= 85 then  do;
21           do Months=1 to 12 until(weight<=80);
22               weight+weight*-0.03;
23               Category="Under 80";
24           end;
25       end;
26       else if weight >= 70 then do;
27           do Months=1 to 12 until (weight<=70);
28               weight+weight*-0.03;
29               Category="Under 70";
30           end;
31       end;
32       else if weight < 65 then do;
33           do months=1 to 12 until(weight>=75);
34               weight+weight*0.03;
35               category="Under 75";
36           end;
37       end;

这是我在 R 中尝试过的

new <- tribble(
~name, ~weight,
'Rajesh',  92,
'Ramesh',  85,
'Kumar',   76,
'Ajeeth',  78,
'Saran',   60,
'Senthil', 54
)

new <- new[rep(row.names(new), 12),]
new <- new %>% mutate(month=row_number(), .by=name) %>% arrange(name) %>% 
  mutate(weight2= case_when(
    weight>=85 ~ weight+(weight*-(month*0.03)),
    weight >= 70 ~ weight+(weight*-(month*0.03)),
    weight < 65 ~ weight+(weight*(month*0.03))
    ),
    weight_cat= case_when(
     between(weight2,70,80) ~ 1,
    weight2 <= 70 ~ 1,
      weight2 >=75 ~ 1
    ))

预期产出

观察	参加者姓名	参与者的体重	数月内的预期结果	比赛重量
1	拉杰什	79	5	80岁以下
2	拉梅什	80	2	80岁以下
3	库马尔	69	3	70岁以下
4	阿吉斯	69	4	70岁以下
5	萨兰	76	8	80岁以下
6	森蒂尔	77	12	80岁以下

Answer 1

为了让事情变得更容易，我将从定义一个辅助函数开始

scale_to <- function(start, target, rate = .97) {
  ceiling(log(target/start) / log(rate))
}
calc <- Vectorize(function(x) {
  if (x>=85) {
    months <- scale_to(x, 80, .97)
    weight <- round(x*.97**months)
    new_cat <- "Under 80"
  } else if (x>=70) {
    months <- scale_to(x, 70, .97)
    weight <- round(x*.97**months)
    new_cat <- "Under 70"
  } else if (x<64) {
    months <- scale_to(x, 75, 1.03)
    weight <- round(x*1.03**months)
    new_cat <- "Under 75"
  }
  list(weight=weight, months=months, category=new_cat)
}, SIMPLIFY=FALSE)

然后你可以使用它

new %>% mutate(
  stats = calc(weight), weight=NULL
) %>% tidyr::unnest_wider(stats)

获得

  name    weight months category
  <chr>    <dbl>  <dbl> <chr>   
1 Rajesh      79      5 Under 80
2 Ramesh      80      2 Under 80
3 Kumar       69      3 Under 70
4 Ajeeth      69      4 Under 70
5 Saran       76      8 Under 75
6 Senthil     77     12 Under 75