Есть ли способ многократного решения матриц, созданных из фрейма данных, без использования циклов? - PullRequest
Новая
       30

Есть ли способ многократного решения матриц, созданных из фрейма данных, без использования циклов?

0 голосов
/ 11 июня 2019

Обновление

Я пробовал функции apply(), но вывод меня в тупик. Мне нужно data.frame или data.table. apply(smallExample, 1, SectionDev) дает правильный вывод, но в списке. Я прочитал, что sapply() может выдать data.frame или matrix, но я не могу получить всю строку для подачи в функцию.

Новая функция 

  SectionDev <- function(x){
    parameters <- data.table("Name" = c("Head", "Foot", "Pillow", "Mattress", "Sleeping", "Restless"),
                             "Space" = c(8, 78, 17, 17, 3, 8), 
                             "Portion" = c(2, 4, 2, 2, 3, 3))

    RG <- as.numeric(x[which(names(x) == "Gas")])
    RS <- as.numeric(x[which(names(x) == "Solid")])

    A <- data.frame(MG=c(1, 0, 1, 0),
                    MS=c(1, 0, 0, 1),
                    VG=c(0, 1, -1*RG, 0),
                    VS=c(0, 1, 0, -1*RS))

    for (j in 1:nrow(parameters)) {
      SectName <- as.vector(as.matrix(parameters[j, `Name`]))
      Ac <- parameters[j, `Portion`]
      Vt <- parameters[j, `Space`]

      Pushing <- as.numeric(x[which(names(x) == SectName)])
      Driving <- as.numeric(Pushing * 249.1)
      Pressing <- Driving*Ac / 9.8
      b <- c(Pressing, Vt, 0, 0)

      MatrixConstants <- data.table("Timestamp" = as.vector(as.matrix(x[which(names(x) == "Timestamp")])),
                                    "Section" = SectName,
                                    RG,
                                    RS) 

      MatrixSolution <- solve(A,b)

      MatrixPtResult <- cbind(MatrixConstants,t(
        as.data.frame(MatrixSolution)))

      if (exists("MatrixTest")){
        rlist <- list(MatrixTest, MatrixPtResult)
      } else {
        rlist <- list(MatrixPtResult)
      }

      MatrixTest <- rbindlist(rlist)
      }

    return(MatrixTest)
  }

Желаемый выход 

> MatrixOutput[1:12,]
              Timestamp  Portion Gas Solid        MG         MS         VG
 1: 2019-04-24 06:00:00     Head  18   234  149.2218  -67.88299   8.290098
 2: 2019-04-24 06:00:00     Foot  18   234 1427.7993 -309.39116  79.322184
 3: 2019-04-24 06:00:00   Pillow  18   234  318.7908 -166.28061  17.710601
 4: 2019-04-24 06:00:00 Mattress  18   234  183.2262 1596.05952  10.179233
 5: 2019-04-24 06:00:00 Sleeping  18   234 -316.4209 4815.47194 -17.578940
 6: 2019-04-24 06:00:00 Restless  18   234 -549.3597 9013.67602 -30.519983
 7: 2019-04-24 07:00:00     Head  17   239  141.7429  -80.73885   8.337819
 8: 2019-04-24 07:00:00     Foot  17   239 1365.2541 -551.86634  80.309064
 9: 2019-04-24 07:00:00   Pillow  17   239  303.3448 -201.67136  17.843813
10: 2019-04-24 07:00:00 Mattress  17   239  178.7719 1549.67705  10.515996
11: 2019-04-24 07:00:00 Sleeping  17   239 -277.9378 4624.47863 -16.349283
12: 2019-04-24 07:00:00 Restless  17   239 -501.7540 8966.07028 -29.514938
            VS
 1: -0.2900983
 2: -1.3221844
 3: -0.7106009
 4:  6.8207672
 5: 20.5789399
 6: 38.5199830
 7: -0.3378195
 8: -2.3090642
 9: -0.8438132
10:  6.4840044
11: 19.3492830
12: 37.5149384

Оригинал

Я должен решить одну и ту же матрицу для каждой временной точки и местоположения в моих данных. Цикл for работает, но не быстро в 12 000+ временных точках и 6 местах.

Есть ли способ сделать это без использования for? Это просто не похоже на R, как я делаю это сейчас.

Я пытался использовать foreach с doParallel, но на самом деле он был медленнее, чем for, как написано в TERR.

Есть две вложенные петли. Первый выполняет измерения для момента времени, а второй выполняет solve для каждого местоположения. 

  for (i in 1:nrow(smallExample)) {
      RG <- as.matrix(smallExample[i, "Gas"])
      RS <- as.matrix(smallExample[i, "Solid"])

      A <- data.frame(MG=c(1, 0, 1, 0),
                      MS=c(1, 0, 0, 1),
                      VG=c(0, 1, -1*RG,0),
                      VS=c(0, 1, 0, -1*RS))

      for (j in 1:nrow(parameters)) {
        SectName <- as.vector(as.matrix(parameters[j, "Name"]))
        Ac <- parameters[j, "Portion"]
        Vt <- parameters[j, "Space"]

        Pushing <- smallExample[i, get(SectName)]
        Driving <- as.matrix(Pushing*249.1) 
        Pressing <- Driving * as.matrix(Ac) / 9.8
        b <- c(Pressing,Vt,0,0)

        MatrixConstants <- data.table("Timestamp" = as.vector(as.matrix(smallExample[i, "Timestamp"])),
                                      "Portion" = SectName,
                                      RG,
                                      RS)

        MatrixSolution <- solve(A,b)

        MatrixPtResult <- cbind(MatrixConstants,t(
          as.data.frame(MatrixSolution)))

        if (exists("MatrixOutput")){
          rlist <- list(MatrixOutput, MatrixPtResult)
        } else {
          rlist <- list(MatrixPtResult)
        }

        MatrixOutput <- rbindlist(rlist)
        cat(paste("\r",i, "Observations of ", nrow(smallExample),"\t",nrow(MatrixOutput),"Matrix results",sep = " "))
      }
  }

Результатом является неповернутая таблица времени, местоположений, измерений и четырех частей решений.

Данные: 

library(data.table)

smallExample <- structure(list(Gas = c(18,  17, 15,  14,  12,  11), 
                                 Solid = c(234, 239,  237, 238,  233, 239),
                                 Timestamp = structure(c(1556085600,
                                                         1556089200, 
                                                         1556092800, 
                                                         1556096400, 
                                                         1556100000, 
                                                         1556103600),
                                                       class = c("POSIXct", "POSIXt"), tzone = "UTC"), 
                                 Head = c(1.6, 1.2, 1.1, 1.0, 0.8, 0.7), 
                                 Foot = c(11, 8, 7, 6, 5, 4), 
                                 Pillow = c(3, 2, 2, 2, 1, 1), 
                                 Mattress = c(35, 34, 31, 30, 28, 26), 
                                 Sleeping = c(59, 57, 59, 58, 59, 59), 
                                 Restless = c(111, 111, 110, 111, 112, 113)),
                            class = c("data.table", "data.frame"),
                            row.names = c(NA_integer_, -6L))

parameters <- data.table("Name" = c("Head", "Foot", "Pillow", "Mattress", "Sleeping", "Restless"),
                         "Space" = c(8, 78, 17, 17, 3, 8), 
                         "Portion" = c(2, 4, 2, 2, 3, 3))

1 Ответ

0 голосов
/ 13 июня 2019

Решением было использование apply и do.call с rbind ( благодаря fotNelton ). Сравнение с microbenchmark с использованием apply прошло на 60% быстрее. Просто ушел, желая, чтобы я смог заставить do.call(rbindlist,)) работать . 

MatrixAnswer <- as.data.table(do.call(rbind, apply(MatrixSubTest, 1, SectionMasses)))
...