问从数据帧中提取信息

EN

## 1: split into (val,ss) pairs, and capture ci (column index) association
res <- setNames(do.call(rbind,lapply(seq_along(df),function(ci)
    do.call(rbind,lapply(strsplit(as.character(df[[ci]]),'-'),function(x)
        data.frame(x[2L],x[1L],ci,stringsAsFactors=F)
    ))
)),c('val','ss','ci'));
res;
##   val ss ci
## 1   4  3  1
## 2   1  4  1
## 3   4  5  1
## 4   4  2  2
## 5  15  3  2
## 6  16  7  2

## 2: aggregate ss (joining on comma) by (val,ci), and capture record count as n
res <- do.call(rbind,by(res,res[c('val','ci')],function(x)
    data.frame(val=x$val[1L],ci=x$ci[1L],n=nrow(x),ss=paste(x$ss,collapse=','),stringsAsFactors=F)
));
res;
##   val ci n  ss
## 1   1  1 1   4
## 2   4  1 2 3,5
## 3  15  2 1   3
## 4  16  2 1   7
## 5   4  2 1   2

## 3: reshape to wide format
res <- reshape(res,idvar='val',timevar='ci',dir='w');
res;
##   val n.1 ss.1 n.2 ss.2
## 1   1   1    4  NA <NA>
## 2   4   2  3,5   1    2
## 3  15  NA <NA>   1    3
## 4  16  NA <NA>   1    7

## 4: add repeated column; can be calculated by summing all n.* columns
## note: leveraging psum() from <http://stackoverflow.com/questions/12139431/add-variables-whilst-ignoring-nas-using-transform-function>
psum <- function(...,na.rm=F) { x <- list(...); rowSums(matrix(unlist(x),ncol=length(x)),na.rm=na.rm); };
res$repeated <- do.call(psum,c(res[grep('^n\\.[0-9]+$',names(res))],na.rm=T));
res;
##   val n.1 ss.1 n.2 ss.2 repeated
## 1   1   1    4  NA <NA>        1
## 2   4   2  3,5   1    2        3
## 3  15  NA <NA>   1    3        1
## 4  16  NA <NA>   1    7        1

n.cis <- grep('^n\\.[0-9]+$',names(res));
ss.cis <- grep('^ss\\.[0-9]+$',names(res));
res[n.cis][is.na(res[n.cis])] <- 0L;
res[ss.cis][is.na(res[ss.cis])] <- '-';
res;
##   val n.1 ss.1 n.2 ss.2 repeated
## 1   1   1    4   0    -        1
## 2   4   2  3,5   1    2        3
## 3  15   0    -   1    3        1
## 4  16   0    -   1    7        1

newdfstring <- apply(df,1:2, function(v) unlist(strsplit(v,"-")))
newdf <- apply(newdfstring,1:3, as.numeric)

#length of the columns in the new frame = number of unique values
dflength <- length(unique(array(newdf[2,,]))) 
dfout <- data.frame(Value=rep(0,dflength),repeated=rep(0,dflength),s1N=rep(0,dflength),s2N=rep(0,dflength),ss1=rep(0,dflength),ss2=rep(0,dflength))

dfout$Value <- unique(array(newdf[2,,]))
for(i in 1:dflength){
  getID <- which(as.data.frame(table(newdf[2,,]))$Var1==dfout$Value[i])
  dfout$repeated[i] <- as.data.frame(table(newdf[2,,]))$Freq[getID]
  dfout$s1N[i] <- as.data.frame(table(newdf[2,,1]))$Freq[getID]
  if(is.na(dfout$s1N[i])){
    dfout$s1N[i] <- 0
  }
  dfout$s2N[i] <- as.data.frame(table(newdf[2,,2]))$Freq[getID]
  if(is.na(dfout$s2N[i])){
    dfout$s2N[i] <- 0
  }
  getID <- which(newdf[2,,1]==dfout$Value[i])
  if(length(getID)>0){
    dfout$ss1[i] <- toString(newdf[1,,1][getID])
  } else {
    dfout$ss1[i] <- 0
  }
  getID <- which(newdf[2,,2]==dfout$Value[i])
  if(length(getID)>0){
    dfout$ss2[i] <- toString(newdf[1,,2][getID])
  } else {
    dfout$ss2[i] <- 0
  }
}
dfout
#  Value repeated s1N s2N  ss1 ss2
#1     4        3   2   1 3, 5   2
#2     1        1   1   1    4   0
#3    15        1   0   1    0   3
#4    16        1   0   0    0   7

newdfstring <- apply(df,1:2, function(v) unlist(strsplit(v,"-")))
newdf <- apply(newdfstring,1:3, as.numeric)
dflength <- length(unique(array(newdf[2,,])))
#find the number of s variables
slength <- length(newdf[1,1,])
#create a matrix of appropriate size
dfout <- matrix(data=NA,nrow=dflength,ncol=(2+2*slength))
#create a (near)-empty names array, we will fill it in later
names <- c("Value","repeated",rep("",2*slength))
#fill in the Values column
dfout[,1] <- unique(array(newdf[2,,]))
#loop for every s variable
for(j in 1:slength){
  #get their names, paste N or s and add them to the names array
  names[2+j] <- paste(names(df)[j],"N",sep="")
  names[2+j+slength] <- paste("s",names(df)[j],sep="")
  #loop to get the other values
  for(i in 1:dflength){
    getID <- which(as.data.frame(table(newdf[2,,]))$Var1==dfout[i,1])
    dfout[i,2] <- as.data.frame(table(newdf[2,,]))$Freq[getID]
    dfout[i,2+j] <- as.data.frame(table(newdf[2,,j]))$Freq[getID]
    if(is.na(dfout[i,2+j])){
      dfout[i,2+j] <- 0
    }
    getID <- which(newdf[2,,j]==dfout[i,1])
    if(length(getID)>0){
      dfout[i,2+j+slength] <- toString(newdf[1,,j][getID])
    } else {
      dfout[i,2+j+slength] <- 0
    }
  }
}
colnames(dfout)<-names
as.data.frame(dfout)
#  Value repeated s1N s2N  ss1 ss2
#1     4        3   2   1 3, 5   2
#2     1        1   1   1    4   0
#3    15        1   0   1    0   3
#4    16        1   0   0    0   7

# function to split the strings
myfun<-function(x){
  x<-strsplit(as.character(x), '-')
  x1<-unlist(x)
  x.new<-as.data.frame(matrix(x1, byrow = T, length(x)))
  return(x.new)
}

# this returns a list of dataframes 
list.v<-lapply(df[1:dim(df)[2]], myfun)
# like this
head(list.v[[17]])

# try to combine all the dfs, produced an error of mismatching # of columns
df2<-do.call(rbind, list.v) 

# some of the dfs in list.v are all NA's, they should be dropped
sum<-summary(list.v)        
list.v<-list.v[-which(sum[,1] != "2")]  # this excludes those all-NA datafrmes in list.v

# now combine all dfs for indexing purposes
df2<-do.call(rbind, list.v)

# create "value", "repeated" column in the desired result df. 
# These codes are same as my previous answer
value<-names(table(df2[,2]))
repeated<-as.vector(table(df2[,2]))

# create an empty list to store the counts columns
list.count<-vector("list", length = length(list.v))

# every df in list.v has same number of rows, get the row number
rownum<-nrow(list.v[[1]])

# use a for loop to fill out list.count
for(i in 0:(length(list.count)-1)){
  row.start<-i*rownum+1   # it is kind of tricky here
  row.end<-(i+1)*rownum   # same as above
  list.count[[i + 1]]<-as.vector(table(df2[,2][row.start:row.end]))
}

# combine the vectors in list.count and assing names
count.df<-do.call(cbind, list.count)
count.df<-as.data.frame(count.df)

# create & assign colum names in the format of "s_n", and "_" is filled with corresponding original column name
names.cnt<-character()
for(i in 1:length(names(list.v))){
  names.cnt[i]<-paste("s", names(list.v)[i], "n", sep="")
}          
names(count.df)<-names.cnt

# this is a very long loop to concatenate the strings and store them into a matrix, but it gets the job done here.
ss.store<-matrix(,nrow = length(value), ncol = length(list.v), byrow = FALSE)
for(i in 1:length(list.v)){
  for(j in 1:length(value)){
  ss.store[j,i]<-paste(list.v[[i]][,1][which(list.v[[i]][,2] == value[j])], collapse =",")
  }
}

# create a df for strings
string.df<-as.data.frame(ss.store, stringsAsFactors = FALSE)

# create & assign names to the df
names.str<-character()
for(i in 1:length(names(list.v))){
  names.str[i]<-paste("s", "s", names(list.v)[i], sep="")
} 
names(string.df)<-names.str

# combine everything and form the new data frame
new.df<-cbind(value, repeated, count.df, string.df, stringAsFactors = FALSE)

new.df[1:10, 1:15]
   value repeated sAn sF1n sF2n sF3n sF4n sF5n sF6n sF7n sF8n sF9n sF10n sF11n sF12n
1    100      155   3    0    0    0    0    0    0    0    0    0     0     0     0
2   1005       14   1    0    0    0    0    0    0    0    0    0     0     0     0
3   1006       50   1    0    0    0    0    0    0    0    0    0     0     0     0
4   1023        1   1    0    0    0    0    0    0    0    0    0     0     0     0
5   1025       38   1    0    0    0    0    0    0    0    0    0     0     0     0
6   1030      624   1    0    1    2    0    0    0    0    0    0     1     0     0
7   1035        1   1    0    0    0    0    0    0    0    0    0     0     0     0
8    104      165   2    0    0    0    0    0    0    0    0    0     0     0     0
9   1076      186   2    0    0    0    0    0    0    0    0    0     0     0     0
10  1078      333   3    0    0    0    0    0    0    0    0    0     0     0     0