Nothing
#' @export
print.LexChar <- function (x,file = NULL, sep = ";", dec=".",...)
{
if (!inherits(x, "LexChar"))
stop("x object must be LexChar class")
df.res <- data.frame(name = character(),
description = character(),
stringsAsFactors = FALSE)
if("CharWord" %in% names(x)) df.res[nrow(df.res)+1,] <- c("$CharWord", "Words characterizing the documents")
if("stats" %in% names(x)) df.res[nrow(df.res)+1,] <- c("$stats", "Association statistics of the lexical table")
if("CharDoc" %in% names(x)) df.res[nrow(df.res)+1,] <- c("$CharDoc", "Documents characterizing categories of aggregate table")
if("Proba" %in% names(x)) df.res[nrow(df.res)+1,] <- c("$Proba", "Threshold on the p-value used when selecting the characteristic words
(by default 0.05")
if(!is.null(x$quali$CharWord)) df.res[nrow(df.res)+1,] <-c("$quali$CharWord", "Words characterizing the qualitative variables and their categories")
if(!is.null(x$quali$stats)) df.res[nrow(df.res)+1,] <- c("$quali$stats", "Association statistics for vocabulary and qualitative variables")
if(!is.null(x$quali$CharDoc)) df.res[nrow(df.res)+1,] <-c("$quali$CharDoc", "Documents characterizing categories of aggregate table from qualitative variables and their categories")
if(!is.null(x$quanti$CharWord)) df.res[nrow(df.res)+1,] <- c("$quanti$CharWord", "Provides characteristic quantitative variables for each word")
if(!is.null(x$quanti$stats)) df.res[nrow(df.res)+1,] <- c("$quanti$stats", "Association statistics for vocabulary and quantitative variables")
df.res <- as.matrix(df.res)
index <- nrow(df.res)
res <- array("", c(index, 2), list(1:index, c("name", "description")))
for(i in 1:index) res[i,] <-df.res[i,]
cat("\n*The results are available in the following objects:\n\n")
print(res[c(1:index),])
sink.reset <- function(){
for(i in seq_len(sink.number())){sink()}}
sink.reset
if (is.null(file))
cat("(*) To obtain more detailed information use print to file (print.LexChar)")
else
{
sink(file)
fCharWord <- function(z) {
nobjects <- length(z)
cat("\n\nCHARACTERISTIC WORDS FOR EACH DOCUMENT\n(DETAILED INFORMATION)\n\n")
cat("\nOver_used_words are ordered from the most characteristic word to the less one\n")
cat("Infra_used_words are ordered from the most anti-characteristic word to the less one\n\n")
stit <- t(c("Word","Intern %","glob %","Intern freq","Glob freq","p.value", "v.test"))
for(i in 1:nobjects){
out1 <- c(names(z[i]), "Over_used_words")
out2 <- c(names(z[i]), "Infra_used_words")
# write.table(out1, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
temp <- z[[i]]
posic <- temp[,"v.test"]>0
out.over <- data.frame(temp[posic,,drop=FALSE])
out.infra <- data.frame(temp[!posic,,drop=FALSE])
if(nrow(out.over)>0){
write.table(out1, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(stit, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(out.over, quote=FALSE, sep = sep, col.names=FALSE, row.names=TRUE,dec=dec)
cat("\n")
}
if(nrow(out.infra)>0){
write.table(out2, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(stit, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(out.infra, quote=FALSE, sep = sep, col.names=FALSE, row.names=TRUE,dec=dec)
cat("\n")
}
}
}
fCharQuanti<- function(x) {
tac <- NULL
strcolnames<- c("GlobalAverage", "AverageWord","Differ.", "pvalue", "Word", "Variable")
for(i in 1:length(x)) {
t1<- as.data.frame(x[i,drop=FALSE])
t2 <- data.frame(t1,rep(names(x[i]),length(x[i])), rownames(t1))
colnames(t2) <- strcolnames
if(i==1) tac <- t2 else tac <- rbind(tac,t2)
SP <- split(tac,f=tac$Variable, drop=FALSE)
str.colnames<- c("Word", "GlobalAverage", "AverageWord","Differ.", "pvalue")
empty_list = structure(vector(mode = "list", length = length(SP)), names = names(SP))
for(i in 1:length(SP)) {
t1<- as.data.frame(SP[i,drop=FALSE])
t2.pos <- t1[t1[,3]>0, ,drop=FALSE]
t2.neg <- t1[t1[,3]<0, ,drop=FALSE]
if(nrow(t2.pos)>0) {
t2.pos <- t2.pos[order(t2.pos[,4]),,drop=FALSE]
rownames(t2.pos) <- paste0("P", c(1:nrow(t2.pos)))
t3.pos <- t2.pos[,c(5,1:4)]
colnames(t3.pos) <- str.colnames
empty_list[[i]]$posit <- t3.pos
}
if(nrow(t2.neg)>0) {
t2.neg <- t2.neg[order(t2.neg[,4]),,drop=FALSE]
rownames(t2.neg) <- paste0("N", c(1:nrow(t2.neg)))
t3.neg <- t2.neg[,c(5,1:4)]
colnames(t3.neg) <- str.colnames
# print(t3.neg)
empty_list[[i]]$negat <- t3.neg
}
} # End for
}
return(empty_list)
} # End fCharQuanti
################# Check CharWord
if(!is.null(x$CharWord)) {
fCharWord(x$CharWord)
nobjects <- length(x$CharWor)
cat("\n\nDOCUMENTS (OR AGGREGATE DOCS) RELATED WITH A WORD\n")
tw <- NULL
for(i in 1:nobjects){
tw <- c(tw,rownames(x$CharWord[[i]]))
}
tw <- paste(unique(tw))
tw <- sort(tw, decreasing = FALSE)
ntw <- length(tw)
for(i in 1:ntw){
vsearch <- tw[i]
vt_ <- NULL; posit <- NULL; negat <- NULL
for(j in 1:nobjects){
cat_ <- which(rownames(x$CharWord[[j]]) %in% vsearch)
if(length(cat_)>0){
vt <- x$CharWord[[j]][cat_,6]
if(vt>0) posit <- c(posit,sep,names(x$CharWord[j])) else
negat <- c(negat,sep,names(x$CharWord[j]))
}
}
cat("\n",vsearch)
if(length(posit)>0) cat("\n",sep, "Over", posit)
if(length(negat)>0) cat("\n",sep, "Infra", negat)
cat("\n")
}
}
fCharWord2 <- function(z,i) {
nobjects <- length(z)
# cat("\n\nCHARACTERISTIC WORDS FOR EACH DOCUMENT\n(DETAILED INFORMATION)\n\n")
# cat("\nOver_used_words are ordered from the most characteristic word to the less one\n")
# cat("Infra_used_words are ordered from the most anti-characteristic word to the less one\n\n")
stit <- t(c("Word","Intern %","glob %","Intern freq","Glob freq","p.value", "v.test"))
# for(i in 1:nobjects){
out1 <- c(names(z[i]), "Over_used_words")
out2 <- c(names(z[i]), "Infra_used_words")
# write.table(out1, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
temp <- z[[i]]
posic <- temp[,"v.test"]>0
out.over <- data.frame(temp[posic,,drop=FALSE])
out.infra <- data.frame(temp[!posic,,drop=FALSE])
if(nrow(out.over)>0){
write.table(out1, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(stit, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(out.over, quote=FALSE, sep = sep, col.names=FALSE, row.names=TRUE,dec=dec)
cat("\n")
}
if(nrow(out.infra)>0){
write.table(out2, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(stit, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(out.infra, quote=FALSE, sep = sep, col.names=FALSE, row.names=TRUE,dec=dec)
cat("\n")
}
# }
}
################# Check of stats exists
if(!is.null(x$stats)) {
cat("\n\n\nSTATISTIC ASSOCIATION LEXICAL TABLE DOCUMENTS (OR AGGREGATE DOCS) AND VOCABULARY\n\n")
stit <- t(c("",colnames(x$stat)))
write.table(stit, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(x$stats, quote=FALSE, sep = sep, col.names=FALSE, row.names=TRUE,dec=dec)
}
################# Check CharDoc
if(!is.null(x$CharDoc)) {
cat("\n\n\nCHARACTERISTIC SOURCE-DOCUMENTS\n")
# print(object$CharDoc)
stit <- t(names(x$CharDoc[[1]]))
for(i in 1:length(x$CharDoc)){
cat("\n")
write.table(names(x$CharDoc[i]), quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(stit, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(x$CharDoc[[i]][1:3], quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
}
}
########### Qualitative contextual variables
if(!is.null(x$quali$stats)){
cat("\n\nASSOCIATION STATISTICS OF AGGREGATE CONTEXTUAL QUALITATIVE TABLE\n")
stit <- t(c("",colnames(x$quali$stats)))
write.table(stit, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(x$quali$stats, quote=FALSE, sep = sep, col.names=FALSE, row.names=TRUE,dec=dec)
} # End Vocab$quali$CharWord$stats
if(!is.null(x$quali$CharWord)){
for(i in 1:length(x$quali$CharWord)) {
cat("\n\nCharacteristic of aggregate-documents for qualitative variable: ", names(x$quali$CharWord[i]), "\n")
cat("=====================================================================================")
fCharWord2(x$quali$CharWord,i)
}
################# Check CharDoc
if(!is.null(x$quali$CharDoc)) {
cat("\n\n\nCHARACTERISTIC SOURCE-DOCUMENTS\n")
# print(object$CharDoc)
stit <- t(names(x$quali$CharDoc[[1]]))
for(i in 1:length(x$quali$CharDoc)){
cat("\n")
write.table(names(x$quali$CharDoc[i]), quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(stit, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(x$quali$CharDoc[[i]][1:3], quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
}
}
} # End CharWord
########### Quantitative contextual variables
if(!is.null(x$quanti$stats)){
cat("\nRELATIONSHIPS BETWEEN VOCABULARY AND CONTEXTUAL QUANTITATIVE VARIABLES\n")
cat("\nStatistics for quantitative variables")
cat("\n-------------------------------------\n")
stit <- t(c("",colnames(x$quanti$stats)))
write.table(stit, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(x$quanti$stats, quote=FALSE, sep = sep, col.names=FALSE, row.names=TRUE,dec=dec)
# print(object$quanti$CharWord)
res.quanti <- fCharQuanti(x$quanti$CharWord)
num.var.quanti <- length(res.quanti)
stit<- t(c("Word", "GlobalAverage", "AverageWord","Differ.", "pvalue"))
for(i in 1:num.var.quanti) {
str.name.var <- rownames(x$quanti$stats)[i]
cat("\n\nCharacteristic quantitative variables for each word. Variable:", str.name.var)
cat("\n----------------------------------------------------------------------------------------\n")
if(length(res.quanti[[str.name.var]]$posit)>0) {
cat(paste0("\n$",str.name.var, "$posit\n"))
write.table(stit, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(res.quanti[[str.name.var]]$posit, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
}
if(length(res.quanti[[str.name.var]]$negat)>0) {
cat(paste0("\n$",str.name.var, "$negat\n"))
write.table(stit, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
write.table(res.quanti[[str.name.var]]$negat, quote=FALSE, sep = sep, col.names=FALSE, row.names=FALSE,dec=dec)
}
}
} # End quanti
cat("\n------- Proba threshold -----------\n")
cat(paste("Proba=", x$Proba))
sink()
} # End sink file
if (!is.null(file)) cat(paste("(*) All the results are in file", file))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.