#' Updater function for elasticizer: Conduct actor searches
#'
#' Updater function for elasticizer: Conduct actor searches
#' @param out Does not need to be defined explicitly! (is already parsed in the elasticizer function)
#' @param localhost Defaults to false. When true, connect to a local Elasticsearch instance on the default port (9200)
#' @param ids List of actor ids
#' @param prefix Regex containing prefixes that should be excluded from hits
#' @param postfix Regex containing postfixes that should be excluded from hits
#' @param identifier String used to mark highlights. Should be a lowercase string
#' @param udmodel The udpipe model used for parsing every hit
#' @param ver Short string (preferably a single word/sequence) indicating the version of the updated document (i.e. for a udpipe update this string might be 'udV2')
#' @param es_super Password for write access to ElasticSearch
#' @return As this is a nested function used within elasticizer, there is no return output
#' @export
#' @examples
#' actorizer(out, localhost = F, ids, type, prefix, postfix, identifier, udmodel, es_super)
actorizer <- function ( out , localhost = F , ids , type , prefix , postfix , identifier , udmodel , es_super , ver ) {
exceptionizer <- function ( id , ud , doc , markers , regex_identifier , prefix , postfix ) {
min <- min ( ud $ start [ud $ sentence_id == id ] )
max <- max ( ud $ end [ud $ sentence_id == id ] )
split <- markers [markers %in% seq ( min , max , 1 ) ]
max <- max + ( length ( split ) * nchar ( identifier ) )
sentence <- str_sub ( doc $ highlight , min , max )
if ( ! str_detect ( sentence , paste0 ( regex_identifier , postfix ) ) && ! str_detect ( sentence , paste0 ( prefix , regex_identifier ) ) ) {
return ( id )
} else {
return ( NULL )
}
}
sentencizer <- function ( row , out , ids , prefix , postfix , identifier , type ) {
print ( row )
### If no pre or postfixes, match *not nothing* i.e. anything
if ( is.na ( prefix ) || prefix == ' ' ) {
prefix = ' $^'
}
if ( is.na ( postfix ) || postfix == ' ' ) {
postfix = ' $^'
}
### Also needs fix for empty strings (non-NA)
err <- F
doc <- out [row , ]
ud <- doc $ `_source.ud` [ [1 ] ] %>%
select ( - one_of ( ' exists' ) ) %>% # Removing ud.exists variable
unnest ( ) %>%
mutate ( doc_id = doc $ `_id` )
# ud <- as.data.frame(udpipe(udmodel, x = doc$merged, parser = "none", doc_id = doc$`_id`))
markers <- doc $ markers [ [1 ] ] [ , ' start' ]
if ( length ( setdiff ( markers , ud $ start ) ) > 0 ) {
err <- T
ud <- ud %>%
group_by ( doc_id ) %>%
summarise (
sentence_id = list ( list ( as.integer ( 0 ) ) ) ,
sentence_start = list ( list ( 0 ) ) ,
sentence_end = list ( list ( 0 ) )
)
occurences <- 0
prominence <- 0
rel_first <- 0
return ( data.frame ( ud , actor_start = I ( list ( list ( markers ) ) ) , occ = occurences , prom = prominence , rel_first = rel_first , ids = I ( list ( list ( ids ) ) ) , err = err ) )
}
ud $ actor [ud $ start %in% markers ] <- T
sentence_count <- length ( unique ( ud $ sentence_id ) )
actor_sentences <- unique ( na.omit ( ud $ sentence_id [ud $ actor == T ] ) )
if ( type == " Party" ) {
sentence_ids <- lapply ( actor_sentences , exceptionizer , ud = ud , doc = doc , markers = markers , regex_identifier = regex_identifier , prefix = prefix , postfix = postfix )
} else {
sentence_ids <- actor_sentences
}
ud <- ud %>%
filter ( sentence_id %in% sentence_ids ) %>%
group_by ( sentence_id ) %>%
summarise (
sentence_start = as.integer ( min ( start ) ) ,
sentence_end = as.integer ( max ( end ) ) ,
doc_id = first ( doc_id )
) %>%
group_by ( doc_id ) %>%
summarise (
sentence_id = list ( list ( as.integer ( sentence_id ) ) ) ,
sentence_start = list ( list ( sentence_start ) ) ,
sentence_end = list ( list ( sentence_end ) )
)
occurences <- length ( unique ( ud $ sentence_id [ [1 ] ] [ [1 ] ] ) ) # Number of sentences in which actor occurs
prominence <- occurences / sentence_count # Relative prominence of actor in article (number of occurences/total # sentences)
rel_first <- 1 - ( ud $ sentence_id [ [1 ] ] [ [1 ] ] [1 ] / sentence_count ) # Relative position of first occurence at sentence level
return ( data.frame ( ud , actor_start = I ( list ( list ( markers ) ) ) , occ = occurences , prom = prominence , rel_first = rel_first , ids = I ( list ( list ( ids ) ) ) , err = err ) )
# ## The exception below is only valid for the UK, where the original UDPipe output misses a dot at the end of the article, but the actor output does not
# ## (UK output is older than actor output, should be updated)
# if (length(ud_org$sentence_id) == length(ud$sentence_id)-1) {
# ud <- ud[-length(ud$sentence_id),]
# }
# if (length(ud_org$sentence_id) == length(ud$sentence_id)) {
# ud <- bind_cols(ud_org, sentence = ud$sentence, token = ud$token, doc_id = ud$doc_id, actor = ud$actor)
# } else {
# err = T
# print(paste0('ud_org and ud_actor not the same length for id ', doc$`_id`))
# print(length(ud_org$sentence_id))
# print(length(ud$sentence_id))
# }
}
out <- mamlr ::: out_parser ( out , field = ' highlight' , clean = F )
# out$highlight <- out$merged
# out <- mamlr:::out_parser(out, field = '_source', clean = F)
offsetter <- function ( x ) {
return ( x - ( ( row ( x ) -1 ) * nchar ( identifier ) ) )
}
regex_identifier <- gsub ( " ([.|()\\^{}+$*?]|\\[|\\])" , " \\\\\\1" , identifier )
out $ markers <- lapply ( str_locate_all ( out $ merged , coll ( identifier ) ) , offsetter )
ids <- fromJSON ( ids )
updates <- bind_rows ( mclapply ( seq ( 1 , length ( out [ [1 ] ] ) , 1 ) , sentencizer , out = out , ids = ids , postfix = postfix , prefix = prefix , identifier = identifier , type = type , mc.cores = detectCores ( ) ) )
bulk <- apply ( updates , 1 , bulk_writer , varname = ' actorsDetail2' , type = ' add' , ver = ver )
bulk <- c ( bulk , apply ( updates [c ( 1 , 9 ) ] , 1 , bulk_writer , varname = ' actors2' , type = ' add' , ver = ver ) )
return ( elastic_update ( bulk , es_super = es_super , localhost = localhost ) )
}