|
| 1 | +# This script extracts a standard dynamic network, as a sequence of static |
| 2 | +# graphs representing time slices. There is no aggregation here: a different |
| 3 | +# function allows extracting cumulative graphs. |
| 4 | +# |
| 5 | +# Vincent Labatut |
| 6 | +# 03/2023 |
| 7 | +# |
| 8 | +# setwd("~/eclipse/workspaces/Networks/NaNet") |
| 9 | +# setwd("C:/Users/Vincent/Eclipse/workspaces/Networks/NaNet") |
| 10 | +# source("src/dynamic/instant.R") |
| 11 | +############################################################################### |
| 12 | + |
| 13 | + |
| 14 | + |
| 15 | + |
| 16 | +############################################################################### |
| 17 | +# Extracts a dynamic network based on the specified scenes. |
| 18 | +# |
| 19 | +# inter.df: dataframe containing the pairwise interactions. |
| 20 | +# char.stats: list of characters with their attributes. |
| 21 | +# scene.chars: which character appears in which scene. |
| 22 | +# scene.stats: allows retrieving scene durations. |
| 23 | +# volume.stats: allows ordering volumes by publication date or story-wise. |
| 24 | +# filtered: whether characters should be filtered or not. |
| 25 | +# pub.order: whether to consider volumes in publication vs. story order. |
| 26 | +# narr.unit: narrative unit of the dynamic graph (scene, volume, arc). |
| 27 | +# |
| 28 | +# returns: a sequence of graphs corresponding to a dynamic graph. |
| 29 | +############################################################################### |
| 30 | +inst.graph.extraction <- function(inter.df, char.stats, scene.chars, scene.stats, volume.stats, filtered=FALSE, pub.order=TRUE, narr.unit=NA) |
| 31 | +{ |
| 32 | +# extract the graph |
| 33 | +tlog(2,"Extracting the scene sequence graph") |
| 34 | +gg <- extract.static.graph.scenes( |
| 35 | +inter.df=inter.df, |
| 36 | +char.stats=char.stats, |
| 37 | +volume.stats=volume.stats, |
| 38 | +scene.stats=scene.stats, scene.chars=scene.chars, |
| 39 | +ret.seq=TRUE, pub.order=pub.order |
| 40 | +) |
| 41 | + |
| 42 | +# possiby compute the filtered version |
| 43 | +if(filtered) |
| 44 | +{ tlog(2,"Filtering the characters") |
| 45 | +filt.names <- char.stats[char.stats[,COL_FILTER]=="Discard",COL_NAME] |
| 46 | +if(length(filt.names)==0) stop("Empty list of filtered characters") |
| 47 | +gg <- future_lapply(gg, function(g) delete_vertices(g, v=intersect(filt.names,V(g)$name))) |
| 48 | +} |
| 49 | + |
| 50 | +# possibly aggregate to handle the narrative unit |
| 51 | +res <- list() |
| 52 | +if(narr.unit!="scene") |
| 53 | +{ tlog(2,"Aggregating by ",narr.unit) |
| 54 | +prev.unit <- NA |
| 55 | +for(s in 1:length(gg)) |
| 56 | +{#tlog(4,"Processing scene ",s,"/",length(gg)) |
| 57 | + |
| 58 | +# retrieve current scene graph |
| 59 | +sc.g <- gg[[s]] |
| 60 | + |
| 61 | +# retrieve current narrative unit |
| 62 | +sc.id <- gg[[s]]$SceneId |
| 63 | +sc.idx <- which(scene.stats[,COL_SCENE_ID]==sc.id) |
| 64 | +if(narr.unit=="chapter") |
| 65 | +cur.unit <- scene.stats[sc.idx,COL_CHAPTER_ID] |
| 66 | +else if(narr.unit=="volume") |
| 67 | +cur.unit <- scene.stats[sc.idx,COL_VOLUME_ID] |
| 68 | +else if(narr.unit=="arc") |
| 69 | +cur.unit <- scene.stats[sc.idx,COL_ARC_ID] |
| 70 | +#tlog(4,"Current ",narr.unit,": ",cur.unit," (previous ",narr.unit,": ",prev.unit,")") |
| 71 | + |
| 72 | +# first graph of a narrative unit |
| 73 | +if(is.na(prev.unit) || prev.unit!=cur.unit) |
| 74 | +{# possibly remove isolates in previous graph |
| 75 | +if(!is.na(prev.unit)) |
| 76 | +{prev.g <- res[[length(res)]] |
| 77 | +prev.isolates <- which(degree(prev.g,mode="all")==0) |
| 78 | +prev.g <- delete_vertices(graph=prev.g, v=prev.isolates) |
| 79 | +res[[length(res)]] <- prev.g |
| 80 | +} |
| 81 | + |
| 82 | +# add current scene graph in the sequence |
| 83 | +sc.g$NarrUnit <- paste0(narr.unit,"_",cur.unit) |
| 84 | +res[[length(res)+1]] <- sc.g |
| 85 | +prev.unit <- cur.unit |
| 86 | +} |
| 87 | + |
| 88 | +# rest of the narrative unit |
| 89 | +else |
| 90 | +{prev.g <- res[[length(res)]] |
| 91 | + |
| 92 | +# add current edges to previous graph |
| 93 | +if(gsize(sc.g)>0) |
| 94 | +{el <- as_edgelist(graph=sc.g, names=TRUE) |
| 95 | +for(e in 1:nrow(el)) |
| 96 | +{#tlog(6,"e=",e," nrow(el)=",nrow(el)) |
| 97 | +# edge already exists: increment weights |
| 98 | +if(are_adjacent(graph=prev.g, v1=el[e,1], v2=el[e,2])) |
| 99 | +{idx <- get.edge.ids(graph=prev.g, vp=el[e,]) |
| 100 | +#tlog(6,"idx=",idx) |
| 101 | +E(prev.g)[idx]$Occurrences <- E(prev.g)[idx]$Occurrences + E(sc.g)$Occurrences[e] |
| 102 | +E(prev.g)[idx]$Duration <- E(prev.g)[idx]$Duration + E(sc.g)$Duration[e] |
| 103 | +} |
| 104 | +# otherwise: create new edge |
| 105 | +else |
| 106 | +prev.g <- add_edges(graph=prev.g, edges=el[e,], |
| 107 | +attr=list(Occurrences=E(sc.g)$Occurrences[e], Duration=E(sc.g)$Duration[e])) |
| 108 | +} |
| 109 | +} |
| 110 | + |
| 111 | +# update last graph in result sequence |
| 112 | +res[[length(res)]] <- prev.g |
| 113 | +} |
| 114 | +} |
| 115 | +# remove isolates in last graph |
| 116 | +last.g <- res[[length(res)]] |
| 117 | +last.isolates <- which(degree(last.g,mode="all")==0) |
| 118 | +last.g <- delete_vertices(graph=last.g, v=last.isolates) |
| 119 | +res[[length(res)]] <- last.g |
| 120 | +} |
| 121 | + |
| 122 | +# no aggregation needed for scenes, as it is the smallest narrative unit |
| 123 | +else |
| 124 | +{for(s in 1:length(gg)) |
| 125 | +{# get current graph |
| 126 | +sc.g <- gg[[s]] |
| 127 | +# add narrative unit attribute to graph |
| 128 | +cur.unit <- gg[[s]]$SceneId |
| 129 | +sc.g$NarrUnit <- paste0(narr.unit,"_",cur.unit) |
| 130 | +# add graph to list |
| 131 | +res[[length(res)+1]] <- sc.g |
| 132 | +} |
| 133 | +} |
| 134 | + |
| 135 | +# test: plot evolution of nbr of vertices |
| 136 | +#v.nbr <- sapply(res, gorder) |
| 137 | +#units <- 1:length(res) |
| 138 | +#x.labels <- sapply(res, function(g) g$NarrUnit) |
| 139 | +#plot(x=units, y=v.nbr, xaxt="n", xlab=paste0(narr.unit,"s"), ylab="Vertices", col="RED") |
| 140 | +#axis(side=1, at=units, labels=x.labels, las=2) |
| 141 | + |
| 142 | +return(res) |
| 143 | +} |
| 144 | + |
| 145 | + |
| 146 | + |
| 147 | + |
| 148 | +############################################################################### |
| 149 | +# Record a dynamic graph as a series of graphs. |
| 150 | +# |
| 151 | +# gs: list of igraph objects representing a dynamic graph. |
| 152 | +# filtered: whether the characters have been filtered or not. |
| 153 | +# pub.order: whether to consider volumes in publication vs. story order. |
| 154 | +# char.det: character detection mode ("implicit" or "explicit"). |
| 155 | +############################################################################### |
| 156 | +inst.write.graph <- function(gs, filtered, pub.order=TRUE, char.det=NA) |
| 157 | +{if(pub.order)# by publication order |
| 158 | +ord.fold <- "publication" |
| 159 | +else# by story order |
| 160 | +ord.fold <- "story" |
| 161 | + |
| 162 | +# retrieve narrative unit |
| 163 | +narr.unit <- strsplit(gs[[1]]$NarrUnit, split="_")[[1]][1] |
| 164 | + |
| 165 | +base.file <- get.path.data.graph(mode="scenes", char.det=char.det, net.type="instant", order=ord.fold, filtered=filtered, subfold=narr.unit, pref="inst") |
| 166 | +write.dynamic.graph(gs=gs, base.path=base.file) |
| 167 | +} |
| 168 | + |
| 169 | + |
| 170 | + |
| 171 | + |
| 172 | +############################################################################### |
| 173 | +# Read sequence of graphs representing a dynamic graph, based on a sequence of |
| 174 | +# graphml files, each one representing one step of the dynamic graph. |
| 175 | +# |
| 176 | +# filtered: whether the characters have been filtered or not. |
| 177 | +# remove.isolates: whether to remove isolates in each time slice. |
| 178 | +# pub.order: whether to consider volumes in publication vs. story order. |
| 179 | +# char.det: character detection mode ("implicit" or "explicit"). |
| 180 | +# narr.unit: narrative unit used to extract the dynamic network (scene, volume, etc.). |
| 181 | +# |
| 182 | +# returns: list of igraph objects representing a dynamic graph. |
| 183 | +############################################################################### |
| 184 | +inst.read.graph <- function(filtered, remove.isolates=TRUE, pub.order=TRUE, char.det=NA, narr.unit=NA) |
| 185 | +{if(pub.order)# by publication order |
| 186 | +ord.fold <- "publication" |
| 187 | +else# by story order |
| 188 | +ord.fold <- "story" |
| 189 | + |
| 190 | +base.file <- get.path.data.graph(mode="scenes", char.det=char.det, net.type="instant", order=ord.fold, filtered=filtered, subfold=narr.unit, pref="inst") |
| 191 | +gs <- read.dynamic.graph(base.file=base.file, remove.isolates=remove.isolates) |
| 192 | + |
| 193 | +return(gs) |
| 194 | +} |
0 commit comments