R function for reformatting columns to rows indicating start and stop points

Viewed 64

I am trying to figure out a way in R to reformate my data frame so that the Veh column with 2 or more stops (Areas) are represented in their own row with Area 2 repeated as a new starting point. Being relatively new to R-- I am not sure how to go about doing this. Any help would be most appreciated.

For example, id like to convert this

ID  Veh   Area 1    Area 2  Area 3   Area 4
1  Veh 1  Area A    Area B    NA       NA                    
2  Veh 2  Area C    NA        NA       NA                     
3  Veh 3  Area D    Area A    NA       NA                   
4  Veh 4  Area E    Area F   Area D  Area A 
5  Veh 5  Area H    Area B   Area C    NA    
6  Veh 6  Area J    Area K   Area A  Area B 

into this:

ID  Veh    Start_Area  Stop_Area
1  Veh 1   Area A      Area B 
2  Veh 2   Area C      Area C
3  Veh 3   Area D      Area A 
4  Veh 4   Area E      Area F 
5  Veh 4   Area F      Area G
6  Veh 4   Area D      Area A   
7  Veh 5   Area H      Area B      
8  Veh 5   Area B      Area C  
9  Veh 6   Area J      Area K   
10 Veh 6   Area K      Area F 
11 Veh 6   Area A      Area B 

and then count the frequency of each pair

4 Answers

We can use base R to do this. Loop over the rows with apply (MARGIN = 1) with the subset of columns i.e remove the 1st two columns (not needed), then we remove the NA in the row (na.omit), if the length of the resultant vector is 1, then create a data.frame with both columns as that value or else, remove the first and last value to create the 'Stop_Area', 'Start_Area'. The output will be a list. Then, we replicate the rows of the original dataset based on the number of rows of this list, and the cbind it with the list cbinded

lst1 <- apply(df1[-(1:2)], 1, function(x) {
      x1 <- na.omit(x)
 if(length(x1) == 1) data.frame(StartArea = x1, Stop_Area = x1) else 
    data.frame(StartArea = x1[-length(x1)], Stop_Area = x1[-1]) 
  })

out <- cbind(df1[1:2][rep(seq_len(nrow(df1)),
          sapply(lst1, nrow)),], do.call(rbind, lst1))
row.names(out) <- NULL

-output

out
#   ID   Veh StartArea Stop_Area
#1   1 Veh 1    Area A    Area B
#2   2 Veh 2    Area C    Area C
#3   3 Veh 3    Area D    Area A
#4   4 Veh 4    Area E    Area F
#5   4 Veh 4    Area F    Area D
#6   4 Veh 4    Area D    Area A
#7   5 Veh 5    Area H    Area B
#8   5 Veh 5    Area B    Area C
#9   6 Veh 6    Area J    Area K
#10  6 Veh 6    Area K    Area A
#11  6 Veh 6    Area A    Area B

data

df1 <- structure(list(ID = 1:6, Veh = c("Veh 1", "Veh 2", "Veh 3", "Veh 4", 
"Veh 5", "Veh 6"), Area1 = c("Area A", "Area C", "Area D", "Area E", 
"Area H", "Area J"), Area2 = c("Area B", NA, "Area A", "Area F", 
"Area B", "Area K"), Area3 = c(NA, NA, NA, "Area D", "Area C", 
"Area A"), Area4 = c(NA, NA, NA, "Area A", NA, "Area B")),
class = "data.frame", row.names = c(NA, 
-6L))

Here is a solution based on tidyverse.

Create df target

Because Area C doesn't have a Stop Area clearly indicated between Area2-3-4, we need to replace the missing value in Area2 with Area1 when Area2-3-4 are missing. Note we use rowwise and c_across to instruct our code to check row by row.

At that point you just reshape your data with pivot_longer and you remove all NAs by specifying values_drop_na = TRUE.

Last touch: you can define StartArea and StopArea for each ID and Veh.

library(tidyr)
library(dplyr)

df1 <- df1 %>%
  rowwise() %>% 
  mutate(Area2 = if_else(all(is.na(c_across(c(Area2, Area3, Area4)))), Area1, Area2)) %>% 
  pivot_longer(starts_with("Area"), values_drop_na = TRUE) %>% 
  group_by(ID, Veh) %>% 
  summarise(StartArea = value[-length(value)],
            StopArea = value[-1],
            .groups = "drop")

df1
#> # A tibble: 11 x 4
#>       ID Veh   StartArea StopArea
#>    <int> <chr> <chr>     <chr>   
#>  1     1 Veh 1 Area A    Area B  
#>  2     2 Veh 2 Area C    Area C  
#>  3     3 Veh 3 Area D    Area A  
#>  4     4 Veh 4 Area E    Area F  
#>  5     4 Veh 4 Area F    Area D  
#>  6     4 Veh 4 Area D    Area A  
#>  7     5 Veh 5 Area H    Area B  
#>  8     5 Veh 5 Area B    Area C  
#>  9     6 Veh 6 Area J    Area K  
#> 10     6 Veh 6 Area K    Area A  
#> 11     6 Veh 6 Area A    Area B  

Count

To count the frequency you can use count:

df1 %>% count(StartArea, StopArea)
#> # A tibble: 9 x 3
#>   StartArea StopArea     n
#>   <chr>     <chr>    <int>
#> 1 Area A    Area B       2
#> 2 Area B    Area C       1
#> 3 Area C    Area C       1
#> 4 Area D    Area A       2
#> 5 Area E    Area F       1
#> 6 Area F    Area D       1
#> 7 Area H    Area B       1
#> 8 Area J    Area K       1
#> 9 Area K    Area A       1

If you want to count the couples of Areas that are connected and you do not care about the direction, then you need to sort each row first.

df2 <- df1 %>% select(StartArea,StopArea)
df2[] <- asplit(apply(df2, 1, sort), 1) # sort by row

df2 %>% count(StartArea, StopArea)
#> # A tibble: 9 x 3
#>   StartArea StopArea     n
#>   <chr>     <chr>    <int>
#> 1 Area A    Area B       2
#> 2 Area A    Area D       2
#> 3 Area A    Area K       1
#> 4 Area B    Area C       1
#> 5 Area B    Area H       1
#> 6 Area C    Area C       1
#> 7 Area D    Area F       1
#> 8 Area E    Area F       1
#> 9 Area J    Area K       1

Data

df1 <- structure(list(ID = 1:6, Veh = c("Veh 1", "Veh 2", "Veh 3", "Veh 4", 
"Veh 5", "Veh 6"), Area1 = c("Area A", "Area C", "Area D", "Area E", 
"Area H", "Area J"), Area2 = c("Area B", NA, "Area A", "Area F", 
"Area B", "Area K"), Area3 = c(NA, NA, NA, "Area D", "Area C", 
"Area A"), Area4 = c(NA, NA, NA, "Area A", NA, "Area B")),
class = "data.frame", row.names = c(NA, -6L))

data.table solution:

library(data.table)
setDT(df1)

melt(df1, id.vars=c("ID","Veh"))[!is.na(value)][
    ,
    if(.N == 1) .(start=value, stop=value) else
                .(start = value[-.N], stop = value[-1]),
    by=c("ID","Veh")    
]

#    ID   Veh  start   stop
# 1:  1 Veh 1 Area A Area B
# 2:  2 Veh 2 Area C Area C
# 3:  3 Veh 3 Area D Area A
# 4:  4 Veh 4 Area E Area F
# 5:  4 Veh 4 Area F Area D
# 6:  4 Veh 4 Area D Area A
# 7:  5 Veh 5 Area H Area B
# 8:  5 Veh 5 Area B Area C
# 9:  6 Veh 6 Area J Area K
#10:  6 Veh 6 Area K Area A
#11:  6 Veh 6 Area A Area B

Which can be extended further if you want to jump straight to counting how many of each pair:

melt(df1, id.vars=c("ID","Veh"))[!is.na(value)][
    ,
    if(.N == 1) .(start=value, stop=value) else
                .(start = value[-.N], stop = value[-1]),
    by=c("ID","Veh")    
][
    ,
    .(count = .N),
    by=c("start","stop")
]

#    start   stop count
#1: Area A Area B     2
#2: Area C Area C     1
#3: Area D Area A     2
#4: Area E Area F     1
#5: Area F Area D     1
#6: Area H Area B     1
#7: Area B Area C     1
#8: Area J Area K     1
#9: Area K Area A     1

Here is a base R option

do.call(
  rbind,
  c(
    make.row.names = FALSE,
    lapply(split(df, 1:nrow(df)), function(v) {
      if (length(u <- na.omit(unlist(v[-(1:2)]))) == 1) y <- rep(u, 2) else y <- embed(c(u), 2)[, 2:1]
      cbind(v[1:2], `colnames<-`(matrix(y, ncol = 2), c("startArea", "stopArea")), row.names = NULL)
    })
  )
)

which gives

   ID   Veh startArea stopArea
1   1 Veh 1    Area A   Area B
2   2 Veh 2    Area C   Area C
3   3 Veh 3    Area D   Area A
4   4 Veh 4    Area E   Area F
5   4 Veh 4    Area F   Area D
6   4 Veh 4    Area D   Area A
7   5 Veh 5    Area H   Area B
8   5 Veh 5    Area B   Area C
9   6 Veh 6    Area J   Area K
10  6 Veh 6    Area K   Area A
11  6 Veh 6    Area A   Area B
Related