R:将功能逐行应用于表,将查找表中的值作为参数传递

时间:2019-05-16 02:04:08

标签: r iteration purrr

这是我一直在尝试使用purrr :: pmap解决的逐行迭代问题,但是没有运气。

我从原始分数表开始:

rawscore_table <- data.frame(rawscore = 10:14, SS1 = NA, SS2 = NA)

  rawscore SS1 SS2
1       10  NA  NA
2       11  NA  NA
3       12  NA  NA
4       13  NA  NA
5       14  NA  NA

有两个空列,SS1和SS2,我想通过将函数应用于每行来获取其值:

SS1 = rawscore + x + y

SS2 = rawscore + x + y

在查找表中找到xy的值:

lookup_table <- data.frame(SS = c('SS1', 'SS2'), x = 1:2, y = 3:4)

   SS x y
1 SS1 1 3
2 SS2 2 4

我正在寻找的解决方案将通过在{{1}的rawscore_table$SS1行中找到xy的值来计算列SS1的值},它将通过在lookup_table的{​​{1}}行中找到rawscore_table$SS2x的值来计算列y的值。

因此,代码必须引用SS2的名称,以便从lookup_table的相应中提取值

所需的输出如下:

rawscore_table

在此先感谢您的帮助!

2 个答案:

答案 0 :(得分:2)

一种选择是获取“ lookup_table”的数字列的rowSums,将“ +”与“ rawscore_table”的第一列相加,将输出分配回除第一列

rawscore_table[-1] <- lapply(as.list(rowSums(lookup_table[-1])), `+`, 
           rawscore_table[,1])

或复制rowSums输出并添加第一列

rawscore_table[as.character(lookup_table$SS)] <- rawscore_table$rawscore + 
            rep(rowSums(lookup_table[-1]), each = nrow(rawscore_table))

或使用tidyverse

library(tidyverse)
lookup_table %>% 
    transmute(SS, xy = x + y) %>%
    deframe %>%
    as.list %>%
    imap_dfc(~ 
             rawscore_table  %>%
                 transmute(!! .y :=  .x + rawscore)) %>% 
    bind_cols(rawscore_table[1], .)
#   rawscore SS1 SS2
#1       10  14  16
#2       11  15  17
#3       12  16  18
#4       13  17  19
#5       14  18  20

答案 1 :(得分:1)

另一种选择是加入lookuprawscore_table %>% gather(SS, val, -rawscore) %>% left_join(lookup_table, by = 'SS') %>% mutate(val = rawscore + x + y, x = NULL, y = NULL) %>% spread(SS, val) # rawscore SS1 SS2 #1 10 14 16 #2 11 15 17 #3 12 16 18 #4 13 17 19 #5 14 18 20

CREATE FUNCTION LocalCustom.Pretty_XML(@uglyXML VARCHAR(MAX))
RETURNS VARCHAR(MAX) 
AS
BEGIN
  DECLARE @len AS INT = LEN(@uglyXML)
        , @prettyXML AS VARCHAR(MAX) = ''
        , @indent AS INT = 0
        , @tab AS CHAR(1) = CHAR(9)
        , @lf AS CHAR(1) = CHAR(10)
        , @currElement AS VARCHAR(MAX) = NULL
        , @nextElement AS VARCHAR(MAX);

  WHILE @uglyXML + ISNULL(@currElement,'') <> ''
  BEGIN
     IF @currElement IS NULL
     BEGIN
        SET @currElement = LocalCustom.GetColumn(1,'>',@uglyXML);
        SET @uglyXML = SUBSTRING(@uglyXML,LEN(@currElement)+2,@len);
     END;
     SET @nextElement = LocalCustom.GetColumn(1,'>',@uglyXML);
     IF @currElement LIKE '</%'
     BEGIN
        SET @indent = @indent - 1;
        SET @prettyXML = @prettyXML + REPLICATE(@tab,@indent) +  @currElement + '>' + CASE @indent WHEN 0 THEN '' ELSE @lf END;
        SET @currElement = @nextElement;
        SET @uglyXML = SUBSTRING(@uglyXML,LEN(@nextElement)+2,@len);
     END
     ELSE
        IF @currElement LIKE '<% /'
        BEGIN
           SET @prettyXML = @prettyXML + REPLICATE(@tab,@indent) +  @currElement + '>' + CASE @indent WHEN 0 THEN '' ELSE @lf END;
           SET @currElement = @nextElement;
           SET @uglyXML = SUBSTRING(@uglyXML,LEN(@nextElement)+2,@len);
        END
        ELSE
           IF @nextElement LIKE '%</' + SUBSTRING(@currElement,2,@len) 
           BEGIN
              SET @prettyXML = @prettyXML + REPLICATE(@tab,@indent) +  @currElement + '>' + @nextElement + '>' + @lf;
              SET @uglyXML = SUBSTRING(@uglyXML,LEN(@nextElement)+2,@len);
              SET @currElement = NULL;
           END
           ELSE
              IF @nextElement NOT LIKE '</%'
              BEGIN
                 SET @prettyXML = @prettyXML + REPLICATE(@tab,@indent) +  @currElement + '>' + @lf;
                 SET @indent = @indent + 1;
                 SET @currElement = @nextElement;
                 SET @uglyXML = SUBSTRING(@uglyXML,LEN(@nextElement)+2,@len);
              END;
  END;
  RETURN @prettyXML;
END
GO