如何重塑数据框并将多个值粘贴到 R 中稀疏矩阵的单个单元格中?
How to reshape a dataframe and paste multiple values in a single cell of a sparse matrix in R?
我有一个如下所述的数据框。我想创建一个稀疏矩阵,其行名和列名是唯一的站名,在稀疏矩阵的单元格中,我想要该特定站名的所有火车号。 Here is the link of whole data
Train.No. train.Name isl.no. station.code Station.Name
'00851' BNC SUVIDHA SPL 1 BBS BHUBANESWAR
'00851' BNC SUVIDHA SPL 2 BAM BRAHMAPUR
'00851' BNC SUVIDHA SPL 3 VSKP VISAKHAPATNAM
'00851' BNC SUVIDHA SPL 4 BZA VIJAYAWADA JN
'00851' BNC SUVIDHA SPL 5 RU RENIGUNTA JN
'00851' BNC SUVIDHA SPL 6 JTJ JOLARPETTAI
'00851' BNC SUVIDHA SPL 7 BNC BANGALORE CANT
'00852' BNC BBS SUVIDHA 1 BNC BANGALORE CANT
'00852' BNC BBS SUVIDHA 2 JTJ JOLARPETTAI
我正在使用以下代码获得所需的输出,但是这个过程花费了太多时间,因为这不是维度为 4337*4337 的稀疏矩阵。
r1 <- rail
mat_n <- matrix(data = NA, nrow = length(unique(r1$Station.Name)),
ncol = length(unique(r1$Station.Name)))
rownames(mat_n) <- unique(r1$Station.Name)
colnames(mat_n) <- unique(r1$Station.Name)
a1 <- unique(r1$Train.No.)
for(k in 1:length(a1)){
fd1 <- grep(a1[k], r1$Train.No.)
for(i in 1:nrow(mat_n)){
sta1 <- rownames(mat_n)[i]
for(j in 1:ncol(mat_n)){
if(i != j){
sta2 <- colnames(mat_n)[j]
if(length(grep(sta1, r1$Station.Name[fd1[1]]))>0 & length(grep(sta2, r1$Station.Name[fd1[1]:fd1[length(fd1)]]))>0){
mat_n[i,j] <-paste(mat_n[i,j], a1[k])}
}
}
}
}
使用 reshape2、dplyr、tidyr 等软件包的替代方法是什么?我搜索了相同的内容,但没有得到任何可以给我所需输出的内容。 This is the form of desired output I want.
从您的初始数据帧 r1
开始,此 dplyr/tidyr 解决方案可能会为您提供所需的结果
library(dplyr)
library(tidyr)
r1 <- r1 %>%
arrange(Train.No., isl.no.) %>%
group_by(Train.No.) %>%
mutate(Start.Station = first(Station.Name)) %>%
ungroup() %>%
mutate(rownum = row_number()) %>%
spread(Station.Name, Train.No.) %>%
select(-train.Name, -isl.no., -station.code, -rownum) %>%
group_by(Start.Station) %>%
summarise_each(funs(paste(na.omit(.), collapse = " ")))
row.names(r1) <- r1$Start.Station
r1$Start.Station <- NULL
我有一个如下所述的数据框。我想创建一个稀疏矩阵,其行名和列名是唯一的站名,在稀疏矩阵的单元格中,我想要该特定站名的所有火车号。 Here is the link of whole data
Train.No. train.Name isl.no. station.code Station.Name
'00851' BNC SUVIDHA SPL 1 BBS BHUBANESWAR
'00851' BNC SUVIDHA SPL 2 BAM BRAHMAPUR
'00851' BNC SUVIDHA SPL 3 VSKP VISAKHAPATNAM
'00851' BNC SUVIDHA SPL 4 BZA VIJAYAWADA JN
'00851' BNC SUVIDHA SPL 5 RU RENIGUNTA JN
'00851' BNC SUVIDHA SPL 6 JTJ JOLARPETTAI
'00851' BNC SUVIDHA SPL 7 BNC BANGALORE CANT
'00852' BNC BBS SUVIDHA 1 BNC BANGALORE CANT
'00852' BNC BBS SUVIDHA 2 JTJ JOLARPETTAI
我正在使用以下代码获得所需的输出,但是这个过程花费了太多时间,因为这不是维度为 4337*4337 的稀疏矩阵。
r1 <- rail
mat_n <- matrix(data = NA, nrow = length(unique(r1$Station.Name)),
ncol = length(unique(r1$Station.Name)))
rownames(mat_n) <- unique(r1$Station.Name)
colnames(mat_n) <- unique(r1$Station.Name)
a1 <- unique(r1$Train.No.)
for(k in 1:length(a1)){
fd1 <- grep(a1[k], r1$Train.No.)
for(i in 1:nrow(mat_n)){
sta1 <- rownames(mat_n)[i]
for(j in 1:ncol(mat_n)){
if(i != j){
sta2 <- colnames(mat_n)[j]
if(length(grep(sta1, r1$Station.Name[fd1[1]]))>0 & length(grep(sta2, r1$Station.Name[fd1[1]:fd1[length(fd1)]]))>0){
mat_n[i,j] <-paste(mat_n[i,j], a1[k])}
}
}
}
}
使用 reshape2、dplyr、tidyr 等软件包的替代方法是什么?我搜索了相同的内容,但没有得到任何可以给我所需输出的内容。 This is the form of desired output I want.
从您的初始数据帧 r1
开始,此 dplyr/tidyr 解决方案可能会为您提供所需的结果
library(dplyr)
library(tidyr)
r1 <- r1 %>%
arrange(Train.No., isl.no.) %>%
group_by(Train.No.) %>%
mutate(Start.Station = first(Station.Name)) %>%
ungroup() %>%
mutate(rownum = row_number()) %>%
spread(Station.Name, Train.No.) %>%
select(-train.Name, -isl.no., -station.code, -rownum) %>%
group_by(Start.Station) %>%
summarise_each(funs(paste(na.omit(.), collapse = " ")))
row.names(r1) <- r1$Start.Station
r1$Start.Station <- NULL