R переписывание строковых манипуляций, реализованных в цикле к R-way - PullRequest
Новая
       8

R переписывание строковых манипуляций, реализованных в цикле к R-way

0 голосов
/ 03 ноября 2018

Я работаю над набором логистических данных, пытаясь визуализировать шаги, предпринятые субъектами в наборе данных.

Мои входные данные имеют следующую форму: ID_object; процес

Предпринятые_процессы имеют вид: A-B | B-C | C-D ...

Я визуализирую в visNetwork.

Для узлов у меня есть предопределенный фрейм данных, где объявлены все возможные узлы (A-Z) и даны некоторые начальные свойства (например, все узлы имеют серый цвет и имеют определенную метку).

Для связей между узлами я написал цикл, который:

  • Просмотр всех строк в наборе данных
  • За строку берется столбец предпринятых_процессов
  • Разбивает предпринятые_процессы по "|" чтобы получить отдельные движения (A-B, B-C, ...)
  • Делит результат выше на "-", чтобы получить список векторов, где первый элемент - это "объект-объект", а второй - "объект-объект"
  • Зацикливание списка векторов и заполнение одного вектора, содержащего все «объекты-объекты», и одного вектора, связывающего все «объекты-объекты».
  • построить кадр данных со столбцами от, до, на основе вектора выше и сом дополнительных столбцов для дополнительных свойств (например, цвет направления ссылки стрелки)
  • Для каждой строки в родительском цикле я проверяю, какой последний объект находится там, где был идентификатор, и меняю цвет для этого узла на другой цвет
  • После цикла, группирующего ссылочный фрейм данных по цветам и стрелкам от, до, чтобы получить общее количество перемещений на группу

Этот способ отлично работает для небольших наборов данных, но очень медленный / не подходит для больших. Я предполагаю, что есть способ с отображением и / или применением функций, но я еще не понял это. Может ли кто-нибудь указать мне правильное направление? 

library(visNetwork)

visNetwordGridLayout <- function(x)
{
 x[is.na(x)] <- 0

 x <- apply(t(x), 1, rev)

 LmatX <- seq(-1,1,length=ncol(x))
 LmatY <- seq(1,-1,length=nrow(x))

   loc <- t(sapply(1:max(x),function(y)which(x==y,arr.ind=T)))
   layout <- cbind(LmatX[loc[,2]],LmatY[loc[,1]])
   return(layout)
   }

  ID_movements <- data.frame(
   ID = c(1, 2),
   PROCES = c("A-B|B-C|C-E", "A-B|B-C|C-D"),
    stringsAsFactors = FALSE
   )

  # nodes
   nodes <- data.frame(id = c("A", "B", "C", "D", "E"))
    nodes <- nodes %>% mutate(label = id)
    nodes$color.background <- rep('grey', nrow(nodes))

  # Links
 links <- data.frame()
  for (row in 1:nrow(ID_movements)) {
  ID_movement <- ID_movements[row, ]$PROCES

  procesSteps <- strsplit(ID_movement , "\\|")[[1]]
  procesSteps <- strsplit(procesSteps, '-')

  fromVec <- c()
  toVec <- c()
  for (step in procesSteps){
    fromVec <- c(fromVec , step[1])
    toVec <- c(toVec , step[2])
  }
   links <- rbind(links,
             data.frame(from = fromVec,
                        to = toVec,
                        color = 'blue',
                        arrows = 'to')
  )

 lastNode <- last(toVec)
 nodes$color.background[nodes$id == 
                       lastNode] <- 'green'
 }
links <- links %>%
  group_by(from, to, color, arrows) %>%
 summarise(label = n()) %>%
  ungroup()

# Grid waar de nodes komen
 grid <- matrix(
 match(
c(
  "A",0,0,0,0,
  0,"B",0,0,0,
  0,0,"C",0,"D",
  0,0,0,0,"E"
),
  nodes$id),
 nrow=4,byrow=TRUE)


visNetwork(nodes, links) %>%
 visIgraphLayout(layout = "layout.norm",
              layoutMatrix = visNetwordGridLayout(grid))

1 Ответ

0 голосов
/ 03 ноября 2018

Так что это только начало, я думаю, но с точки зрения ускорения вы хотите перестать пересчитывать одно и то же снова и снова. Даже если вам нужно сделать еще один цикл, убедитесь, что вы выполняете вычисления только тогда, когда у них есть новые данные.

Так например 

ID_movements <- data.frame(
  ID = c(1, 2),
  PROCES = c("A-B|B-C|C-E", "A-B|B-C|C-D"),
  stringsAsFactors = FALSE
)

# nodes
nodes <- data.frame(id = c("A", "B", "C", "D", "E"))
nodes <- nodes %>% mutate(label = id)
nodes$color.background <- rep('grey', nrow(nodes))


procesSteps <- strsplit(ID_movements$PROCES , "|", fixed = TRUE)
procesSteps <- lapply(procesSteps, strsplit, split = '-')
names(procesSteps) <- ID_movements$ID
procesSteps <- as.data.frame(t(as.data.frame(procesSteps)))
names(procesSteps) <- c("from", "to")
procesSteps$color <- "blue"
procesSteps$arrows <- "to"
procesSteps$id <- sub("\\..*$", "",  row.names(procesSteps))

дает вам фрейм данных с from и to, цветом, стрелками и id (снова с префиксом X - sub, чтобы при желании избавиться от x).

...