-
Notifications
You must be signed in to change notification settings - Fork 0
/
make_read.R
651 lines (633 loc) · 24.1 KB
/
make_read.R
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
# Read ####
#' Making networks from external files
#'
#' @description
#' Researchers regularly need to work with a variety of external data formats.
#' The following functions offer ways to import from some common external
#' file formats into objects that `{manynet}` and other graph/network packages
#' in R can work with:
#'
#' - `read_matrix()` imports adjacency matrices from Excel/csv files.
#' - `read_edgelist()` imports edgelists from Excel/csv files.
#' - `read_nodelist()` imports nodelists from Excel/csv files.
#' - `read_pajek()` imports Pajek (.net or .paj) files.
#' - `read_ucinet()` imports UCINET files from the header (.##h).
#' - `read_dynetml()` imports DyNetML interchange format for rich social network data.
#' - `read_graphml()` imports GraphML files.
#' @details
#' Note that these functions are not as actively maintained as others
#' in the package, so please let us know if any are not currently working
#' for you or if there are missing import routines
#' by [raising an issue on Github](https://github.com/stocnet/manynet/issues).
#' @param file A character string with the system path to the file to import.
#' If left unspecified, an OS-specific file picker is opened to help users select it.
#' Note that in `read_ucinet()` the file path should be to the header file (.##h),
#' if it exists and that it is currently not possible to import multiple
#' networks from a single UCINET file. Please convert these one by one.
#' @param sv Allows users to specify whether their csv file is
#' `"comma"` (English) or `"semi-colon"` (European) separated.
#' @param ... Additional parameters passed to the read/write function.
#' @return `read_edgelist()` and `read_nodelist()` will import
#' into edgelist (tibble) format which can then be coerced or combined into
#' different graph objects from there.
#'
#' `read_pajek()` and `read_ucinet()` will import into
#' a tidygraph format, since they already contain both edge and attribute data.
#' `read_matrix()` will import into tidygraph format too.
#' Note that all graphs can be easily coerced into other formats
#' with `{manynet}`'s `as_` methods.
#' @family makes
#' @details There are a number of repositories for network data
#' that hold various datasets in different formats. See for example:
#'
#' - [UCINET data](https://sites.google.com/site/ucinetsoftware/datasets?authuser=0)
#' - [Pajek data](http://vlado.fmf.uni-lj.si/pub/networks/data/)
#' - [networkdata](https://schochastics.github.io/networkdata/)
#' - [GML datasets](http://www-personal.umich.edu/~mejn/netdata/)
#' - UCIrvine Network Data Repository
#' - [KONECT project](http://konect.cc/)
#' - [SNAP Stanford Large Network Dataset Collection](http://snap.stanford.edu/data/)
#'
#' Please let us know if you identify any further repositories
#' of social or political networks and we would be happy to add them here.
#'
#' The `_ucinet` functions only work with relatively recent UCINET
#' file formats, e.g. type 6406 files.
#' To import earlier UCINET file types, you will need to update them first.
#' To import multiple matrices packed into a single UCINET file,
#' you will need to unpack them and convert them one by one.
#' @source
#' `read_ucinet()` kindly supplied by Christian Steglich,
#' constructed on 18 June 2015.
#' @importFrom utils read.csv read.csv2 read.table
#' @name read
#' @seealso [as]
NULL
#' @rdname read
#' @export
read_matrix <- function(file = file.choose(),
sv = c("comma", "semi-colon"),
...) {
sv <- match.arg(sv)
if (grepl("csv$", file)) {
if (sv == "comma") {
out <- read.csv(file, ...) # For US
} else {
out <- read.csv2(file, ...) # For EU
}
} else if (grepl("xlsx$|xls$", file)) {
thisRequires("readxl")
out <- readxl::read_excel(file, ...)
}
if((dim(out)[1]+1) == dim(out)[2])
out <- out[,-1]
if(!is.null(colnames(out)) &
all(colnames(out) == paste0("X",seq_along(colnames(out)))))
colnames(out) <- NULL
if(!is.null(colnames(out)) & is.null(rownames(out)) &
dim(out)[1] == dim(out)[2])
rownames(out) <- colnames(out)
as_tidygraph(as.matrix(out))
}
#' @rdname read
#' @export
read_edgelist <- function(file = file.choose(),
sv = c("comma", "semi-colon"),
...) {
sv <- match.arg(sv)
if (grepl("csv$", file)) {
if (sv == "comma") {
out <- read.csv(file, header = TRUE, ...) # For US
} else {
out <- read.csv2(file, header = TRUE, ...) # For EU
}
} else if (grepl("xlsx$|xls$", file)) {
thisRequires("readxl")
out <- readxl::read_excel(file, ...)
}
out
}
#' @rdname read
#' @export
read_nodelist <- function(file = file.choose(),
sv = c("comma", "semi-colon"),
...) {
sv <- match.arg(sv)
if (grepl("csv$", file)) {
if (sv == "comma") {
out <- read.csv(file, header = TRUE, ...) # For US
} else {
out <- read.csv2(file, header = TRUE, ...) # For EU
}
} else if (grepl("xlsx$|xls$", file)) {
thisRequires("readxl")
out <- readxl::read_excel(file, ...)
}
out
}
#' @rdname read
#' @param ties A character string indicating the ties/network,
#' where the data contains several.
#' @importFrom network read.paj
#' @importFrom utils read.delim
#' @export
read_pajek <- function(file = file.choose(),
ties = NULL,
...) {
paj <- network::read.paj(file, ...)
if(!is.network(paj)){
if(is.null(ties))
stop(paste("This file contains multiple networks/ties.",
"Please choose a set of ties for the imported network among:\n",
paste0("- '", names(paj$networks), "'", collapse = "\n "),
"\n by adding the name as a character string to the `ties = ` argument"))
out <- paj[[1]][[ties]]
if("partitions" %in% names(paj)){
for(x in names(paj$partitions)){
out <- igraph::set_vertex_attr(out, name = gsub(".clu","",x),
value = paj$partitions[,x])
}
}
out <- as_tidygraph(out)
} else {
out <- as_tidygraph(paj)
}
# if(grepl("Partition", utils::read.delim(file))){
# clus <- strsplit(paste(utils::read.delim(file)), "\\*")[[1]]
# clus <- clus[grepl("^Vertices|^Partition", clus)][-1]
# if(length(clus) %% 2 != 0) stop("Unexpected .pajek file structure.")
# namo <- clus[c(TRUE, FALSE)]
# attr <- clus[c(FALSE, TRUE)]
# for (i in seq_len(namo)){
# vct <- strsplit(attr[i], ",")[[1]][-1]
# vct <- gsub("\"", "", vct)
# vct <- gsub(" ", "", vct, fixed = TRUE)
# vct <- vct[!grepl("^$", vct)]
# if(all(grepl("^-?[0-9.]+$", vct))) vct <- as.numeric(vct)
# out <- set_vertex_attr(out, name = strsplit(namo[i], " |\\.")[[1]][2],
# value = vct)
# }
# }
out
}
#' @rdname read
#' @export
read_ucinet <- function(file = file.choose()) {
# Some basic checks of the input file
# Check if the file is a UCINET header file
if (!grepl(".##h$", file)) {
stop("Please select the UCINET header file with the
'.##h' extension.")
} # Continue if header file is selected
# Check whether there is a data file to be imported in the same folder as the
# hearder file.
if (!(file.exists(sub("h$", "d", file)))) stop("UCINET data file not found.
Please add the '.##d' file in
the same folder as the header
file you are trying to
import. It should also have
the same name as the header
file.")
read_ucinet_header <- function(header_file) {
UCINET.header <- file(header_file, "rb")
ignore <- readBin(UCINET.header, what = "int", size = 1)
headerversion <- paste(
rawToChar(readBin(UCINET.header, what = "raw", size = 1)),
rawToChar(readBin(UCINET.header, what = "raw", size = 1)),
rawToChar(readBin(UCINET.header, what = "raw", size = 1)),
rawToChar(readBin(UCINET.header, what = "raw", size = 1)),
rawToChar(readBin(UCINET.header, what = "raw", size = 1)),
sep = ""
)
# Check for correct UCINET version
if (!(headerversion %in% c("DATE:", "V6404"))) {
close(UCINET.header)
stop(paste("Unknown header type; try more recent UCINET file types"))
}
# Get ymd and weekday of the UCINET file
year <- 2000 + readBin(UCINET.header, what = "int", size = 2)
month <- c(
"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug",
"Sep", "Oct", "Nov", "Dec"
)[readBin(UCINET.header, what = "int", size = 2)]
day <- readBin(UCINET.header, what = "int", size = 2)
dow <- c(
"Monday", "Tuesday", "Wednesday", "Thursday", "Friday",
"Saturday", "Sunday"
)[readBin(UCINET.header, what = "int", size = 2)]
labtype <- readBin(UCINET.header, what = "int", size = 2)
infile.dt <- c(
"nodt", "bytedt", "booleandt", "shortintdt", "worddt",
"smallintdt", "longintdt", "singledt", "realdt", "doubledt",
"compdt", "extendeddt", "labeldt", "setdt", "stringdt", "pointerdt",
"chardt", "integerdt", "nodelistdt", "sparsedt", "int64dt"
)[
readBin(UCINET.header, what = "int", size = 1)
]
# Get the dimensions of the matrix
ndim <- readBin(UCINET.header, what = "int", size = 2)
if (headerversion == "V6404") {
fct <- 2
} else {
fct <- 1
}
dims <- c(
readBin(UCINET.header, what = "int", size = 2 * fct),
readBin(UCINET.header, what = "int", size = 2 * fct)
)
if (ndim == 3) {
dims[3] <- readBin(UCINET.header, what = "int", size = 2 * fct)
}
# Check if user tries to import multiple networks at once.
# This check fails if it is a time series or multilevel network.
if (!(ndim == 2 | ndim == 3 & dims[3] == 1)) {
close(UCINET.header)
stop(paste("UCINET file with", dims[3], "levels; please convert separately"))
}
# Extract the title of the UCINET network
t.length <- readBin(UCINET.header, what = "int", size = 1)
if (t.length > 0) {
titl <- vapply(seq_len(t.length), function(i) {
rawToChar(readBin(UCINET.header, what = "raw", size = 1))
}, FUN.VALUE = character(1))
titl <- paste(titl, collapse = "")
} else {
titl <- ""
}
haslab <- c(
readBin(UCINET.header, what = "logical", size = 1),
readBin(UCINET.header, what = "logical", size = 1)
)
if (ndim == 3) {
haslab[3] <- readBin(UCINET.header, what = "logical", size = 1)
}
dim.labels <- list()
for (arr.dim in seq_len(length(dims))) {
if (haslab[arr.dim]) {
dim.labels[[arr.dim]] <- rep(NA, dims[arr.dim])
for (i in seq_len(dims[arr.dim])) {
lab <- ""
lablen <- readBin(UCINET.header, what = "int", size = 2)
for (let in seq_len(lablen)) {
lab <- paste(lab,
rawToChar(readBin(UCINET.header, what = "raw", size = 1)),
sep = ""
)
}
dim.labels[[arr.dim]][i] <- lab
}
}
}
# Close file connection
close(UCINET.header)
if (ndim == 3 & dims[3] == 1) {
titl <- dim.labels[[3]][1]
# warning(paste('UCINET file with one level; level name "',
# titl,'" treated as network name',sep=''))
ndim <- 2
dims <- dims[1:2]
haslab <- haslab[1:2]
dim.labels <- dim.labels[1:2]
}
return(list(
headerversion = headerversion,
date = paste(dow, paste(day, month, year, sep = "-")),
labtype = labtype,
infile.dt = infile.dt,
ndim = ndim,
dims = dims,
titl = titl,
haslab = haslab,
dim.labels = dim.labels
))
}
# Start of main function code:
header <- read_ucinet_header(file)
file <- sub(".##h", "", file)
# Read in the actual data file ".##d"
UCINET.data <- file(paste(file, ".##d", sep = ""), "rb")
thedata <- vector()
for (i in 1:(header$dims[1] * header$dims[2])) {
thedata[i] <- readBin(UCINET.data,
what = "numeric",
size = 4,
endian = "little"
)
}
close(UCINET.data)
# Build the adjacency matrix
mat <- matrix(thedata,
nrow = header$dims[2],
ncol = header$dims[1],
dimnames = header$dim.labels[c(2, 1)],
byrow = TRUE
)
# put additional info from header file on matrix
if (!(is.null(header$title))) {
attr(mat, "title") <- header$title
}
attr(mat, "date") <- header$date
# attr(mat,'labtype') <- header$labtype
# attr(mat,'infile.dt') <- header$infile.dt
# Convert the adjacency matrix to a tidygraph object
as_tidygraph(mat)
}
#' @rdname read
#' @importFrom dplyr bind_rows coalesce filter mutate select everything
#' @export
read_dynetml <- function(file = file.choose()) {
thisRequires("xml2")
name <- type <- nodeset <- target <- value <- NULL
xmlfile <- xml2::read_xml(file)
xmllist <- xml2::as_list(xmlfile)
# Getting nodeset
# to deal with legacy constructions:
if("MetaMatrix" %in% names(xmllist$DynamicNetwork))
nodesets <- xmllist$DynamicNetwork$MetaMatrix$nodes else
nodesets <- xmllist$DynamicNetwork$MetaNetwork$nodes
nodesets <- dplyr::coalesce(unlist(lapply(nodesets,
function(x) ifelse(is.null(attr(x, "id")),
NA_character_, attr(x, "id")))),
unlist(lapply(nodesets,
function(x) ifelse(is.null(attr(x, "type")),
NA_character_, attr(x, "type")))))
# to deal with legacy constructions:
if("MetaMatrix" %in% names(xmllist$DynamicNetwork)){
nodesets <- unname(rep(nodesets, vapply(xmllist$DynamicNetwork$MetaMatrix$nodes,
function(x) length(x), numeric(1))))
} else
nodesets <- unname(rep(nodesets, vapply(xmllist$DynamicNetwork$MetaNetwork$nodes,
function(x) length(x), numeric(1))))
# Getting nodes
nodes <- xml2::as_list(xml2::xml_find_all(xmlfile, ".//node"))
nodes <- dplyr::bind_rows(lapply(nodes, function(x){
values <- sapply(x$properties, function(y) attr(y, "value"))
attrs <- sapply(x$properties, function(y) attr(y, "name"))
names(values) <- attrs
c(name = attr(x, "id"), values)
}))
# Add nodeset information if necessary
if(length(unique(nodesets))==2)
nodes <- nodes %>% dplyr::mutate(type = nodesets == unique(nodesets)[2]) %>%
dplyr::select(name, type, dplyr::everything()) else if (length(unique(nodesets))>2)
nodes <- nodes %>% dplyr::mutate(nodeset = nodesets) %>%
dplyr::select(name, nodeset, dplyr::everything())
# Getting edges
edgelist <- xml2::xml_attrs(xml2::xml_find_all(xmlfile, ".//edge"))
# to deal with legacy constructions:
if(length(edgelist)==0) edgelist <- xml2::xml_attrs(xml2::xml_find_all(xmlfile, ".//link"))
edgelist <- as.data.frame(t(sapply(edgelist, function(x) x, simplify = TRUE)))
edgelist$type <- NULL
edgelist$value <- as.numeric(edgelist$value)
edgelist <- dplyr::filter(edgelist, source %in% nodes$name & target %in% nodes$name)
edgelist <- dplyr::filter(edgelist, value != 0)
as_tidygraph(list(nodes = nodes, ties = edgelist))
}
#' @rdname read
#' @importFrom igraph read_graph
#' @export
read_graphml <- function(file = file.choose()) {
as_tidygraph(igraph::read_graph(file, format = "graphml"))
}
# Write ####
#' Making networks to external files
#'
#' @description
#' Researchers may want to save or work with networks outside R.
#' The following functions offer ways to export to some common external
#' file formats:
#'
#' - `write_matrix()` exports an adjacency matrix to a .csv file.
#' - `write_edgelist()` exports an edgelist to a .csv file.
#' - `write_nodelist()` exports a nodelist to a .csv file.
#' - `write_pajek()` exports Pajek .net files.
#' - `write_ucinet()` exports a pair of UCINET files in V6404 file format (.##h, .##d).
#' - `write_graphml()` exports GraphML files.
#' @details
#' Note that these functions are not as actively maintained as others
#' in the package, so please let us know if any are not currently working
#' for you or if there are missing import routines
#' by [raising an issue on Github](https://github.com/stocnet/manynet/issues).
#' @inheritParams is
#' @param filename Character string filename.
#' If missing, the files will have the same name as the object
#' and be saved to the working directory.
#' An appropriate extension will be added if not included.
#' @param name Character string to name the network internally, e.g. in UCINET.
#' By default the name will be the same as the object.
#' @param ... Additional parameters passed to the write function.
#' @return The `write_`functions export to different file formats,
#' depending on the function.
#' @family makes
#' @source
#' `write_ucinet()` kindly supplied by Christian Steglich,
#' constructed on 18 June 2015.
#' @importFrom utils write.csv write.csv2
#' @name write
#' @seealso [as]
NULL
#' @rdname write
#' @export
write_matrix <- function(.data,
filename,
# name,
...) {
if (missing(.data)) {
Abruzzo <- Campania <- Calabria <- Puglia <- NULL
Abruzzo <- c(1, 0.76, 0.8, 0.90)
Campania <- c(0.76, 1, 0.62, 0.69)
Calabria <- c(0.80, 0.62, 1, 0.85)
Puglia <- c(0.90, 0.69, 0.85, 1)
out <- data.frame(Abruzzo, Campania, Calabria, Puglia)
row.names(out)<- c('Abruzzo','Campania', 'Calabria', 'Puglia')
out <- as_matrix(out)
object_name <- "test"
} else {
object_name <- deparse(substitute(.data))
out <- as_matrix(.data)
}
if (missing(filename)) filename <- paste0(getwd(), "/", object_name, ".csv")
# if (missing(name)) name <- object_name
write.csv(out, file = filename, row.names = FALSE)
}
#' @rdname write
#' @export
write_edgelist <- function(.data,
filename,
# name,
...) {
if (missing(.data)) {
out <- data.frame(
from = c("A", "B", "C"),
to = c("B", "C", "A"),
weight = c(1.1, 11, 110)
)
object_name <- "test"
} else {
object_name <- deparse(substitute(.data))
out <- as.data.frame(as_edgelist(.data))
}
if (missing(filename)) filename <- paste0(getwd(), "/", object_name, ".csv")
# if (missing(name)) name <- object_name
write.csv(out, file = filename, row.names = FALSE, ...)
}
#' @rdname write
#' @export
write_nodelist <- function(.data,
filename,
# name,
...) {
if (missing(.data)) {
out <- data.frame(
type = c(FALSE, FALSE, TRUE),
name = c("A", "B", "C")
)
object_name <- "test"
} else {
object_name <- deparse(substitute(.data))
out <- as.data.frame(as_tidygraph(.data))
}
if (missing(filename)) filename <- paste0(getwd(), "/", object_name, ".csv")
# if (missing(name)) name <- object_name
write.csv(out, file = filename, row.names = FALSE, ...)
}
#' @rdname write
#' @importFrom igraph write_graph
#' @export
write_pajek <- function(.data,
filename,
...) {
if (missing(filename)) {
object_name <- deparse(substitute(.data))
filename <- paste0(getwd(), "/", object_name, ".net")
}
igraph::write_graph(as_igraph(.data),
file = filename,
format = "pajek",
...
)
}
#' @rdname write
#' @importFrom utils askYesNo
#' @return A pair of UCINET files in V6404 file format (.##h, .##d)
#' @export
write_ucinet <- function(.data,
filename,
name) {
object_name <- deparse(substitute(.data))
if (missing(filename)) filename <- paste0(getwd(), "/", object_name)
if (missing(name)) name <- object_name
# Check to avoid overwriting files by mistake
if (file.exists(paste(filename, ".##h", sep = ""))) {
overwrite <- utils::askYesNo(paste("There is already a file called ",
object_name,
".##h here. Do you want to overwrite it?",
sep = ""))
if (overwrite == FALSE | is.na(overwrite)) {
stop("Writing aborted by user.")
}
}
mat <- as_matrix(.data)
# start with UCINET header file:
UCINET.header <- file(paste(filename, ".##h", sep = ""), "wb")
writeBin(as.integer(5), UCINET.header, size = 1)
writeBin(charToRaw("V"), UCINET.header, size = 1)
writeBin(charToRaw("6"), UCINET.header, size = 1)
writeBin(charToRaw("4"), UCINET.header, size = 1)
writeBin(charToRaw("0"), UCINET.header, size = 1)
writeBin(charToRaw("4"), UCINET.header, size = 1)
year <- as.integer(substr(Sys.Date(), 3, 4))
writeBin(year, UCINET.header, size = 2)
month <- as.integer(substr(Sys.Date(), 6, 7))
writeBin(month, UCINET.header, size = 2)
day <- as.integer(substr(Sys.Date(), 9, 10))
writeBin(day, UCINET.header, size = 2)
dow <- which(c(
"Mon",
"Tue",
"Wed",
"Thu",
"Fri",
"Sat",
"Sun"
) == substr(date(), 1, 3))
writeBin(dow, UCINET.header, size = 2)
writeBin(as.integer(3), UCINET.header, size = 2)
# labtype, unused in V6404 files
writeBin(as.integer(7), UCINET.header, size = 1) # infile.dt = 7 'longintdt'
writeBin(as.integer(2), UCINET.header, size = 2) # ndim = 2 for matrix
writeBin(ncol(mat), UCINET.header, size = 4) # number of columns of matrix
writeBin(nrow(mat), UCINET.header, size = 4) # number of rows of matrix
writeBin(nchar(name), UCINET.header, size = 1) # length of matrix name
if (nchar(name) > 0) {
for (i in 1:nchar(name)) {
writeBin(charToRaw(substr(name, i, i)), UCINET.header, size = 1)
}
}
# Deal with column names of adjacency matrix
labc <- colnames(mat)
# Encoding(labc) <- "UTF-8"
if (!is.null(labc)) {
if (length(table(labc)) != length(labc)) {
labc <- NULL
warning("non-unique column labels, all column labels are dropped")
}
}
writeBin(!is.null(labc), UCINET.header, size = 1)
# Deal with column names of adjacency matrix
labr <- rownames(mat)
# Encoding(labr) <- "UTF-8"
if (!is.null(labr)) {
if (length(table(labr)) != length(labr)) {
labr <- NULL
warning("non-unique row labels, all row labels are dropped")
}
}
writeBin(!is.null(labr), UCINET.header, size = 1)
# Write node names of columns
if (!is.null(labc)) {
for (i in seq_len(ncol(mat))) {
writeBin(as.integer(2 * nchar(labc[i])), UCINET.header, size = 2)
for (let in seq_len(nchar(labc[i]))) {
writeBin(charToRaw(substr(labc[i], let, let)),
UCINET.header,
size = 1
)
writeBin(raw(1), UCINET.header, size = 1)
}
}
}
# Write node names of rows
if (!is.null(labr)) {
for (i in seq_len(nrow(mat))) {
writeBin(as.integer(2 * nchar(labr[i])), UCINET.header, size = 2)
for (let in seq_len(nchar(labr[i]))) {
writeBin(charToRaw(substr(labr[i], let, let)),
UCINET.header,
size = 1
)
writeBin(raw(1), UCINET.header, size = 1)
}
}
}
close(UCINET.header)
# continue with UCINET data file: --> Write the actual matrix
UCINET.data <- file(paste(filename, ".##d", sep = ""), "wb")
for (i in seq_len(length(mat))) {
writeBin(t(mat)[i], UCINET.data, size = 4, endian = "little")
}
close(UCINET.data)
}
#' @rdname write
#' @importFrom igraph write_graph
#' @export
write_graphml <- function(.data,
filename,
# name,
...) {
# if (missing(name)) name <- deparse(substitute(.data))
if (missing(filename)) filename <- paste0(getwd(), "/", deparse(substitute(.data)), ".graphml")
igraph::write_graph(.data,
filename,
format = "graphml")
}