inst/doc/rinform-vignette.R

In rinform: An R Wrapper of the 'Inform' C Library for Information Analysis of Complex Systems

## ----setup, include = FALSE----------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(rinform)

## ----eval = FALSE--------------------------------------------------------
#  install.packages("rinform")

## ----eval = FALSE--------------------------------------------------------
#  library(rinform)

## ----eval = FALSE--------------------------------------------------------
#  install.packages("devtools")

## ----eval = FALSE--------------------------------------------------------
#  library(devtools)
#  install_github("ELIFE-ASU/rinform")

## ----eval = FALSE--------------------------------------------------------
#  install_github("ELIFE-ASU/rinform", ref = "dev")

## ----eval = FALSE--------------------------------------------------------
#  library(rinform)

## ------------------------------------------------------------------------
Dist(3)

## ------------------------------------------------------------------------
Dist(c(5, 3))

## ------------------------------------------------------------------------
d <- Dist(c(2, 13))
d

## ------------------------------------------------------------------------
d <- resize(d, 5)
d

## ------------------------------------------------------------------------
d <- resize(d, 3)
d

## ------------------------------------------------------------------------
d <- Dist(c(1:5))
d

## ------------------------------------------------------------------------
p <- copy(d)
p

## ------------------------------------------------------------------------
d <- infer(c(0, 0, 1, 0, 1))
dump(d)

## ------------------------------------------------------------------------
d <- infer(c(0, 0, 1, 0, 1, 2, 2, 1))
dump(d)

## ------------------------------------------------------------------------
probs <- c(0.5, 0.2, 0.3)
d     <- approximate(probs, 1e-3)
d$histogram

probs <- c(1.0 / 3, 2.0 / 3)
d     <- approximate(probs, 1e-3)
d$histogram

## ------------------------------------------------------------------------
d <- uniform(3)
d

dump(d)

## ------------------------------------------------------------------------
d <- NULL
length(d)

## ------------------------------------------------------------------------
d <- Dist(5)
length(d)

## ------------------------------------------------------------------------
dist <- Dist(c(5, 10))
counts(dist) == 15

## ------------------------------------------------------------------------
dist <- set_item(dist, 2, 5)
counts(dist) == 10

## ------------------------------------------------------------------------
dist <- Dist(3)
valid(dist)

## ------------------------------------------------------------------------
dist <- Dist(c(1:5))
valid(dist)

## ------------------------------------------------------------------------
dist$size <- as.integer(0)
valid(dist)

## ------------------------------------------------------------------------
dist <- Dist(c(3, 2, 1, 0))
get_item(dist, 1) == 3
get_item(dist, 2) == 2
get_item(dist, 3) == 1
get_item(dist, 4) == 0

## ------------------------------------------------------------------------
dist <- Dist(2)
dist

## ------------------------------------------------------------------------
dist <- set_item(dist, 1, 3)
dist <- set_item(dist, 2, 8)
dist

## ------------------------------------------------------------------------
dist <- Dist(c(2, 4))

## ------------------------------------------------------------------------
dist <- tick(dist, 1)
get_item(dist, 1) == 3

dist <- tick(dist, 2)
get_item(dist, 2) == 5

## ------------------------------------------------------------------------
d <- Dist(c(1, 2, 3))
dump(d)

## ------------------------------------------------------------------------
events <- c(0, 0, 1, 0, 1)
d <- accumulate(d, events)
dump(d)

## ------------------------------------------------------------------------
events <- c(0, 1, 1, 3, 1)
d <- accumulate(d, events)
dump(d)

## ------------------------------------------------------------------------
dist <- Dist(c(2, 2, 4))

## ------------------------------------------------------------------------
probability(dist, 1) == 0.25
probability(dist, 2) == 0.25
probability(dist, 3) == 0.50

## ------------------------------------------------------------------------
dist <- Dist(c(2, 2, 4))
dump(dist)

## ------------------------------------------------------------------------
dist <- set_item(dist, 1, 12)
dump(dist)

## ------------------------------------------------------------------------
p <- Dist(c(1, 1, 1, 1))
shannon_entropy(p)
shannon_entropy(p, b = 4)

## ------------------------------------------------------------------------
p <- Dist(c(2, 1))
shannon_entropy(p)
shannon_entropy(p, b = 3)

## ------------------------------------------------------------------------
xy <- Dist(c(10, 70, 15, 5))
x  <- Dist(c(80, 20))
y  <- Dist(c(25, 75))

shannon_mutual_info(xy, x, y)

## ------------------------------------------------------------------------
xy <- Dist(c(10, 70, 15, 5))
x  <- Dist(c(80, 20))
y  <- Dist(c(25, 75))

shannon_conditional_entropy(xy, x)
shannon_conditional_entropy(xy, y)

## ------------------------------------------------------------------------
xyz <- Dist(c(24, 24, 9, 6, 25, 15, 10, 5))
xz  <- Dist(c(15, 9, 5, 10))
yz  <- Dist(c(9, 15, 10, 15))
z   <- Dist(c(3, 5))
shannon_cond_mutual_info(xyz, xz, yz, z)

## ------------------------------------------------------------------------
p <- Dist(c(4, 1))
q <- Dist(c(1, 1))
shannon_relative_entropy(p, q)
shannon_relative_entropy(q, p)
     
p <- Dist(c(1, 0))
q <- Dist(c(1, 1))
shannon_relative_entropy(p, q)
shannon_relative_entropy(q, p)

## ------------------------------------------------------------------------
p <- Dist(c(1, 0, 0))
q <- Dist(c(2, 1, 1))
shannon_cross_entropy(p, q)
shannon_cross_entropy(q, p)
shannon_cross_entropy(p, q, b = 3)
shannon_cross_entropy(q, p, b = 3)

## ------------------------------------------------------------------------
xs <- c(1, 0, 0, 1, 0, 0, 1, 1)
xs

## ------------------------------------------------------------------------
l <- 2
n <- 2
m <- 5
xs <- matrix(sample(0:1, m * l * n, TRUE), nrow = m, ncol = l * n)
xs

## ------------------------------------------------------------------------
series <- c(0, 0, 1, 1, 1, 1, 0, 0, 0)
active_info(series, k = 2)

## ------------------------------------------------------------------------
lai <- active_info(series, k = 2, local = T)
t(lai)

## ------------------------------------------------------------------------
series      <- matrix(nrow = 9, ncol = 2)
series[, 1] <- c(0, 0, 1, 1, 1, 1, 0, 0, 0)
series[, 2] <- c(1, 0, 0, 1, 0, 0, 1, 0, 0)
active_info(series, k = 2)

## ------------------------------------------------------------------------
lai <- active_info(series, k = 2, local = T)
t(lai)


## ------------------------------------------------------------------------
series <- c(0, 0, 1, 1, 1, 1, 0, 0, 0)
block_entropy(series, k = 1)

block_entropy(series, k = 2)

## ------------------------------------------------------------------------
be <- block_entropy(series, k = 1, local = T)
t(be)

be <- block_entropy(series, k = 2, local = T)
t(be)

## ------------------------------------------------------------------------
series      <- matrix(nrow = 9, ncol = 2)
series[, 1] <- c(0, 0, 1, 1, 1, 1, 0, 0, 0)
series[, 2] <- c(1, 0, 0, 1, 0, 0, 1, 0, 0)
block_entropy(series, k = 2)

## ------------------------------------------------------------------------
be <- block_entropy(series, k = 2, local = T)
t(be)

## ------------------------------------------------------------------------
xs <- c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1)
ys <- c(0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1)

conditional_entropy(xs, ys)

conditional_entropy(ys, xs)

## ------------------------------------------------------------------------
ce <- conditional_entropy(xs, ys, local = T)
t(ce)

ce <- conditional_entropy(ys, xs, local = T)
t(ce)

## ------------------------------------------------------------------------
ps <- c(0, 1, 1, 0, 1, 0, 0, 1, 0, 0)
qs <- c(0, 0, 0, 0, 0, 1, 1, 0, 0, 1)

cross_entropy(ps, qs)

cross_entropy(qs, ps)

## ------------------------------------------------------------------------
tpm      <- matrix(0, nrow = 2, ncol = 2)
tpm[, 1] <- c(0.50, 0.5)
tpm[, 2] <- c(0.25, 0.75)
effective_info(tpm, NULL)

## ------------------------------------------------------------------------
tpm      <- matrix(0, nrow = 2, ncol = 2)
tpm[, 1] <- c(0.50, 0.5)
tpm[, 2] <- c(0.25, 0.75)
inter    <- c(0.488372, 0.511628)
effective_info(tpm, inter)

## ------------------------------------------------------------------------
series <- c(0, 0, 1, 1, 1, 1, 0, 0, 0)
entropy_rate(series, k = 2)

## ------------------------------------------------------------------------
er <- entropy_rate(series, k = 2, local = T)
t(er)

## ------------------------------------------------------------------------
series      <- matrix(nrow = 9, ncol = 2)
series[, 1] <- c(0, 0, 1, 1, 1, 1, 0, 0, 0)
series[, 2] <- c(1, 0, 0, 1, 0, 0, 1, 0, 0)
entropy_rate(series, k = 2)

## ------------------------------------------------------------------------
er <- entropy_rate(series, k = 2, local = T)
t(er)

## ------------------------------------------------------------------------
series <- c(0, 0, 1, 1, 0, 0, 1, 1, 0)
excess_entropy(series, k = 2)

## ------------------------------------------------------------------------
ee <- excess_entropy(series, k = 2, local = TRUE)
t(ee)

## ------------------------------------------------------------------------
series      <- matrix(0, nrow = 9, ncol =2)
series[, 1] <- c(0, 0, 1, 1, 0, 0, 1, 1, 0)
series[, 2] <- c(0, 1, 0, 1, 0, 1, 0, 1, 0)
excess_entropy(series, k = 2)

## ------------------------------------------------------------------------
ee <- excess_entropy(series, k = 2, local = TRUE)
t(ee)

## ------------------------------------------------------------------------
series      <- matrix(0, nrow = 10, ncol = 3)
series[, 1] <- c(0, 1, 0, 1, 1, 1, 0, 0, 1, 0)
series[, 2] <- c(0, 1, 0, 1, 1, 1, 0, 0, 1, 0)
series[, 3] <- c(1, 1, 1, 1, 1, 0, 0, 0, 0, 0)
integration_evidence(series)

## ------------------------------------------------------------------------
parts <- c(1, 1, 2)
integration_evidence(series, parts)

## ------------------------------------------------------------------------
ws <- c(0, 0, 1, 0, 1, 1, 0, 1)
xs <- c(0, 0, 1, 0, 1, 1, 0, 1)
ys <- c(0, 0, 1, 0, 1, 1, 0, 1)
zs <- c(0, 0, 0, 0, 0, 0, 0, 0)

## ------------------------------------------------------------------------
info_flow(src = xs, dst = ys, lsrc = 1, ldst = 1)                      
info_flow(src = xs, dst = ys, back = ws, lsrc = 1, ldst = 1, lback = 1)
info_flow(src = ws, dst = zs, back = ys, lsrc = 1, ldst = 1, lback = 1)

## ------------------------------------------------------------------------
ws <- c(0, 0, 1, 0, 1, 1, 0, 1)
xs <- c(0, 0, 1, 0, 1, 1, 0, 1)
ys <- c(1, 0, 1, 0, 0, 1, 1, 0)
zs <- c(1, 0, 0, 0, 1, 0, 1, 1)

## ------------------------------------------------------------------------
info_flow(src = xs, dst = ys, lsrc = 1, ldst = 1)                      
info_flow(src = xs, dst = ys, back = ws, lsrc = 1, ldst = 1, lback = 1)
info_flow(src = ws, dst = zs, back = ys, lsrc = 1, ldst = 1, lback = 1)

## ------------------------------------------------------------------------
xs <- matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1,
               0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1), ncol = 2)
mutual_info(xs)

## ------------------------------------------------------------------------
mi <- mutual_info(xs, local = T)
t(mi)

## ------------------------------------------------------------------------
xs <- matrix(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1,
               0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1,
               1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1), ncol = 3)
mutual_info(xs)

## ------------------------------------------------------------------------
mi <- mutual_info(xs, local = T)
t(mi)

## ------------------------------------------------------------------------
series <- c(0, 0, 1, 1, 0, 0, 1, 1, 0)
predictive_info(series, 1, 2)

## ------------------------------------------------------------------------
pi <- predictive_info(series, 1, 2, T)
t(pi)

## ------------------------------------------------------------------------
series      <- matrix(0, nrow = 9, ncol = 2)
series[, 1] <- c(0, 0, 1, 1, 0, 0, 1, 1, 0)
series[, 2] <- c(0, 1, 0, 1, 0, 1, 0, 1, 0)
predictive_info(series, 1, 2)

## ------------------------------------------------------------------------
pi <- predictive_info(series, 1, 2, T)
t(pi)

## ------------------------------------------------------------------------
xs <- c(0, 1, 0, 0, 0, 0, 0, 0, 0, 1)
ys <- c(0, 1, 1, 1, 1, 0, 0, 1, 0, 0)

relative_entropy(xs, ys)
relative_entropy(ys, xs)

## ------------------------------------------------------------------------
re <- relative_entropy(xs, ys, local = T)
t(re)

re <- relative_entropy(ys, xs, local = T)
t(re)

## ------------------------------------------------------------------------
dest <- c(0, 1, 1, 1, 1, 0, 0, 0, 0)
srcs <- c(0, 0, 1, 1, 1, 1, 0, 0, 0)
separable_info(srcs, dest, k = 2)

## ------------------------------------------------------------------------
si <- separable_info(srcs, dest, k = 2, local = TRUE)
t(si)

## ------------------------------------------------------------------------
dest      <- c(0, 1, 1, 1, 1, 0, 0, 0, 0)
srcs      <- matrix(0, nrow = 9, ncol = 2)
srcs[, 1] <- c(0, 0, 1, 1, 1, 1, 0, 0, 0)
srcs[, 2] <- c(1, 1, 1, 1, 0, 0, 0, 0, 0)
separable_info(srcs, dest, k = 2)

## ------------------------------------------------------------------------
si <- separable_info(srcs, dest, k = 2, local = TRUE)
t(si)

## ------------------------------------------------------------------------
dest      <- matrix(0, nrow = 9, ncol = 2)
dest[, 1] <- c(0, 1, 1, 1, 1, 0, 0, 0, 0)
dest[, 2] <- c(1, 1, 0, 1, 1, 0, 1, 1, 0)
srcs      <- matrix(0, nrow = 9, ncol = 4)
srcs[, 1] <- c(0, 0, 1, 1, 1, 1, 0, 0, 0)
srcs[, 2] <- c(1, 1, 1, 1, 1, 0, 1, 1, 0)
srcs[, 3] <- c(1, 1, 1, 1, 0, 0, 0, 0, 0)
srcs[, 4] <- c(0, 0, 0, 0, 1, 1, 1, 1, 0)
separable_info(srcs, dest, k = 2)

## ------------------------------------------------------------------------
si <- separable_info(srcs, dest, k = 2, local = TRUE)
t(si)

## ------------------------------------------------------------------------
xs <- c(0, 1, 1, 1, 1, 0, 0, 0, 0)
ys <- c(0, 0, 1, 1, 1, 1, 0, 0, 0)
transfer_entropy(xs, ys, ws = NULL, k = 2)

## ------------------------------------------------------------------------
te <- transfer_entropy(xs, ys, ws = NULL, k = 2, local = T)
t(te)

## ------------------------------------------------------------------------
xs <- matrix(0, nrow = 9, ncol = 2)
xs[, 1] <- c(1, 0, 0, 0, 0, 1, 1, 1, 1)
xs[, 2] <- c(1, 1, 1, 1, 0, 0, 0, 1, 1)
ys <- matrix(0, nrow = 9, ncol = 2)
ys[, 1] <- c(0, 0, 1, 1, 1, 1, 0, 0, 0)
ys[, 2] <- c(1, 0, 0, 0, 0, 1, 1, 1, 0)
transfer_entropy(xs, ys, ws = NULL, k = 2)

## ------------------------------------------------------------------------
te <- transfer_entropy(xs, ys, ws = NULL, k = 2, local = T)
t(te)

## ------------------------------------------------------------------------
xs <- c(0, 1, 1, 1, 1, 0, 0, 0, 0)
ys <- c(0, 0, 1, 1, 1, 1, 0, 0, 0)
ws <- c(0, 1, 1, 1, 1, 0, 1, 1, 1)
transfer_entropy(xs, ys, ws, k = 2)

## ------------------------------------------------------------------------
te <- transfer_entropy(xs, ys, ws, k = 2, local = T)
t(te)

## ------------------------------------------------------------------------
xs <- c(0, 1, 1, 1, 1, 0, 0, 0, 0)
ys <- c(0, 0, 1, 1, 1, 1, 0, 0, 0)
ws <- matrix(c(1, 0, 1, 0, 1, 1, 1, 1, 1,
               1, 1, 0, 1, 0, 1, 1, 1, 1), ncol = 2)
transfer_entropy(xs, ys, ws, k = 2)

## ------------------------------------------------------------------------
te <- transfer_entropy(xs, ys, ws, k = 2, local = T)
t(te)

## ------------------------------------------------------------------------
xs <- c(0.2, 0.5, -3.2, 1.8, 0.6, 2.3)
series_range(xs)

## ------------------------------------------------------------------------
series <- c(1, 2, 3, 4, 5, 6)
bin_series(series, b = 2)

## ------------------------------------------------------------------------
bin_series(series, step = 2.0)

## ------------------------------------------------------------------------
bin_series(series, bounds = c(3, 7))

## ------------------------------------------------------------------------
series      <- matrix(0, nrow = 8, ncol = 2)
series[, 1] <- c(0, 1, 1, 0, 1, 0, 0, 1)
series[, 2] <- c(1, 0, 0, 1, 1, 0, 1, 0)
black_box(series, l = 2)

## ------------------------------------------------------------------------
series <- c(0, 1, 1, 0, 1, 0, 0, 1)
black_box(series, l = 1, r = 2)

## ------------------------------------------------------------------------
series      <- matrix(0, nrow = 8, ncol = 2)
series[, 1] <- c(0, 1, 1, 0, 1, 0, 0, 1)
series[, 2] <- c(1, 0, 0, 1, 1, 0, 1, 0)
black_box(series, l = 2, r = c(2, 1), s = c(0, 1))

## ------------------------------------------------------------------------
xs      <- matrix(0, nrow = 8, ncol = 4)
xs[, 1] <- c(0, 1, 1, 0, 1, 0, 0, 1)
xs[, 2] <- c(1, 0, 0, 1, 1, 0, 1, 0)
xs[, 3] <- c(0, 0, 0, 1, 1, 1, 0, 0)
xs[, 4] <- c(1, 0, 1, 0, 1, 1, 1, 0)
parts   <- c(1, 1, 1, 1)
black_box_parts(xs, parts)

## ------------------------------------------------------------------------
parts   <- c(1, 2, 2, 1)
x <- black_box_parts(xs, parts)
x

## ------------------------------------------------------------------------
xs         <- matrix(0, nrow = 8, ncol = 4)
xs[, 1]    <- c(0, 1, 1, 0, 1, 0, 0, 1)
xs[, 2]    <- c(1, 0, 0, 1, 1, 0, 1, 0)
xs[, 3]    <- c(0, 0, 0, 1, 1, 1, 0, 0)
xs[, 4]    <- c(1, 0, 1, 0, 1, 1, 1, 0)
all_parts  <- partitioning(4)
mmi        <- rep(0, dim(all_parts)[2] - 1)

for (i in 2:dim(all_parts)[2]) {
  x          <- black_box_parts(xs, all_parts[, i])
  mmi[i - 1] <- mutual_info(x$box)
}
round(mmi, 3)

## ------------------------------------------------------------------------
coalesce(c(0, 2, 0, 2, 0, 2))

## ------------------------------------------------------------------------
coalesce(c(-8, 2, 6, -2, 4))

## ------------------------------------------------------------------------
encode(c(0, 0, 1), b = 2)
encode(c(0, 1, 0), b = 3)
encode(c(1, 0, 0), b = 4)
encode(c(1, 0, 4), b = 5)

## ------------------------------------------------------------------------
encode(c(0, 0, 2), NA)
encode(c(0, 2, 0))
encode(c(1, 2, 1))

## ------------------------------------------------------------------------
decode(2, b = 2, n = 2)
decode(6, b = 2, n = 3)
decode(6, b = 3, n = 2)

## ------------------------------------------------------------------------
decode(2, b = 2, n = 4)

## ------------------------------------------------------------------------
decode(1, b = 2)
decode(1, b = 3)
decode(3, b = 2)
decode(3, b = 3)
decode(3, b = 4)

## ------------------------------------------------------------------------
partitioning(3)

## ------------------------------------------------------------------------
dim(partitioning(9))[2]

## ------------------------------------------------------------------------
series <- c(0, 2, 1, 0, 1, 2, 0, 1, 2, 1, 0, 0, 2, 1, 1)
series_to_tpm(series)

## ------------------------------------------------------------------------
series <- matrix(0, nrow = 2, ncol = 7)
series[, 1] <- c(0, 0)
series[, 2] <- c(0, 1)
series[, 3] <- c(0, 1)
series[, 4] <- c(0, 1)
series[, 5] <- c(1, 0)
series[, 6] <- c(1, 1)
series[, 7] <- c(2, 2)
series_to_tpm(series)