started revising post scripts

Author: vlabatut

src/post/description/_all_post.R

@@ -12,8 +12,8 @@
 
 
 source("src/post/description/avgdist_evol.R")
-#source("src/post/description/centr_clusters.R")
-#source("src/post/description/centr_vs_centr.R")
+source("src/post/description/centr_clusters.R")
+source("src/post/description/centr_vs_centr.R")
 #source("src/post/description/centr_vs_occ.R")
 #source("src/post/description/char_distr.R")
 #source("src/post/description/char_sim.R")

src/post/description/avgdist_evol.R

@@ -16,7 +16,7 @@ start.rec.log(text="AvgDistEvol")
 
 ###############################################################################
 # publication order vs. story order 
-pub.order <- TRUE
+pub.order <- TRUE			# TRUE=publication order, FALSE=story order
 
 tlog(0, "Evolution of the average distance over scenes: pub.order=",pub.order)
 
@@ -26,19 +26,20 @@ tlog(0, "Evolution of the average distance over scenes: pub.order=",pub.order)
 ###############################################################################
 # plots unfiltered and filtered figures as separate files
 
-# load corpus stats
-tlog(0, "Read corpus stats")
-data <- read.corpus.data()
-
-# get filtered characters
-filt.names <- data$char.stats[data$char.stats[,COL_FILTER]=="Discard",COL_NAME]
-if(length(filt.names)==0) stop("Empty list of filtered characters")
-
+## load corpus stats
+#tlog(0, "Read corpus stats")
+#data <- read.corpus.data()
+#
+## get filtered characters
+#filt.names <- data$char.stats[data$char.stats[,COL_FILTER]=="Discard",COL_NAME]
+#if(length(filt.names)==0) stop("Empty list of filtered characters")
+#
 # compute the sequence of scene-based graphs (possibly one for each scene)
 tlog(0, "Extract graph sequence")
 gs <- extract.static.graph.scenes(
 	inter.df=data$inter.df, 
 	char.stats=data$char.stats, 
+	scene.stats=data$scene.stats, scene.chars=data$scene.chars,
 	volume.stats=data$volume.stats, 
 	ret.seq=TRUE, pub.order=pub.order
 )
@@ -49,17 +50,19 @@ dist.vals <- list()
 order.txt <- if(pub.order) "publication" else "story"
 
 # compute average distance for each graph in the sequence
+tlog(0, "Compute average distances for unfiltered graphs")
 #print(any(sapply(gs, function(g) is_connected(g, mode="weak"))))	# check that each graph is connected
 g.orders[[1]] <- future_sapply(gs, gorder)
 dist.vals[[1]] <- future_sapply(gs, function(g) mean_distance(graph=g, directed=FALSE, unconnected=TRUE))
 
 # same for filtered graphs
+tlog(0, "Compute average distances for filtered graphs")
 gs.filt <- future_lapply(gs, function(g) delete_vertices(g, v=intersect(filt.names,V(g)$name)))
 g.orders[[2]] <- future_sapply(gs.filt, gorder)
 dist.vals[[2]] <- future_sapply(gs.filt, function(g) mean_distance(graph=g, directed=FALSE, unconnected=TRUE))
 
 # loop over unfiltered/filtered
-tlog(0, "Loop over unfiltered/filtered")
+tlog(0, "Loop over unfiltered/filtered graphs")
 natures <- c("unfiltered", "filtered")
 pal <- ATT_COLORS_FILT
 for(i in 1:2)
@@ -93,7 +96,7 @@ for(i in 1:2)
 	print(summary(fit))
 
 	# plot distance as a function of graph order
-	plot.file <- get.path.stats.topo(net.type="static", mode="scenes", meas.name=paste0(MEAS_DISTANCE,SFX_AVG), filtered=filt.txt, suf=paste0("evolution_",order.txt,"_lines"))
+	plot.file <- get.path.stats.topo(net.type="static", mode="scenes", meas.name=paste0(MEAS_DISTANCE,SFX_AVG), weights="none", filtered=filt.txt, suf=paste0("evolution_",order.txt,"_lines"))
 	tlog(2, "Plotting in file ",plot.file)
 	for(fformat in PLOT_FORMAT)
 	{	if(fformat==PLOT_FORMAT_PDF)
@@ -123,7 +126,7 @@ tlog(0, "Unfiltered/filtered loop complete")
 
 ###############################################################################
 # same thing, but plots both unfiltered and filtered figures in the same file
-plot.file <- get.path.stats.topo(net.type="static", mode="scenes", meas.name=paste0(MEAS_DISTANCE,SFX_AVG), filtered="both", suf=paste0("evolution_",order.txt,"_lines"))
+plot.file <- get.path.stats.topo(net.type="static", mode="scenes", meas.name=paste0(MEAS_DISTANCE,SFX_AVG), weights="none", filtered="both", suf=paste0("evolution_",order.txt,"_lines"))
 tlog(0, "Plotting both unfiltered and filtered results in file ",plot.file)
 
 # process all formats

src/post/description/centr_clusters.R

@@ -28,12 +28,13 @@ kept <- which(data$char.stats[,COL_FILTER]=="Keep")
 centr.names <- c(MEAS_DEGREE, MEAS_BETWEENNESS, MEAS_CLOSENESS, MEAS_EIGENCNTR)
 
 # get centrality values
-tlog(0, "Read centrality values")
+tlog(0, "Retrieve centrality values")
 vals.unf <- matrix(NA, nrow=nrow(data$char.stats), ncol=length(centr.names), dimnames=list(data$char.stats[,COL_NAME],centr.names))
 vals.flt <- matrix(NA, nrow=length(kept), ncol=length(centr.names), dimnames=list(data$char.stats[kept,COL_FILTER]=="Keep",centr.names))
 for(centr.name in centr.names)
-{		vals.unf[,centr.name] <- load.static.nodelink.stats.scenes(object="nodes", weights="occurrences", measure=centr.name, filtered=FALSE)
-		vals.flt[,centr.name] <- load.static.nodelink.stats.scenes(object="nodes", weights="occurrences", measure=centr.name, filtered=TRUE)
+{	tlog(2, "Centrality ",centr.name)
+	vals.unf[,centr.name] <- load.static.nodelink.stats.scenes(object="nodes", weights="none", measure=centr.name, filtered="unfiltered")
+	vals.flt[,centr.name] <- load.static.nodelink.stats.scenes(object="nodes", weights="none", measure=centr.name, filtered="filtered")
 }
 
 # filter NA values

src/post/description/centr_vs_centr.R

@@ -55,12 +55,12 @@ for(centr1.name in centr.names)
 	{	tlog(4, "Processing second centrality measure ",centr2.name)
 
 		# get centrality 1 values
-		centr1.vals.unf <- load.static.nodelink.stats.scenes(object="nodes", weights="occurrences", measure=centr1.name, filtered=FALSE)
-		centr1.vals.flt <- load.static.nodelink.stats.scenes(object="nodes", weights="occurrences", measure=centr1.name, filtered=TRUE)
+		centr1.vals.unf <- load.static.nodelink.stats.scenes(object="nodes", weights="none", measure=centr1.name, filtered="unfiltered")
+		centr1.vals.flt <- load.static.nodelink.stats.scenes(object="nodes", weights="none", measure=centr1.name, filtered="filtered")
 
 		# get centrality 2 values
-		centr2.vals.unf <- load.static.nodelink.stats.scenes(object="nodes", weights="occurrences", measure=centr2.name, filtered=FALSE)
-		centr2.vals.flt <- load.static.nodelink.stats.scenes(object="nodes", weights="occurrences", measure=centr2.name, filtered=TRUE)
+		centr2.vals.unf <- load.static.nodelink.stats.scenes(object="nodes", weights="none", measure=centr2.name, filtered="unfiltered")
+		centr2.vals.flt <- load.static.nodelink.stats.scenes(object="nodes", weights="none", measure=centr2.name, filtered="filtered")
 
 		#### handle unfiltered data
 		tlog(6,"Dealing with the unfiltered data")
@@ -71,7 +71,7 @@ for(centr1.name in centr.names)
 		centr1.vals.unf <- centr1.vals.unf[idx]
 		centr2.vals.unf <- centr2.vals.unf[idx]
 		corr.mat.unf.clean[centr1.name,centr2.name] <- cor(centr1.vals.unf, centr2.vals.unf, method="spearman")
-		tlog(8,"Spearman correlation before cleaning: ", corr.mat.unf.clean[centr1.name,centr2.name])
+		tlog(8,"Spearman correlation after cleaning: ", corr.mat.unf.clean[centr1.name,centr2.name])
 		avg.centr2.vals.unf <- sapply(1:max(centr2.vals.unf), function(d) mean(centr1.vals.unf[centr2.vals.unf==d]))
 
 #		# keep tail
@@ -101,7 +101,7 @@ for(centr1.name in centr.names)
 		col.sec <- combine.colors(col, "WHITE", transparency=20)
 		xlab <- NODE_MEASURES[[centr2.name]]$cname
 		ylab <- NODE_MEASURES[[centr1.name]]$cname
-		plot.file <- get.path.stats.topo(net.type="static", mode="scenes", meas.name=MEAS_MULTI_NODES, filtered="both", suf=paste0("centr_",centr2.name,"_vs_",centr1.name))
+		plot.file <- get.path.stats.topo(net.type="static", mode="scenes", meas.name=MEAS_MULTI_NODES, weights="none", filtered="both", suf=paste0("centr_",centr2.name,"_vs_",centr1.name))
 		tlog(8, "Plotting in file ",plot.file)
 		pdf(file=paste0(plot.file,PLOT_FORMAT_PDF), bg="white")
 		par(

src/post/description/char_sim.R

@@ -32,6 +32,8 @@ tlog(0,"Load data and network")
 tlog(2,"Reading previously computed corpus stats")
 data <- read.corpus.data()
 char.stats <- data$char.stats
+scene.stats <- data$scene.stats
+scene.chars <- data$scene.chars
 volume.stats <- data$volume.stats
 scene.stats <- data$scene.stats
 
@@ -61,6 +63,7 @@ if(narr.smooth)
 		inter.df=data$inter.df, 
 		char.stats=char.stats, 
 		volume.stats=volume.stats, 
+		scene.stats=scene.stats, scene.chars=scene.chars,
 		ret.seq=TRUE, pub.order=pub.order
 	)
 	# possibly set weights

src/post/description/partial_extr.R

@@ -43,6 +43,7 @@ idx1 <- 1:(idx-1)
 gs[[1]] <- extract.static.graph.scenes(
 	inter.df=data$inter.df[idx1,], 
 	char.stats=data$char.stats,
+	scene.stats=data$scene.stats, scene.chars=data$scene.chars,
 	volume.stats=data$volume.stats
 )
 
@@ -52,6 +53,7 @@ idx2 <- idx:nrow(data$inter.df)
 gs[[2]] <- extract.static.graph.scenes(
 	inter.df=data$inter.df[idx2,], 
 	char.stats=data$char.stats, 
+	scene.stats=data$scene.stats, scene.chars=data$scene.chars,
 	volume.stats=data$volume.stats 
 )
 

src/post/description/pref_attach.R

@@ -68,6 +68,7 @@ data <- read.corpus.data()
 gs.unf <- extract.static.graph.scenes(
 	inter.df=data$inter.df,
 	char.stats=data$char.stats, 
+	scene.stats=data$scene.stats, scene.chars=data$scene.chars,
 	volume.stats=data$volume.stats, 
 	ret.seq=TRUE, pub.order=TRUE	# TODO check that this parm is used in the rest of the graph (should be a main script param)
 )

src/static/extract_scene.R

@@ -19,6 +19,8 @@
 #
 # inter.df: dataframe containing the pairwise interactions.
 # char.stats: table describing all the characters occurring in the BD series.
+# scene.stats: table describing all the scenes constituting the BD series.
+# scene.chars: list of characters occurring in each scene.
 # volume.stats: table describing all the volumes constituting the BD series.
 # vol: volume of interest (optional, and ignored if arc is specififed or if ret.seq is TRUE).
 # arc: narrative arc of interest (optional, and ignored if ret.seq is TRUE).
@@ -30,7 +32,7 @@
 #		   - Duration: total duration (in number of panels).
 #		   If ret.set==TRUE, then the function returns a list of graphs.
 ###############################################################################
-extract.static.graph.scenes <- function(inter.df, char.stats, volume.stats, vol=NA, arc=NA, ret.seq=FALSE, pub.order=TRUE)
+extract.static.graph.scenes <- function(inter.df, char.stats, scene.stats, scene.chars, volume.stats, vol=NA, arc=NA, ret.seq=FALSE, pub.order=TRUE)
 {	tlog(2,"Extracting the scene-based static graph")
 	res <- list()
 	vname <- NA
@@ -48,28 +50,50 @@ extract.static.graph.scenes <- function(inter.df, char.stats, volume.stats, vol=
 	# possibly filter interactions
 	if(!is.na(arc))
 	{	is <- which(inter.df[,COL_ARC_ID]==arc)
+		scenes.ord <- which(scene.stats[,COL_ARC_ID]==arc)
 	}
 	else if(!is.na(vol))
 	{	vname <- paste0(vol,"_",volume.stats[vol,COL_VOLUME])
 		is <- which(inter.df[,COL_VOLUME_ID]==vol)
+		scenes.ord <- which(scene.stats[,COL_VOLUME_ID]==vol)
 	}
 	else
-	{	# order interactions by publication order
-		if(pub.order)
-			is <- 1:nrow(inter.df)
-		# or by story order
-		else
-		{	vol.ranks <- volume.stats[inter.df[,COL_VOLUME_ID],COL_RANK]
-			scene.ranks <- inter.df[,COL_SCENE_ID]
-			is <- order(vol.ranks, scene.ranks)
+	{	is <- 1:nrow(inter.df)
+		scenes.ord <- 1:nrow(scene.stats)
+	}
+	
+	# possibly sort scenes and interactions by story order
+	if(!pub.order)
+	{	is <- is[order(inter.df[is,COL_RANK])]
+		scenes.ord <- scenes.ord[order(scene.stats[scenes.ord,COL_RANK])]
+	}
+		
+	# possibly init the list with empty graphs or isolates
+	if(ret.seq)
+	{	#tlog(2,"Initializing the graph list")
+		s <- 1
+		while(scenes.ord[s]!=inter.df[is[1],COL_SCENE_ID])
+		{	tlog(4,"Processing s=",s," (scenes.ord[s]=",scenes.ord[s]," and inter.df[is[1],COL_SCENE_ID]=",inter.df[is[1],COL_SCENE_ID],") -- (length(scene.chars[[s]]=",length(scene.chars[[s]]),")")
+			if(length(scene.chars[[scenes.ord[s]]])==0)
+				g <- make_empty_graph(n=0, directed=FALSE)
+			else if(length(scene.chars[[scenes.ord[s]]])==1)
+			{	idx <- which(char.stats[,COL_NAME]==scene.chars[[scenes.ord[s]]])
+				g <- graph_from_data_frame(d=static.df, directed=FALSE, vertices=char.stats[idx,])
+			}
+			res[[s]] <- g
+			s <- s + 1
 		}
 	}
 
 	# build the edgelist by considering each line (i.e. interaction) in the dataframe
 	prev.scene <- NA
+	prev.scene.idx <- NA
+	tlog(2,"Building the edge list")
 	for(i in is)
 	{	# get the current scene id
 		cur.scene <- inter.df[i,COL_SCENE_ID]
+		cur.scene.idx <- which(scenes.ord==cur.scene)
+		#tlog(4,"Processing scene ",cur.scene," (",cur.scene.idx,"/",length(scenes.ord),")")
 
 		# get the characters
 		from.char <- inter.df[i,COL_CHAR_FROM]
@@ -98,9 +122,11 @@ extract.static.graph.scenes <- function(inter.df, char.stats, volume.stats, vol=
 		if(ret.seq)
 		{	# possibly copy previous graph
 			if(!is.na(prev.scene) && cur.scene!=prev.scene)
-			{	for(s in (prev.scene+1):(cur.scene-1))
-				{	g <- res[[s-1]]
-					g <- set_graph_attr(graph=g, name="Scene", value=s)
+			{	# possibly several times, to represent interaction-less scenes
+				for(s in (prev.scene.idx+1):(cur.scene.idx-1))
+				{	#tlog(6,"s=",s," scenes.ord[s-1]=",scenes.ord[s-1]," length(res)=",length(res))
+					g <- res[[s-1]]
+					g <- set_graph_attr(graph=g, name="SceneId", value=scene.stats[scenes.ord[s],COL_SCENE_ID])
 					res[[s]] <- g
 				}
 			}
@@ -109,10 +135,11 @@ extract.static.graph.scenes <- function(inter.df, char.stats, volume.stats, vol=
 			idx <- which(char.stats[,COL_NAME] %in% c(cbind(static.df[,COL_CHAR_FROM],static.df[,COL_CHAR_TO])))
 			g <- graph_from_data_frame(d=static.df, directed=FALSE, vertices=char.stats[idx,])
 			g$Scene <- cur.scene
-			res[[cur.scene]] <- g
+			res[[cur.scene.idx]] <- g
 		}
 
 		prev.scene <- cur.scene
+		prev.scene.idx <- cur.scene.idx
 	}
 
 	# set up result variable
@@ -236,12 +263,15 @@ extract.static.graphs.base <- function(data)
 	inter.df <- data$inter.df
 	page.stats <- data$page.stats
 	char.stats <- data$char.stats
+	scene.stats <- data$scene.stats
+	scene.chars <- data$scene.chars
 	volume.stats <- data$volume.stats
 
 	# extract the full scene-based static graph
 	g <- extract.static.graph.scenes(
 		inter.df=inter.df,
 		char.stats=char.stats,
+		scene.stats=scene.stats, scene.chars=scene.chars,
 		volume.stats=volume.stats
 	)
 	# record to file
@@ -270,6 +300,7 @@ extract.static.graphs.base <- function(data)
 		g <- extract.static.graph.scenes(
 			inter.df=inter.df,
 			char.stats=char.stats, 
+			scene.stats=scene.stats, scene.chars=scene.chars,
 			volume.stats=volume.stats, 
 			arc=a
 		)
@@ -297,6 +328,7 @@ extract.static.graphs.base <- function(data)
 		g <- extract.static.graph.scenes(
 			inter.df=data$inter.df,
 			char.stats=char.stats, 
+			scene.stats=scene.stats, scene.chars=scene.chars,
 			volume.stats=volume.stats, 
 			vol=v
 		)