The goal of imaginarycss is to …
Installation
You can install the released version of imaginarycss from CRAN with:
install.packages("imaginarycss")
And the development version from GitHub with:
# install.packages("devtools")
devtools::install_github("gvegayon/imaginary-structures")
Example
This is a basic example which shows you how to solve a common problem:
library(imaginarycss)
source_ <- c(1, 2, 3, 1)
target_ <- c(2, 1, 4, 4)
source_ <- c(source_, source_[-1] + 4)
target_ <- c(target_, target_[-1] + 4)
adjmat <- matrix(0L, nrow = 8, ncol = 8)
adjmat[cbind(source_, target_)] <- 1L
graph <- new_barry_graph(adjmat, n = 4)
graph
#> A barry_graph with 2 networks of size 4
#> . . 1.00 . 1.00 . . . .
#> 1.00 . . . . . . .
#> . . . 1.00 . . . .
#> . . . . . . . .
#> . . . . . . . 1.00
#> . . . . 1.00 . . .
#> . . . . . . . 1.00
#> . . . . . . . .
# These are two attributes that are part of the barry_graph object
attr(graph, "endpoints")
#> [1] 8
attr(graph, "netsize")
#> [1] 4
count_recip_errors(graph)
#> id name value
#> 1 0 Partially false recip (omission) (0) 1
#> 2 0 Partially false recip (comission) (0) 0
#> 3 0 Completely false recip (omission) (0) 0
#> 4 0 Completely false recip (comission) (0) 0
#> 5 0 Mixed reciprocity errors (0) 0
#> 6 0 (01) Accurate null (0) 3
#> 7 0 (02) Partial false positive (null) (0) 0
#> 8 0 (03) Complete false positive (null) (0) 0
#> 9 0 (04) Partial false negative (assym) (0) 0
#> 10 0 (05) Accurate assym (0) 2
#> 11 0 (06) Mixed assym (0) 0
#> 12 0 (07) Partial false positive (assym) (0) 0
#> 13 0 (08) Complete false negative (full) (0) 0
#> 14 0 (09) Partial false negative (full) (0) 1
#> 15 0 (10) Accurate full (0) 0
krack_data <- read.csv("data-raw/advice_nets.csv")
krack_data <- as.matrix(krack_data)
n <- 21
krack_adjmat <- matrix(0L, nrow = n * 22, ncol = n * 22)
krack_adjmat[krack_data] <- 1L
graph <- new_barry_graph(
krack_adjmat,
n = n
)
ans <- count_recip_errors(graph)
head(ans)
#> id name value
#> 1 0 Partially false recip (omission) (0) 25
#> 2 1 Partially false recip (omission) (1) 78
#> 3 2 Partially false recip (omission) (2) 52
#> 4 3 Partially false recip (omission) (3) 63
#> 5 4 Partially false recip (omission) (4) 56
#> 6 5 Partially false recip (omission) (5) 56
Another example passing a list
library(network)
#>
#> 'network' 1.18.1 (2023-01-24), part of the Statnet Project
#> * 'news(package="network")' for changes since last version
#> * 'citation("network")' for citation information
#> * 'https://statnet.org' for help, support, and other information
library(ergmito)
knet <- as.network(krack_adjmat)
knet %v% "id" <- rep(0:n, each = n)
netlist <- splitnetwork(knet, "id")
netlist <- lapply(netlist, as.matrix)
graph2 <- new_barry_graph(netlist)
all(barray_to_edgelist(graph2) ==
barray_to_edgelist(graph))
#> [1] TRUE
Now checking that none of these coincide completely
# Removing the network id
ans$name <- gsub("\\([0-9]+\\)$", "", ans$name)
Checking out the distribution
library(ggplot2)
# keeping the onces from the census only
ans <- subset(ans, grepl("^\\([0-9]", name))
ggplot(data = ans, aes(y = value)) +
geom_histogram() +
facet_wrap(vars(name)) +
coord_flip() +
labs(title = "Distribution of type of errors")
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Checking the tie level accuracy
taccuracy <- tie_level_accuracy(graph)
boxplot(
taccuracy[,-1],
main = "Individual level true positive and true negative rates",
ylab = "Probability"
)# Keeping only the ones from the census
# Sampling and using that to generate a new barray graph
graph_sampled <- new_barry_graph(
sample_css_network(graph)
)
microbenchmark::microbenchmark(
sample_css_network(graph)
)
#> Unit: milliseconds
#> expr min lq mean median uq
#> sample_css_network(graph) 11.25291 11.65259 14.32988 12.15657 16.58535
#> max neval
#> 32.85994 100
# Retrieving 1000 samples
set.seed(331)
samp <- replicate(n = 100, sample_css_network(graph), simplify = FALSE)
census <- lapply(samp, \(net) {
count_imaginary_census(new_barry_graph(net))
})
Self perception
We can also separate the counts as a function of whether the perceiver is looking into all ties, only ties including them, or only ties not including them.
census_all <- count_imaginary_census(graph, counter_type = 0)
census_perceiver_only <- count_imaginary_census(graph, counter_type = 1)
census_no_perceiver <- count_imaginary_census(graph, counter_type = 2)
# Should be zero
which_not <- census_all$value -
(census_perceiver_only$value + census_no_perceiver$value)
length(census_all$name[which(which_not != 0)]) == 0L
#> [1] TRUE