R/displaytable.R
In JotSoSerious/cooccurExtra: An extension use of R package "cooccur"
Defines functions
displaytable
# Function "displaytable"
#####
# Require package "formattable"
#####
# A function for display the result table
#####
displaytable = function(mymod, ingradients = mymod$Used.Ingradients, with.splits = FALSE,
table.out = c("both", "stats", "significants"),
full_stats = c("full", "prob", "obs"),
collapse_row = c("no", "top", "bottom")){
#####*1* "mymod" a model that generated by "coocana"
#####*2* "ingradients" vector input inquires for the shown ingradients
#####*3* "with.splits" logical, shows the splits stats and summary if "TRUE"
#####*4* "table.out" options of the tables to be shown
#####*5* "full_stats" options of output shown in statistic table.
#####*6* "collapse_row" options of the ways of collapsing rows of pairs
###########################################################################################
#0. turn down warnings
###########################################################################################
oldw <- getOption("warn")
options(warn = -1)
###########################################################################################
#1. some preperations
###########################################################################################
##(0). check whether the input model in a right type
if(class(mymod) == "list"){
check.mod = match(names(mymod), c("Model", "Splits", "Stats", "Pairs",
"Cooc.Mat", "Used.Ingradients"))
judge.mod = any(is.na(check.mod))
}else{
judge.mod = TRUE
}
if(judge.mod){
#show()
writeLines(c("Error Message:",
"The input model type is not in the 'coocana' form."))
return()
}
##(1). check whether has splits & and check the option "with.splits"
judge.splits = !is.na(mymod$Splits)[1] # "True" if there are splits
if(!judge.splits){
if(with.splits){
writeLines(c("Warning Message:",
paste(" The input 'with.splits = TRUE' is invalid,",
"since the input model has no splits.")))}
with.splits = FALSE
}
##(2). check if there is any input ingradient
#if(is.na(ingradients)) ingradients = mymod$Used.Ingradients
##(3). check whether the input ingradients are all in the given model
check.ingradients = match(ingradients, mymod$Used.Ingradients)
judge.ingradients = is.na(check.ingradients)
##(4). show warnings
if(any(judge.ingradients)){
writeLines(c("Warning Message:",
paste(ifelse(sum(judge.ingradients) == 1, "Ingradient", "Ingradients"),
paste(paste0("'", ingradients[judge.ingradients], "'"),
collapse = ","),
ifelse(sum(judge.ingradients) == 1, "is", "are"),
"not analized in the given model, which",
ifelse(sum(judge.ingradients) == 1, "has", "have"),
"been ignored.")))
}
##(5). keep the remainning ingradients
keep.ingradients = ingradients[!judge.ingradients]
###########################################################################################
#2. create a significant table to be print out
###########################################################################################
##(1) table with splits
if(with.splits){
###(o) create a vector of column names
link.ingradient = match(keep.ingradients, mymod$Used.Ingradients)
cnames = c("Specie.One", "Specie.Two",
paste0(rep(c("Range-", "Cooccurence-"),
length(keep.ingradients)),
rep(keep.ingradients, each = 2)))
is.range = 2 * (1:length(keep.ingradients)) + 1 # a vector detect the range columns
###(i) find the number of rows
num.row = 0
max.length = NA # length of each pair
for(n in 1:(length(mymod$Model) - 1)){# counter of pairs
max.length.temp = 0
for(m in 1:length(keep.ingradients)){# counter of ingradients
max.length.temp = max(c(max.length.temp,
length(mymod$Model[[n]][[link.ingradient[m]]])))
}
max.length = c(max.length, max.length.temp + 1)
num.row = num.row + max.length.temp + 1
}
max.length = max.length[-1] # length of each pair
###(ii) create a matrix
Table.to.Show = matrix(0, nrow = num.row, ncol = length(cnames))
###(iii) add the column names and turn into a data frame
colnames(Table.to.Show) = cnames
Table.to.Show = as.data.frame(Table.to.Show)
###(iv) put species names as well as the ranges into the data frame
temp.level = 0
temp.PNR = checkpnr(mymod$Model$`Full Data`)
for(n in 1:(length(mymod$Model) - 1)){# counter of pairs
for(i in 1:max.length[n]){# counter of replicate of pairs
for(j in 1:length(keep.ingradients)){# counter of ingradients
if(i == 1){
range.length.temp = length(mymod$Model[[n]][[j]]) + 1
Table.to.Show[(temp.level + i):(temp.level + max.length[n]),
is.range[j]] = c("Full", names(mymod$Model[[n]][[j]]),
rep(NA, max.length[n] - range.length.temp))
pair.PNR = temp.PNR$PNR[((!is.na(match(mymod$Pairs[n, 1],
temp.PNR$sp1_name))) &
(!is.na(match(mymod$Pairs[n, 2],
temp.PNR$sp2_name))))|
((!is.na(match(mymod$Pairs[n, 1],
temp.PNR$sp2_name))) &
(!is.na(match(mymod$Pairs[n, 1],
temp.PNR$sp2_name))))]
Table.to.Show[temp.level + i, is.range[j] + 1] = t(pair.PNR)
}else{# extract the model of a certain range
if(!is.na(Table.to.Show[temp.level + i, is.range[j]])){
temp.range.model = mymod$Model[[n]][[j]][[i - 1]]
temp.choice = c("Positive", "Negative", "Random")
temp.result = c(temp.range.model$positive, temp.range.model$negative,
temp.range.model$random)
Table.to.Show[temp.level + i,
is.range[j] + 1] = temp.choice[as.logical(temp.result)]
}else{
# Table.to.Show[temp.level + i, is.range[j] + 1] = NA
Table.to.Show[temp.level + i, is.range[j]:(is.range[j] + 1)] = c("", "")
}
}
}
Table.to.Show[temp.level + i, 1:2] = mymod$Pairs[n,]
if(collapse_row == "top" & i != 1){
Table.to.Show[temp.level + i, 1:2] = c("", "")
}
if(collapse_row == "bottom" & i != max.length[n]){
Table.to.Show[temp.level + i, 1:2] = c("", "")
}
}
temp.level = temp.level + max.length[n]
}
}
##(2) table without splits
else{
###(i) get the full model & also the PNR result
if(judge.splits){
Table.to.Show = checkpnr(mymod$Model$`Full Data`)[, c(1, 2, 4)]
}else{
Table.to.Show = checkpnr(mymod$Model)[, c(1, 2, 4)]
}
###(ii) and name the matrix
colnames(Table.to.Show) = c("Specie.One", "Specie.Two", "Cooccurence")
}
# show(Table.to.Show)
###########################################################################################
#3. print the significant table in fancy format
###########################################################################################
if(table.out != "stats"){
if(with.splits){
f1 = formattable(Table.to.Show, align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
area(col = is.range) ~
formatter("span", style = ~ style(color = "dimgrey",
font.weight = "bold")),
area(col = is.range + 1) ~
formatter("span", style = x ~
style(color = ifelse(x == "Positive", "seagreen",
ifelse(x == "Negative", "tomato",
"darkslategrey"))),
x ~ icontext(ifelse(x == "Positive" |
x == "Negative",
"star", ""), x))))
show(f1)
}else{
f1 = formattable(Table.to.Show, align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
area(col = 3:ncol(Table.to.Show)) ~
formatter("span", style = x ~
style(color = ifelse(x == "Positive", "seagreen",
ifelse(x == "Negative", "tomato",
"darkslategrey"))),
x ~ icontext(ifelse(x == "Positive" | x == "Negative",
"star", ""), x))))
show(f1)
}}
###########################################################################################
#4. create a stat table to be print out
###########################################################################################
##(1) stats table with splits
if(with.splits){
###(o) create a vector of column names
cnames = c("Specie.One", "Specie.Two", "Ingradients", "Range", "Sp1_Inc", "Sp2_Inc",
"Obs_Cooccur", "Prob_Cooccur", "Exp_Cooccur", "P_lt", "P_gt")
###(i) find the number of rows
link.ingradient = match(keep.ingradients, mymod$Used.Ingradients)
each.length = rep(NA, (length(mymod$Model) - 1) * length(keep.ingradients)) # length of each pair & each ingradient
temp.level = 0
for(n in 1:(length(mymod$Model) - 1)){# counter of pairs
for(m in 1:length(keep.ingradients)){# counter of ingradients
each.length[temp.level + m] = nrow(mymod$Stats[[link.ingradient[m]]][[n]])
}
temp.level = temp.level + length(keep.ingradients)
}
###(ii) create a matrix
Table.Stats = matrix(0, nrow = sum(each.length), ncol = length(cnames))
###(iii) add the column names and turn into a data frame
colnames(Table.Stats) = cnames
Table.Stats = as.data.frame(Table.Stats)
###(iv) put every detail into the data frame
current.level = 0
for(n in 1:(length(mymod$Model) - 1)){# counter of pairs
more.locate = NA
for(m in 1:length(keep.ingradients)){# counter of ingradients
temp.stats = mymod$Stats[[link.ingradient[m]]][[n]]
temp.length = nrow(temp.stats)
locate = (current.level + 1):(current.level + temp.length)
more.locate = c(more.locate, locate)
Table.Stats[locate, 4] = rownames(temp.stats)
Table.Stats[locate, 5:11] = temp.stats
Table.Stats[locate, 3] = rep(keep.ingradients[m], temp.length)
#show(locate)
if(collapse_row == "top"){
Table.Stats[locate[-1], 3] = rep("", (temp.length - 1))
}
if(collapse_row == "bottom"){
Table.Stats[locate[-temp.length], 3] = rep("", (temp.length - 1))
}
Table.Stats[locate, 1:2] = matrix(rep(mymod$Pairs[n, ], temp.length),
byrow = T, ncol = 2)
current.level = locate[length(locate)]
}
more.locate = more.locate[-1]
if(collapse_row == "top"){
Table.Stats[more.locate[-1], 1:2] = matrix(rep(c("", ""),
(length(more.locate) - 1)),
ncol = 2)
}
if(collapse_row == "bottom"){
Table.Stats[more.locate[-length(more.locate)], 1:2] =
matrix(rep(c("", ""),
(length(more.locate) - 1)),
ncol = 2)
}
}
}
##(2) stats table without splits
else{
###(i) get the result of the full model
if(judge.splits){
Table.Stats = mymod$Model$`Full Data`$results[, c(10:11, 3:9)]
}else{
Table.Stats = mymod$Model$results[, c(10:11, 3:9)]
}
###(ii) and re-name the matrix
colnames(Table.Stats) = c("Specie.One", "Specie.Two", "Sp1_Inc", "Sp2_Inc",
"Obs_Cooccur", "Prob_Cooccur", "Exp_Cooccur", "P_lt", "P_gt")
}
###########################################################################################
#5. print the stats table in fancy format
###########################################################################################
if(table.out != "significants"){
if(with.splits){
judge.trc = mymod$Model$`Full Data`$true_rand_classifier / 2
#full_stats = c("full", "prob", "obs")
if(full_stats == "prob"){
f2 = formattable(Table.Stats[, c(1:4, 7, 9:11)], align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Ingradients = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Range = formatter("span",
style = ~ style(color = "dimgrey",
font.weight = "bold")),
Obs_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Exp_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
P_lt = formatter("span", style = ~
style(color = ifelse(1 - P_gt < judge.trc,
"tomato",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_gt < judge.trc,
"star", ""), P_lt)),
P_gt = formatter("span", style = ~
style(color = ifelse(1 - P_lt < judge.trc,
"seagreen",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_lt < judge.trc,
"star", ""), P_gt))))
}else{
if(full_stats == "obs"){
f2 = formattable(Table.Stats[, 1:8], align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Ingradients = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Range = formatter("span",
style = ~ style(color = "dimgrey",
font.weight = "bold")),
Sp1_Inc = color_tile("gold", "gold4"),
Sp2_Inc = color_tile("gold", "gold4"),
Obs_Cooccur = color_tile("gold", "gold4"),
Prob_Cooccur = color_bar("darkorange")))
}else{
f2 = formattable(Table.Stats, align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Ingradients = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Range = formatter("span",
style = ~ style(color = "dimgrey",
font.weight = "bold")),
# Sp1_Inc = color_tile("gold", "gold4"),
# Sp2_Inc = color_tile("gold", "gold4"),
# Obs_Cooccur = color_tile("gold", "gold4"),
# Prob_Cooccur = color_bar("darkorange"),
# Exp_Cooccur = color_tile("gold", "gold4"),
Sp1_Inc = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Sp2_Inc = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Obs_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Prob_Cooccur = color_bar("seagreen"),
Exp_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
P_lt = formatter("span", style = ~
style(color = ifelse(1 - P_gt < judge.trc,
"tomato",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_gt < judge.trc,
"star", ""), P_lt)),
P_gt = formatter("span", style = ~
style(color = ifelse(1 - P_lt < judge.trc,
"seagreen",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_lt < judge.trc,
"star", ""), P_gt))))
}
}
show(f2)
}else{
judge.trc = ifelse(judge.splits,
mymod$Model$`Full Data`$true_rand_classifier / 2,
mymod$Model$true_rand_classifier / 2)
if(full_stats == "prob"){
f2 = formattable(Table.Stats[, c(1:2, 5, 7:9)], align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Obs_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Exp_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
P_lt = formatter("span", style = ~
style(color = ifelse(1 - P_gt < judge.trc,
"tomato",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_gt < judge.trc,
"star", ""), P_lt)),
P_gt = formatter("span", style = ~
style(color = ifelse(1 - P_lt < judge.trc,
"seagreen",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_lt < judge.trc,
"star", ""), P_gt))))
}else{
if(full_stats == "obs"){
f2 = formattable(Table.Stats[, 1:6], align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Sp1_Inc = color_tile("gold", "gold4"),
Sp2_Inc = color_tile("gold", "gold4"),
Obs_Cooccur = color_tile("gold", "gold4"),
Prob_Cooccur = color_bar("darkorange")))
}else{
f2 = formattable(Table.Stats, align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
# Sp1_Inc = color_tile("gold", "gold4"),
# Sp2_Inc = color_tile("gold", "gold4"),
# Obs_Cooccur = color_tile("gold", "gold4"),
# Prob_Cooccur = color_bar("darkorange"),
# Exp_Cooccur = color_tile("gold", "gold4"),
Sp1_Inc = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Sp2_Inc = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Obs_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Prob_Cooccur = color_bar("seagreen"),
Exp_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
P_lt = formatter("span", style = ~
style(color = ifelse(1 - P_gt < judge.trc,
"tomato",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_gt < judge.trc,
"star", ""), P_lt)),
P_gt = formatter("span", style = ~
style(color = ifelse(1 - P_lt < judge.trc,
"seagreen",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_lt < judge.trc,
"star", ""), P_gt))))
}
}
show(f2)
}}
###########################################################################################
#6. turn back on warnings
###########################################################################################
options(warn = oldw)
###########################################################################################
#7. return both tables
###########################################################################################
if(table.out == "stats") f1 = NA
if(table.out == "significants") f2 = NA
return(list(STATSTAB = Table.Stats, SIGNTAB = Table.to.Show,
STATSFT = f2, SIGNFT = f1))
}
JotSoSerious/cooccurExtra documentation built on Oct. 30, 2019, 8:03 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions displaytable
# Function "displaytable"
#####
# Require package "formattable"
#####
# A function for display the result table
#####
displaytable = function(mymod, ingradients = mymod$Used.Ingradients, with.splits = FALSE,
table.out = c("both", "stats", "significants"),
full_stats = c("full", "prob", "obs"),
collapse_row = c("no", "top", "bottom")){
#####*1* "mymod" a model that generated by "coocana"
#####*2* "ingradients" vector input inquires for the shown ingradients
#####*3* "with.splits" logical, shows the splits stats and summary if "TRUE"
#####*4* "table.out" options of the tables to be shown
#####*5* "full_stats" options of output shown in statistic table.
#####*6* "collapse_row" options of the ways of collapsing rows of pairs
###########################################################################################
#0. turn down warnings
###########################################################################################
oldw <- getOption("warn")
options(warn = -1)
###########################################################################################
#1. some preperations
###########################################################################################
##(0). check whether the input model in a right type
if(class(mymod) == "list"){
check.mod = match(names(mymod), c("Model", "Splits", "Stats", "Pairs",
"Cooc.Mat", "Used.Ingradients"))
judge.mod = any(is.na(check.mod))
}else{
judge.mod = TRUE
}
if(judge.mod){
#show()
writeLines(c("Error Message:",
"The input model type is not in the 'coocana' form."))
return()
}
##(1). check whether has splits & and check the option "with.splits"
judge.splits = !is.na(mymod$Splits)[1] # "True" if there are splits
if(!judge.splits){
if(with.splits){
writeLines(c("Warning Message:",
paste(" The input 'with.splits = TRUE' is invalid,",
"since the input model has no splits.")))}
with.splits = FALSE
}
##(2). check if there is any input ingradient
#if(is.na(ingradients)) ingradients = mymod$Used.Ingradients
##(3). check whether the input ingradients are all in the given model
check.ingradients = match(ingradients, mymod$Used.Ingradients)
judge.ingradients = is.na(check.ingradients)
##(4). show warnings
if(any(judge.ingradients)){
writeLines(c("Warning Message:",
paste(ifelse(sum(judge.ingradients) == 1, "Ingradient", "Ingradients"),
paste(paste0("'", ingradients[judge.ingradients], "'"),
collapse = ","),
ifelse(sum(judge.ingradients) == 1, "is", "are"),
"not analized in the given model, which",
ifelse(sum(judge.ingradients) == 1, "has", "have"),
"been ignored.")))
}
##(5). keep the remainning ingradients
keep.ingradients = ingradients[!judge.ingradients]
###########################################################################################
#2. create a significant table to be print out
###########################################################################################
##(1) table with splits
if(with.splits){
###(o) create a vector of column names
link.ingradient = match(keep.ingradients, mymod$Used.Ingradients)
cnames = c("Specie.One", "Specie.Two",
paste0(rep(c("Range-", "Cooccurence-"),
length(keep.ingradients)),
rep(keep.ingradients, each = 2)))
is.range = 2 * (1:length(keep.ingradients)) + 1 # a vector detect the range columns
###(i) find the number of rows
num.row = 0
max.length = NA # length of each pair
for(n in 1:(length(mymod$Model) - 1)){# counter of pairs
max.length.temp = 0
for(m in 1:length(keep.ingradients)){# counter of ingradients
max.length.temp = max(c(max.length.temp,
length(mymod$Model[[n]][[link.ingradient[m]]])))
}
max.length = c(max.length, max.length.temp + 1)
num.row = num.row + max.length.temp + 1
}
max.length = max.length[-1] # length of each pair
###(ii) create a matrix
Table.to.Show = matrix(0, nrow = num.row, ncol = length(cnames))
###(iii) add the column names and turn into a data frame
colnames(Table.to.Show) = cnames
Table.to.Show = as.data.frame(Table.to.Show)
###(iv) put species names as well as the ranges into the data frame
temp.level = 0
temp.PNR = checkpnr(mymod$Model$`Full Data`)
for(n in 1:(length(mymod$Model) - 1)){# counter of pairs
for(i in 1:max.length[n]){# counter of replicate of pairs
for(j in 1:length(keep.ingradients)){# counter of ingradients
if(i == 1){
range.length.temp = length(mymod$Model[[n]][[j]]) + 1
Table.to.Show[(temp.level + i):(temp.level + max.length[n]),
is.range[j]] = c("Full", names(mymod$Model[[n]][[j]]),
rep(NA, max.length[n] - range.length.temp))
pair.PNR = temp.PNR$PNR[((!is.na(match(mymod$Pairs[n, 1],
temp.PNR$sp1_name))) &
(!is.na(match(mymod$Pairs[n, 2],
temp.PNR$sp2_name))))|
((!is.na(match(mymod$Pairs[n, 1],
temp.PNR$sp2_name))) &
(!is.na(match(mymod$Pairs[n, 1],
temp.PNR$sp2_name))))]
Table.to.Show[temp.level + i, is.range[j] + 1] = t(pair.PNR)
}else{# extract the model of a certain range
if(!is.na(Table.to.Show[temp.level + i, is.range[j]])){
temp.range.model = mymod$Model[[n]][[j]][[i - 1]]
temp.choice = c("Positive", "Negative", "Random")
temp.result = c(temp.range.model$positive, temp.range.model$negative,
temp.range.model$random)
Table.to.Show[temp.level + i,
is.range[j] + 1] = temp.choice[as.logical(temp.result)]
}else{
# Table.to.Show[temp.level + i, is.range[j] + 1] = NA
Table.to.Show[temp.level + i, is.range[j]:(is.range[j] + 1)] = c("", "")
}
}
}
Table.to.Show[temp.level + i, 1:2] = mymod$Pairs[n,]
if(collapse_row == "top" & i != 1){
Table.to.Show[temp.level + i, 1:2] = c("", "")
}
if(collapse_row == "bottom" & i != max.length[n]){
Table.to.Show[temp.level + i, 1:2] = c("", "")
}
}
temp.level = temp.level + max.length[n]
}
}
##(2) table without splits
else{
###(i) get the full model & also the PNR result
if(judge.splits){
Table.to.Show = checkpnr(mymod$Model$`Full Data`)[, c(1, 2, 4)]
}else{
Table.to.Show = checkpnr(mymod$Model)[, c(1, 2, 4)]
}
###(ii) and name the matrix
colnames(Table.to.Show) = c("Specie.One", "Specie.Two", "Cooccurence")
}
# show(Table.to.Show)
###########################################################################################
#3. print the significant table in fancy format
###########################################################################################
if(table.out != "stats"){
if(with.splits){
f1 = formattable(Table.to.Show, align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
area(col = is.range) ~
formatter("span", style = ~ style(color = "dimgrey",
font.weight = "bold")),
area(col = is.range + 1) ~
formatter("span", style = x ~
style(color = ifelse(x == "Positive", "seagreen",
ifelse(x == "Negative", "tomato",
"darkslategrey"))),
x ~ icontext(ifelse(x == "Positive" |
x == "Negative",
"star", ""), x))))
show(f1)
}else{
f1 = formattable(Table.to.Show, align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
area(col = 3:ncol(Table.to.Show)) ~
formatter("span", style = x ~
style(color = ifelse(x == "Positive", "seagreen",
ifelse(x == "Negative", "tomato",
"darkslategrey"))),
x ~ icontext(ifelse(x == "Positive" | x == "Negative",
"star", ""), x))))
show(f1)
}}
###########################################################################################
#4. create a stat table to be print out
###########################################################################################
##(1) stats table with splits
if(with.splits){
###(o) create a vector of column names
cnames = c("Specie.One", "Specie.Two", "Ingradients", "Range", "Sp1_Inc", "Sp2_Inc",
"Obs_Cooccur", "Prob_Cooccur", "Exp_Cooccur", "P_lt", "P_gt")
###(i) find the number of rows
link.ingradient = match(keep.ingradients, mymod$Used.Ingradients)
each.length = rep(NA, (length(mymod$Model) - 1) * length(keep.ingradients)) # length of each pair & each ingradient
temp.level = 0
for(n in 1:(length(mymod$Model) - 1)){# counter of pairs
for(m in 1:length(keep.ingradients)){# counter of ingradients
each.length[temp.level + m] = nrow(mymod$Stats[[link.ingradient[m]]][[n]])
}
temp.level = temp.level + length(keep.ingradients)
}
###(ii) create a matrix
Table.Stats = matrix(0, nrow = sum(each.length), ncol = length(cnames))
###(iii) add the column names and turn into a data frame
colnames(Table.Stats) = cnames
Table.Stats = as.data.frame(Table.Stats)
###(iv) put every detail into the data frame
current.level = 0
for(n in 1:(length(mymod$Model) - 1)){# counter of pairs
more.locate = NA
for(m in 1:length(keep.ingradients)){# counter of ingradients
temp.stats = mymod$Stats[[link.ingradient[m]]][[n]]
temp.length = nrow(temp.stats)
locate = (current.level + 1):(current.level + temp.length)
more.locate = c(more.locate, locate)
Table.Stats[locate, 4] = rownames(temp.stats)
Table.Stats[locate, 5:11] = temp.stats
Table.Stats[locate, 3] = rep(keep.ingradients[m], temp.length)
#show(locate)
if(collapse_row == "top"){
Table.Stats[locate[-1], 3] = rep("", (temp.length - 1))
}
if(collapse_row == "bottom"){
Table.Stats[locate[-temp.length], 3] = rep("", (temp.length - 1))
}
Table.Stats[locate, 1:2] = matrix(rep(mymod$Pairs[n, ], temp.length),
byrow = T, ncol = 2)
current.level = locate[length(locate)]
}
more.locate = more.locate[-1]
if(collapse_row == "top"){
Table.Stats[more.locate[-1], 1:2] = matrix(rep(c("", ""),
(length(more.locate) - 1)),
ncol = 2)
}
if(collapse_row == "bottom"){
Table.Stats[more.locate[-length(more.locate)], 1:2] =
matrix(rep(c("", ""),
(length(more.locate) - 1)),
ncol = 2)
}
}
}
##(2) stats table without splits
else{
###(i) get the result of the full model
if(judge.splits){
Table.Stats = mymod$Model$`Full Data`$results[, c(10:11, 3:9)]
}else{
Table.Stats = mymod$Model$results[, c(10:11, 3:9)]
}
###(ii) and re-name the matrix
colnames(Table.Stats) = c("Specie.One", "Specie.Two", "Sp1_Inc", "Sp2_Inc",
"Obs_Cooccur", "Prob_Cooccur", "Exp_Cooccur", "P_lt", "P_gt")
}
###########################################################################################
#5. print the stats table in fancy format
###########################################################################################
if(table.out != "significants"){
if(with.splits){
judge.trc = mymod$Model$`Full Data`$true_rand_classifier / 2
#full_stats = c("full", "prob", "obs")
if(full_stats == "prob"){
f2 = formattable(Table.Stats[, c(1:4, 7, 9:11)], align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Ingradients = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Range = formatter("span",
style = ~ style(color = "dimgrey",
font.weight = "bold")),
Obs_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Exp_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
P_lt = formatter("span", style = ~
style(color = ifelse(1 - P_gt < judge.trc,
"tomato",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_gt < judge.trc,
"star", ""), P_lt)),
P_gt = formatter("span", style = ~
style(color = ifelse(1 - P_lt < judge.trc,
"seagreen",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_lt < judge.trc,
"star", ""), P_gt))))
}else{
if(full_stats == "obs"){
f2 = formattable(Table.Stats[, 1:8], align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Ingradients = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Range = formatter("span",
style = ~ style(color = "dimgrey",
font.weight = "bold")),
Sp1_Inc = color_tile("gold", "gold4"),
Sp2_Inc = color_tile("gold", "gold4"),
Obs_Cooccur = color_tile("gold", "gold4"),
Prob_Cooccur = color_bar("darkorange")))
}else{
f2 = formattable(Table.Stats, align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Ingradients = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Range = formatter("span",
style = ~ style(color = "dimgrey",
font.weight = "bold")),
# Sp1_Inc = color_tile("gold", "gold4"),
# Sp2_Inc = color_tile("gold", "gold4"),
# Obs_Cooccur = color_tile("gold", "gold4"),
# Prob_Cooccur = color_bar("darkorange"),
# Exp_Cooccur = color_tile("gold", "gold4"),
Sp1_Inc = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Sp2_Inc = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Obs_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Prob_Cooccur = color_bar("seagreen"),
Exp_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
P_lt = formatter("span", style = ~
style(color = ifelse(1 - P_gt < judge.trc,
"tomato",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_gt < judge.trc,
"star", ""), P_lt)),
P_gt = formatter("span", style = ~
style(color = ifelse(1 - P_lt < judge.trc,
"seagreen",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_lt < judge.trc,
"star", ""), P_gt))))
}
}
show(f2)
}else{
judge.trc = ifelse(judge.splits,
mymod$Model$`Full Data`$true_rand_classifier / 2,
mymod$Model$true_rand_classifier / 2)
if(full_stats == "prob"){
f2 = formattable(Table.Stats[, c(1:2, 5, 7:9)], align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Obs_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Exp_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
P_lt = formatter("span", style = ~
style(color = ifelse(1 - P_gt < judge.trc,
"tomato",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_gt < judge.trc,
"star", ""), P_lt)),
P_gt = formatter("span", style = ~
style(color = ifelse(1 - P_lt < judge.trc,
"seagreen",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_lt < judge.trc,
"star", ""), P_gt))))
}else{
if(full_stats == "obs"){
f2 = formattable(Table.Stats[, 1:6], align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Sp1_Inc = color_tile("gold", "gold4"),
Sp2_Inc = color_tile("gold", "gold4"),
Obs_Cooccur = color_tile("gold", "gold4"),
Prob_Cooccur = color_bar("darkorange")))
}else{
f2 = formattable(Table.Stats, align = "c",
list(Specie.One = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
Specie.Two = formatter("span",
style = ~ style(color = "darkslategrey",
font.weight = "bold")),
# Sp1_Inc = color_tile("gold", "gold4"),
# Sp2_Inc = color_tile("gold", "gold4"),
# Obs_Cooccur = color_tile("gold", "gold4"),
# Prob_Cooccur = color_bar("darkorange"),
# Exp_Cooccur = color_tile("gold", "gold4"),
Sp1_Inc = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Sp2_Inc = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Obs_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
Prob_Cooccur = color_bar("seagreen"),
Exp_Cooccur = formatter("span",
style = ~ style(color = "black",
font.weight = "bold")),
P_lt = formatter("span", style = ~
style(color = ifelse(1 - P_gt < judge.trc,
"tomato",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_gt < judge.trc,
"star", ""), P_lt)),
P_gt = formatter("span", style = ~
style(color = ifelse(1 - P_lt < judge.trc,
"seagreen",
"darkslategrey"),
font.weight = "bold"),
~ icontext(ifelse(1 - P_lt < judge.trc,
"star", ""), P_gt))))
}
}
show(f2)
}}
###########################################################################################
#6. turn back on warnings
###########################################################################################
options(warn = oldw)
###########################################################################################
#7. return both tables
###########################################################################################
if(table.out == "stats") f1 = NA
if(table.out == "significants") f2 = NA
return(list(STATSTAB = Table.Stats, SIGNTAB = Table.to.Show,
STATSFT = f2, SIGNFT = f1))
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.