In FJValverde/entropies: Plotting ternary entropy diagrams for joint distributions, contingency matrices, etc

This vignettes tries to present instances of features that have specific stochastic properties to improve the understanding and intution of what each corner of the Source Multivariate Entropy Triangle (SMET) means.

Environment construction

library(dplyr)     # That famous Mr. Wickham!
library(entropies) # This package
#knitr::opts_chunk$set(dev = 'pdf') # plots in pdf, better for publication
knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(comment=NA, fig.width=6, fig.height=4)

Conceptual triangle

This is the conceptual triangle for the AGGREGATE source multivariate entropy triangle:

m <- 
    rbind(
    c("irredundant", 0.00, 0.00, 1.0, "irredundant"), 
    c("redundant", 0.0, 1.0, 0.0, "redundant"),
    c("deterministic", 1.0, 0.0, 0.0, "deterministic"),
    c("almost irredundant", 0.05, 0.05, 0.9, "irredundant"), 
    c("almost redundant", 0.05, 0.9, 0.05, "redundant"),
    c("almost deterministic", 0.9, 0.05, 0.05, "quasi-deterministic")
)
d <- data.frame(
    name = m[,1],
    DeltaH_Pxi=as.numeric(m[,2]),
    M_Pxi=as.numeric(m[,3]),
    VI_Pxi=as.numeric(m[,4]),
    point = m[,5]
) %>% mutate(extreme = DeltaH_Pxi == 1.0 | M_Pxi == 1.0 | VI_Pxi == 1.0)
#multiSplitEntropies  <-  splitESmetCoords <-  c("name", "DeltaH_Pxi", "M_Pxi", "VI_Pxi") 
#names(d) <-  c(multiSplitEntropies, "point", "extremePoint")

# THe points at the vertices
conceptual <- ggmetern(filter(d, extreme), fancy=FALSE) + 
    geom_point(aes(fill=name, shape=name), size=3) +    
    #scale_fill_manual(values=c("red", "blue", "orange")) +
    scale_shape_manual(values=c(21,22,23)) + #, guide=FALSE) +
    #guides(fill=FALSE, shape=FALSE) 
    guides(fill=FALSE) + labs(shape="Source type") 
    #labs(shape="Feature type") + #guides(color=FALSE) #scale_color_manual(guide=FALSE)
    #guides(fill=FALSE,shape=FALSE) #scale_color_manual(guide=FALSE)

#Now place the non-extreme points: be careful to rename them
nonExtremes <- filter(d, !extreme) %>%
    #rename(Delta=DeltaH_Pxi, M=M_Pxi, VI=VI_Pxi) %>%
    select(-point, -extreme)
#the points in the middle of the angles and dise
conceptual <- conceptual + 
    geom_point(data=nonExtremes, aes(shape=name), size=3) +
    #scale_shape_manual(values=rep(22,3), guide=FALSE) + 
    scale_shape_manual(values=rep(c(21,22,23),2)) + #, guide=FALSE) + 
    scale_colour_manual(values=c("red", "blue", "orange")) +
    #guides(shape=guide_legend()) + #,fill=guide_colorbar()) + 
    labs(shape="Source type")
    #guides(shape=FALSE) +

conceptual
ggsave(filename="annotated_SMET_triangle.jpeg", plot=conceptual)

Data generation

This describes a split triangle.

m <- 240 # vector instances
nRandom <- 5     # Add a number of balanced, random features
dsRandom <- as.data.frame(matrix(rep(0, m*nRandom), nrow=m, ncol=nRandom)) 
# Add the random balanced vectors
rRandom <- 1:nRandom
set.seed(29)
for(f in rRandom){#generate random features: 
    dsRandom[,f] <- rbinom(m, 1, 0.5)
}
names(dsRandom) <- paste0("b",rRandom)
##########################################################################################
nUnbalanced <- 5 # Add a number of unbalanced, random features
dsUnbalanced <- as.data.frame(matrix(rep(0, m*nUnbalanced), nrow=m, ncol=nUnbalanced))
# Add the random unbalanced vectors.
rUnbalanced <-  1:nUnbalanced
for(f in rUnbalanced){#generate random features: 
    dsUnbalanced[,f] <- rbinom(m, 1, 0.99)
}
names(dsUnbalanced) <-  paste0("u", rUnbalanced)
##########################################################################################
nRedundant <- 5  # Add a number of very redundant features
dsRedundant <- as.data.frame(matrix(rep(0, m*nRedundant), nrow=m, ncol=nRedundant))
#n <- nRandom + nUnbalanced + nRedundant
#ds <- as.data.frame(matrix(rep(0, m+n), nrow=m, ncol=n))
# Add a number of very redundant vectors
rRedundant <- 1:nRedundant
v <- as.numeric(rbinom(m, 1, 0.5)) # They are also quite balanced
for(f in rRedundant){
    #dsRedundant[,f] <- jitter(v * f, amount=0.1*f)
    dsRedundant[,f] <- jitter(v, factor=0.5)
    #dsRedundant[,f] <- as.numeric(rbinom(m, 1, 0.5)) + 05
}
names(dsRedundant) <- paste0("r", rRedundant)

##########################################################################################
#names(ds) <- c(paste0("b",rRandom), paste0("u", rUnbalanced), paste0("r", rRedundant))

Visualization

###########################################################################
edsRandom <- sentropies(dsRandom) %>% mutate(type="irredundant")
            #(type=substr(name, 1,1)) %>% filter(type != "A")
ggmetern(edsRandom) + # now create the plot
    geom_point(aes(colour=name), size=3)
edsUnbalanced <- sentropies(dsUnbalanced) %>% mutate(type="quasi-deterministic")
    #mutate(type=substr(name, 1,1)) %>% filter(type != "A")
ggmetern(edsUnbalanced) + # now create the plot
    geom_point(aes(colour=name), size=3)
edsRedundant <- sentropies(dsRedundant) %>% mutate(type="redundant")
ggmetern(edsRedundant) + # now create the plot
    geom_point(aes(colour=name), size=3)
###########################################################################
# Put together al the different types of points
eds <- rbind(edsRandom, edsUnbalanced, edsRedundant) %>% filter(name != "ALL")
#summary(eds)

# First add the densities
#et <- ggmetern(eds, fancy=FALSE) #+ # now create the plot
    # stat_density_tern(geom='polygon',
    #                      n         = 200,
    #                      aes(fill  = ..level..,
    #                          alpha = ..level..)) +    
    # scale_fill_gradient(low = "white",high = "black")  +
    # guides(fill = "none", alpha= "none")
    #guides(fill = "none", alpha = "none")
# then add the points on the original data
et <-  ggmetern(eds, fancy=FALSE) + 
    geom_point(aes(shape=type), size=3) +
    scale_shape_manual(values=c(21,22,23)) + #, guide=FALSE) + 
    scale_colour_manual(values=c("red", "blue", "orange")) +
    labs(shape="Feature type") + guides(color=FALSE) #scale_color_manual(guide=FALSE)
    #scale_fill_manual(values=c("red", "blue", "yellow"))
et
ggsave(filename="annotated_multisplit_SMET.jpeg", plot=et)

Postscriptum

More information about the evaluation of sources with the Source Multivariate Entropy Triangle can be found in

library(bibtex)
print(citation("entropies")['val:pel:17b'], style="text")

Session information

sessionInfo()

FJValverde/entropies documentation built on Oct. 12, 2023, 10:17 p.m.