File: loadnetwork.R

package info (click to toggle)
r-cran-blockmodeling 1.1.5-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 912 kB
  • sloc: ansic: 2,024; f90: 952; sh: 13; makefile: 5
file content (161 lines) | stat: -rw-r--r-- 5,472 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
#' Functions for loading and writing Pajek files
#' 
#' Functions for reading/loading and writing Pajek files:
#' 
#' 
#' @name Pajek
NULL


#' @rdname Pajek
#' @description \code{loadnetwork} - Loads a Pajek ".net" filename as a matrix. For now, only simple one and two-mode networks are supported (eg. only single relations, no time information).
#' 
#' @aliases Pajek loadnetwork loadnetwork2 loadnetwork3 loadnetwork4 savevector savenetwork savematrix loadmatrix loadvector loadvector2 loadpajek
#'
#' @param filename The name of the file to be loaded or saved to or an open file object.
#' @param useSparseMatrix Should a sparse matrix be use instead of the ordinary one? Sparse matrices can only be used if package Matrix is installed. The default \code{NULL} uses sparse matrices  for networks with more that \code{minN} vertices.
#' @param minN The minimal number of units in the network to use sparse matrices.
#'
#' @return NULL, a matrix or a vector.
#'
#' @references 
#' Batagelj, V., & Mrvar. A. (1999). Pajek - Program for Large Network Analysis. Retrieved from http://vlado.fmf.uni-lj.si/pub/networks/pajek/.
#' 
#' de Nooy, W., Mrvar, A., & Batagelj. V. (2005). Exploratory Social Network Analysis with Pajek. London: SAGE Publications.
#' 
#' @author Vladimir Batagelj & Andrej Mrvar (most functions), \enc{Aleš Žiberna}{Ales Ziberna} (\code{loadnetwork}, \code{loadpajek} and modification of others)
#' @seealso \code{\link{plot.mat}}, \code{\link{critFunC}}, \code{\link{optRandomParC}}
#' @keywords graphs file
#' @import Matrix
#' @importFrom utils read.table
#' 
#' @export

"loadnetwork" <-
function(filename,useSparseMatrix=NULL,minN=50){
  trim.trailing <- function (x) sub("\\s+$", "", x)

  n<-c("%")
  i=0
  repeat {
    n<-read.table(file=filename,nrows=1,as.is=TRUE,skip = i)
    if(substr(n[1],1,1)!="%") break
    print(paste(n,collapse=" "))
    i=i+1
  }
  if(length(n)==2){
    n<-as.numeric(n[2])
    n
    rLines<-readLines(con=filename)
    nl<-length(rLines)
    #ind.stars<-which(regexpr(pattern="*", text=rLines,fixed=TRUE)>0)
    ind.stars<-which(substr(rLines,1,1)=="*")
    nstars<-length(ind.stars)
    stars<-rLines[ind.stars]
    stars<-trim.trailing(stars)
    rm(rLines)
    
    vnames1<-read.table(file=filename,skip=ind.stars[1],nrows=ind.stars[2]-ind.stars[1]-1,as.is =TRUE)
    vnames<-character(n)
    vnames[vnames1[,1]]<-vnames1[,2]
    if(all(is.na(vnames))){
      vnames<-NULL
    } else vnames[is.na(vnames)]<-""
    
    if(is.null(useSparseMatrix)){
        useSparseMatrix<- n>=50
    }
    
    if(useSparseMatrix){
    	if(requireNamespace("Matrix")){
    		M<-Matrix::Matrix(0,nrow=n,ncol=n,sparse=TRUE)
    	}else{
    		warning("Matrix package is not installed. Ordanary (dense) matrices will be used instead of sparse onse")
    		M<-matrix(0,nrow=n,ncol=n)
    	}
    }else{
	M<-matrix(0,nrow=n,ncol=n)       
    }
    
    
    if(useSparseMatrix){
    	if(requireNamespace("Matrix")){
    		M<-Matrix::Matrix(0,nrow=n,ncol=n,sparse=TRUE)
    	}else{
        	M<-matrix(0,nrow=n,ncol=n)
        	warning("Matrix package is not installed. Ordanary (dense) matrices will be used instead of sparse onse")
        }
    } else{
	M<-matrix(0,nrow=n,ncol=n)           
    }
    for(i in 2:nstars){
      nrows<-ifelse(i==nstars,-1,ind.stars[i+1]-ind.stars[i]-1)
      ties<-read.table(file=filename,skip=ind.stars[i],nrows=nrows)
      ncols<-dim(ties)[2]
      if(ncols==2){
      	ties<-cbind(ties,1)
      } else if(ncols>3){
      	ties<-ties[,1:3]
      }
      ties<-apply(ties,2,as.numeric)
      if(stars[i]=="*Arcs"|stars[i]=="*arcs"){
        M[ties[,1:2]]<-ties[,3]
      } else if(stars[i]=="*Edges"|stars[i]=="*edges"){
        M[ties[,1:2]]<-ties[,3]
        M[ties[,2:1]]<-ties[,3]
      }
    }
    dimnames(M)<-list(vnames,vnames)
  } else{
      n12<-as.numeric(n[2])
      n1<-as.numeric(n[3])
      n2<-n12-n1

    rLines<-readLines(con=filename)
    nl<-length(rLines)
    #ind.stars<-which(regexpr(pattern="*", text=rLines,fixed=TRUE)>0)
    ind.stars<-which(substr(rLines,1,1)=="*")
    nstars<-length(ind.stars)
    stars<-rLines[ind.stars]
    rm(rLines)
    
    vnames1<-read.table(file=filename,skip=ind.stars[1],nrows=ind.stars[2]-ind.stars[1]-1,as.is =TRUE)
    vnames<-character(n12)
    vnames[vnames1[,1]]<-vnames1[,2]
    if(all(is.na(vnames))){
      vnames<-NULL
    } else vnames[is.na(vnames)]<-""
    
    
    if(is.null(useSparseMatrix)){
        useSparseMatrix<- n12>50
    }    
    if(useSparseMatrix){
    	if(requireNamespace("Matrix")){
    		M<-Matrix::Matrix(0,nrow=n12,ncol=n12,sparse=TRUE)
    	}else{
    		warning("Matrix package is not installed. Ordanary (dense) matrices will be used instead of sparse onse")
    		M<-matrix(0,nrow=n12,ncol=n12)
    	}
    }else{
	M<-matrix(0,nrow=n12,ncol=n12)       
    }
    for(i in 2:nstars){
      nrows<-ifelse(i==nstars,-1,ind.stars[i+1]-ind.stars[i]-1)
      ties<-read.table(file=filename,skip=ind.stars[i],nrows=nrows)
      ncols<-dim(ties)[2]
      if(ncols==2){
      	ties<-cbind(ties,1)
      } else if(ncols>3){
      	ties<-ties[,1:3]
      }
      ties<-apply(ties,2,as.numeric)
      M[ties[,1:2]]<-ties[,3]
      M[ties[,2:1]]<-ties[,3]
    }
    dimnames(M)<-list(vnames,vnames)
  M<-M[1:n1,(n1+1):n12]    
  }
  return(M)
}