├── _pkgdown.yml ├── vignettes ├── .gitignore └── evently-profiling-users.Rmd ├── .gitignore ├── data └── auspol.rda ├── docs ├── reference │ ├── Rplot001.png │ ├── plot_event_series-1.png │ ├── evently.html │ ├── auspol.html │ ├── prepare_tmp_file.html │ ├── set_tmp_folder.html │ ├── plot_kernel_function.html │ ├── fits_dist_matrix.html │ ├── get_a1.html │ ├── get_branching_factor.html │ ├── setup_ampl.html │ ├── get_model_intensity_at.html │ ├── get_viral_score.html │ ├── predict_final_popularity.html │ └── generate_features.html ├── pkgdown.yml ├── articles │ ├── evently-profiling-users_files │ │ ├── figure-html │ │ │ └── unnamed-chunk-4-1.png │ │ └── accessible-code-block-0.0.1 │ │ │ └── empty-anchor.js │ └── index.html ├── link.svg ├── bootstrap-toc.css ├── docsearch.js ├── pkgdown.js ├── bootstrap-toc.js ├── authors.html └── 404.html ├── tests ├── testthat.R └── testthat │ ├── test_plot.R │ ├── test_tweet.R │ ├── test_feature.R │ ├── test_simulate.R │ ├── test_model.R │ └── test_fit.R ├── man ├── evently.Rd ├── set_tmp_folder.Rd ├── prepare_tmp_file.Rd ├── plot_kernel_function.Rd ├── fits_dist_matrix.Rd ├── get_a1.Rd ├── setup_ampl.Rd ├── get_branching_factor.Rd ├── auspol.Rd ├── melt_snowflake.Rd ├── get_model_intensity_at.Rd ├── get_viral_score.Rd ├── generate_features.Rd ├── predict_final_popularity.Rd ├── plot_event_series.Rd ├── generate_user_magnitude.Rd ├── group_fit_series.Rd ├── get_hawkes_neg_likelihood_value.Rd ├── new_hawkes.Rd ├── generate_series.Rd ├── parse_raw_tweets_to_cascades.Rd └── fit_series.Rd ├── R ├── package.R ├── data.R ├── CONST.R ├── utils.R ├── SEISMIC.R ├── setup.R ├── ampl_output.R ├── snowflake.R ├── plot.R ├── EXP.R ├── PLN.R ├── EXPN.R ├── MULTI.R ├── PL.R ├── model.R └── fit.R ├── evently.Rproj ├── DESCRIPTION ├── LICENSE.txt ├── NAMESPACE └── .github └── workflows └── main.yml /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | destination: docs 2 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | .Rbuildignore 6 | -------------------------------------------------------------------------------- /data/auspol.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/behavioral-ds/evently/HEAD/data/auspol.rda -------------------------------------------------------------------------------- /docs/reference/Rplot001.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/behavioral-ds/evently/HEAD/docs/reference/Rplot001.png -------------------------------------------------------------------------------- /docs/reference/plot_event_series-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/behavioral-ds/evently/HEAD/docs/reference/plot_event_series-1.png -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(evently) 3 | if (Sys.which('ampl') == '') setup_ampl(Sys.getenv('HOME')) 4 | 5 | test_check("evently") 6 | -------------------------------------------------------------------------------- /docs/pkgdown.yml: -------------------------------------------------------------------------------- 1 | pandoc: 2.7.3 2 | pkgdown: 1.6.1 3 | pkgdown_sha: ~ 4 | articles: 5 | evently-profiling-users: evently-profiling-users.html 6 | last_built: 2021-01-30T00:11Z 7 | 8 | -------------------------------------------------------------------------------- /docs/articles/evently-profiling-users_files/figure-html/unnamed-chunk-4-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/behavioral-ds/evently/HEAD/docs/articles/evently-profiling-users_files/figure-html/unnamed-chunk-4-1.png -------------------------------------------------------------------------------- /tests/testthat/test_plot.R: -------------------------------------------------------------------------------- 1 | context('Test plotting functions') 2 | 3 | test_that('plot_kernel_function works', { 4 | model <- new_hawkes(par = c(K = 0.9, theta = 1), model_type = 'EXP') 5 | expect_s3_class(plot_kernel_function(fitted_models = list(model) ), 'ggplot') 6 | }) 7 | -------------------------------------------------------------------------------- /man/evently.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/package.R 3 | \docType{package} 4 | \name{evently} 5 | \alias{evently} 6 | \title{Fitting Hawkes processes with AMPL} 7 | \description{ 8 | To learn more about evently, start with the vignettes: 9 | `browseVignettes(package = "evently")` 10 | } 11 | -------------------------------------------------------------------------------- /R/package.R: -------------------------------------------------------------------------------- 1 | #' Fitting Hawkes processes with AMPL 2 | #' 3 | #' @description To learn more about evently, start with the vignettes: 4 | #' `browseVignettes(package = "evently")` 5 | #' @docType package 6 | #' @name evently 7 | NULL 8 | 9 | .globals <- new.env(parent = emptyenv()) 10 | .globals$execution <- sprintf('export PATH=$PATH:%s; ampl', Sys.getenv('AMPL_PATH')) 11 | .globals$tmp <- '/tmp' 12 | utils::globalVariables('.data') 13 | -------------------------------------------------------------------------------- /man/set_tmp_folder.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ampl.R 3 | \name{set_tmp_folder} 4 | \alias{set_tmp_folder} 5 | \title{Set up the folder for placing temporary files, defaults to /tmp} 6 | \usage{ 7 | set_tmp_folder(path) 8 | } 9 | \arguments{ 10 | \item{path}{A string of path to the folder where you would like to place temporary files} 11 | } 12 | \description{ 13 | Set up the folder for placing temporary files, defaults to /tmp 14 | } 15 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | #' `#auspol` hash tagged retweet diffusions 2 | #' 3 | #' A dataset containing retweet event diffusions relating to tweets hash tagged with `auspol` 4 | #' 5 | #' @format A list of 3333 data frames with three columns: 6 | #' \describe{ 7 | #' \item{time}{Relative retweet times w.r.t the initial tweet} 8 | #' \item{magnitude}{The number of followers a corresponding Twitter user has} 9 | #' \item{user}{An anonymized Twitter user id who created the tweet/retweet} 10 | #' } 11 | "auspol" 12 | -------------------------------------------------------------------------------- /man/prepare_tmp_file.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ampl.R 3 | \name{prepare_tmp_file} 4 | \alias{prepare_tmp_file} 5 | \title{Prepare the temporary auxilixry files for AMPL} 6 | \usage{ 7 | prepare_tmp_file(type) 8 | } 9 | \arguments{ 10 | \item{type}{One of "mod" (AMPL model file), "dat" (AMPL data file), 11 | "run" (AMPL run file) and "res" (file hosts AMPL runned output)} 12 | } 13 | \description{ 14 | Prepare the temporary auxilixry files for AMPL 15 | } 16 | -------------------------------------------------------------------------------- /man/plot_kernel_function.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.R 3 | \name{plot_kernel_function} 4 | \alias{plot_kernel_function} 5 | \title{Plot the kernel functions of Hawkes processes} 6 | \usage{ 7 | plot_kernel_function(fitted_models) 8 | } 9 | \arguments{ 10 | \item{fitted_models}{A list of fitted model objects to plot the kernel functions} 11 | } 12 | \value{ 13 | A ggplot object 14 | } 15 | \description{ 16 | Plot the kernel functions of Hawkes processes 17 | } 18 | -------------------------------------------------------------------------------- /tests/testthat/test_tweet.R: -------------------------------------------------------------------------------- 1 | context('Extract cascades from raw tweet json objects') 2 | 3 | test_that('Cascades can be extracted from raw tweets', { 4 | # The jsonl file needs to be replaced with the true tweet ids 5 | # datas <- parse_raw_tweets_to_cascades(system.file('extdata', 'tweets_anonymized.jsonl', package = 'evently')) 6 | # for (data in datas) { 7 | # expect_s3_class(data, 'data.frame') 8 | # } 9 | # expect_s3_class(fit_series(datas, model_type = 'mPL', cores = 1, observation_time = Inf), 'hawkes') 10 | }) 11 | -------------------------------------------------------------------------------- /evently.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageCheckArgs: --no-build-vignettes 22 | PackageRoxygenize: rd,collate,namespace 23 | -------------------------------------------------------------------------------- /man/fits_dist_matrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/feature.R 3 | \name{fits_dist_matrix} 4 | \alias{fits_dist_matrix} 5 | \title{Given a list of grouped fits, compute a distance matrix} 6 | \usage{ 7 | fits_dist_matrix(group_fits) 8 | } 9 | \arguments{ 10 | \item{group_fits}{A list of grouped fits returned by {group_fit_series}} 11 | } 12 | \value{ 13 | A dist matrix of pairwise distances between each group-fit 14 | } 15 | \description{ 16 | Given a list of grouped fits, compute a distance matrix 17 | } 18 | -------------------------------------------------------------------------------- /man/get_a1.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/model.R 3 | \name{get_a1} 4 | \alias{get_a1} 5 | \title{Calculating the expected size of first level of descendants} 6 | \usage{ 7 | get_a1(model) 8 | } 9 | \arguments{ 10 | \item{model}{A model object provides data, model_type, observation_time 11 | and model parameters} 12 | } 13 | \value{ 14 | a vector of the expected sizes of first level of descendants of the 15 | given cascades 16 | } 17 | \description{ 18 | Calculating the expected size of first level of descendants 19 | } 20 | -------------------------------------------------------------------------------- /tests/testthat/test_feature.R: -------------------------------------------------------------------------------- 1 | context('Extract diffusion features from cascades') 2 | 3 | test_that('fit on a list of cascades individually', { 4 | data <- list(data.frame(time = c(0, 1), magnitude = c(1, 1)), 5 | data.frame(time = c(0, 2), magnitude = c(1, 1))) 6 | for (i in seq(5)) { 7 | data <- c(data, data) 8 | } 9 | data <- c(data, list(data.frame(time = c(0, 2), magnitude = c(1, 1)))) 10 | names(data) <- c(rep('1', 32), rep('2', 32), '3') 11 | group_fits <- group_fit_series(data = data) 12 | 13 | expect_s3_class(group_fits, 'hawkes.group.fits') 14 | }) 15 | -------------------------------------------------------------------------------- /man/setup_ampl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ampl.R 3 | \name{setup_ampl} 4 | \alias{setup_ampl} 5 | \title{Set up the AMPL environment by downloading an AMPL demo version and the compiled 6 | ipopt binary. Only supports UNIX compatible OSs.} 7 | \usage{ 8 | setup_ampl(ampl_path) 9 | } 10 | \arguments{ 11 | \item{ampl_path}{The path where the AMPL folder will be placed} 12 | } 13 | \description{ 14 | Set up the AMPL environment by downloading an AMPL demo version and the compiled 15 | ipopt binary. Only supports UNIX compatible OSs. 16 | } 17 | -------------------------------------------------------------------------------- /man/get_branching_factor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/model.R 3 | \name{get_branching_factor} 4 | \alias{get_branching_factor} 5 | \title{Branching factor is the expected number of events generated 6 | by a single event.} 7 | \usage{ 8 | get_branching_factor(model) 9 | } 10 | \arguments{ 11 | \item{model}{A model object for computing the branching factor.} 12 | } 13 | \value{ 14 | A single number, the branching factor of the given model 15 | } 16 | \description{ 17 | Branching factor is the expected number of events generated 18 | by a single event. 19 | } 20 | -------------------------------------------------------------------------------- /man/auspol.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{auspol} 5 | \alias{auspol} 6 | \title{`#auspol` hash tagged retweet diffusions} 7 | \format{ 8 | A list of 3333 data frames with three columns: 9 | \describe{ 10 | \item{time}{Relative retweet times w.r.t the initial tweet} 11 | \item{magnitude}{The number of followers a corresponding Twitter user has} 12 | \item{user}{An anonymized Twitter user id who created the tweet/retweet} 13 | } 14 | } 15 | \usage{ 16 | auspol 17 | } 18 | \description{ 19 | A dataset containing retweet event diffusions relating to tweets hash tagged with `auspol` 20 | } 21 | \keyword{datasets} 22 | -------------------------------------------------------------------------------- /R/CONST.R: -------------------------------------------------------------------------------- 1 | # this script implements methods for the background rate type: constant, i.e. a homogeneous poisson 2 | 3 | get_param_names.hawkes_CONST <- function(model) { 4 | 'lambda' 5 | } 6 | 7 | get_ampl_likelihood.hawkes_CONST <- function(model) { 8 | stop('Not implemented yet!') 9 | } 10 | 11 | get_ampl_constraints.hawkes_CONST <- function(model) { 12 | '' 13 | } 14 | 15 | generate_random_points.hawkes_CONST <- function(model) { 16 | data.frame(lambda = c(stats::runif(8, min = .Machine$double.eps, max = 300), 17 | NA, Inf)) 18 | } 19 | 20 | get_lower_bound.hawkes_CONST <- function(model) { 21 | c(lambda = 1e-100) 22 | } 23 | 24 | get_upper_bound.hawkes_CONST <- function(model) { 25 | c(lambda = 1e6) 26 | } 27 | -------------------------------------------------------------------------------- /man/melt_snowflake.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/snowflake.R 3 | \name{melt_snowflake} 4 | \alias{melt_snowflake} 5 | \title{Inversely transform a Twitter id back to its components (timestamp, datacentre id, 6 | worker id and sequence id).} 7 | \usage{ 8 | melt_snowflake(snowflake_id, twepoch = bit64::as.integer64("1288834974657")) 9 | } 10 | \arguments{ 11 | \item{snowflake_id}{a list of Twitter ids} 12 | 13 | \item{twepoch}{time epoch. Defaults to 1288834974657} 14 | } 15 | \value{ 16 | A list of timestamp, datacentre id, worker id and sequence id 17 | } 18 | \description{ 19 | Inversely transform a Twitter id back to its components (timestamp, datacentre id, 20 | worker id and sequence id). 21 | } 22 | -------------------------------------------------------------------------------- /man/get_model_intensity_at.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/model.R 3 | \name{get_model_intensity_at} 4 | \alias{get_model_intensity_at} 5 | \title{Compute the intensity value of a given model at time t} 6 | \usage{ 7 | get_model_intensity_at(model, t, cascade_index = 1) 8 | } 9 | \arguments{ 10 | \item{model}{A model object for computing the intensity value} 11 | 12 | \item{t}{The given time to compute the intensity} 13 | 14 | \item{cascade_index}{Determine which cascade in the list of cascades to compute, defaults to 1} 15 | } 16 | \value{ 17 | A single number, the intensity value of the given model evaluated at t 18 | } 19 | \description{ 20 | Compute the intensity value of a given model at time t 21 | } 22 | -------------------------------------------------------------------------------- /docs/articles/evently-profiling-users_files/accessible-code-block-0.0.1/empty-anchor.js: -------------------------------------------------------------------------------- 1 | // Hide empty tag within highlighted CodeBlock for screen reader accessibility (see https://github.com/jgm/pandoc/issues/6352#issuecomment-626106786) --> 2 | // v0.0.1 3 | // Written by JooYoung Seo (jooyoung@psu.edu) and Atsushi Yasumoto on June 1st, 2020. 4 | 5 | document.addEventListener('DOMContentLoaded', function() { 6 | const codeList = document.getElementsByClassName("sourceCode"); 7 | for (var i = 0; i < codeList.length; i++) { 8 | var linkList = codeList[i].getElementsByTagName('a'); 9 | for (var j = 0; j < linkList.length; j++) { 10 | if (linkList[j].innerHTML === "") { 11 | linkList[j].setAttribute('aria-hidden', 'true'); 12 | } 13 | } 14 | } 15 | }); 16 | -------------------------------------------------------------------------------- /docs/link.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 5 | 8 | 12 | 13 | -------------------------------------------------------------------------------- /man/get_viral_score.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/model.R 3 | \name{get_viral_score} 4 | \alias{get_viral_score} 5 | \title{Viral score is the total reaction of the system to a single promotion, 6 | i.e. the expected cascade size started by a single event of magnitude} 7 | \usage{ 8 | get_viral_score(model, m_0 = NULL) 9 | } 10 | \arguments{ 11 | \item{model}{A model object for computing the branching factor.} 12 | 13 | \item{m_0}{The magnitude of the initial post for computing its viral score. 14 | The first magnitude value in model$data[[1]] will be used if not provided.} 15 | } 16 | \value{ 17 | A single number, the viral score of the given model 18 | } 19 | \description{ 20 | Viral score is the total reaction of the system to a single promotion, 21 | i.e. the expected cascade size started by a single event of magnitude 22 | } 23 | -------------------------------------------------------------------------------- /man/generate_features.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/feature.R 3 | \name{generate_features} 4 | \alias{generate_features} 5 | \title{Given a list of group-fits produced by 'group_fit_series', this function generates features 6 | for each group-fit by summarizing the fitted parameters.} 7 | \usage{ 8 | generate_features(list_fits, data = FALSE) 9 | } 10 | \arguments{ 11 | \item{list_fits}{A list of group fits returned by {group_fit_series}} 12 | 13 | \item{data}{A indicator decides if the data features should be included or not.} 14 | } 15 | \value{ 16 | A data frame of features for each group. If features are all -1, it means all the 17 | fits of the group are NAs 18 | } 19 | \description{ 20 | Given a list of group-fits produced by 'group_fit_series', this function generates features 21 | for each group-fit by summarizing the fitted parameters. 22 | } 23 | -------------------------------------------------------------------------------- /man/predict_final_popularity.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/model.R 3 | \name{predict_final_popularity} 4 | \alias{predict_final_popularity} 5 | \title{Predict the final popularity (event count) of give histories and 6 | its model parameters.} 7 | \usage{ 8 | predict_final_popularity(model, data = NULL, observation_time = NULL) 9 | } 10 | \arguments{ 11 | \item{model}{A model object provides data, model_type, observation_time 12 | and model parameters} 13 | 14 | \item{data}{A given cascade whose final popularity will be predicted} 15 | 16 | \item{observation_time}{The observation time of the given cascade} 17 | } 18 | \value{ 19 | a vector of predicted final popularities whose length is the same 20 | as the number of cascades in the provided model object 21 | } 22 | \description{ 23 | Predict the final popularity (event count) of give histories and 24 | its model parameters. 25 | } 26 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: evently 2 | Type: Package 3 | Title: Fit Hawkes and HawkesN Processes with AMPL and Ipopt 4 | Version: 0.3.0 5 | Authors@R: c( 6 | person("Quyu", "Kong", email = "quyu.kong@anu.edu.au", role = c("aut", "cre")), 7 | person("Marian-Andrei", "Rizoiu", email = "marian-andrei.rizoiu@uts.edu.au", role = c("aut")) 8 | ) 9 | Maintainer: Quyu Kong 10 | Description: This package is designed for simulating and fitting the Hawkes processes and the HawkesN processes with several options of kernel functions. 11 | License: CC BY-NC 4.0 12 | Encoding: UTF-8 13 | VignetteBuilder: knitr 14 | LazyData: true 15 | RoxygenNote: 7.1.1 16 | Depends: 17 | R (>= 3.5) 18 | Suggests: 19 | testthat, 20 | covr, 21 | devtools, 22 | jsonlite, 23 | rmarkdown, 24 | knitr, 25 | ggplot2, 26 | tsne, 27 | seismic, 28 | data.table, 29 | bit64, 30 | poweRlaw, 31 | purrr, 32 | glue, 33 | Hmisc 34 | -------------------------------------------------------------------------------- /man/plot_event_series.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.R 3 | \name{plot_event_series} 4 | \alias{plot_event_series} 5 | \title{Plot a Hawkes process and its intensity function} 6 | \usage{ 7 | plot_event_series(model, cascade = NULL, cascade_index = 1) 8 | } 9 | \arguments{ 10 | \item{model}{A model object where data, model_type and par are required} 11 | 12 | \item{cascade}{This cascade data.frame will be used if provided} 13 | 14 | \item{cascade_index}{Determine which cascade in the list of cascades to plot 15 | default to the first cascade} 16 | } 17 | \value{ 18 | A ggplot object 19 | } 20 | \description{ 21 | Plot a Hawkes process and its intensity function 22 | } 23 | \examples{ 24 | par <- c(K = 0.95, theta = 1) 25 | data <- generate_series(model_type = 'EXP', 26 | par = par, 27 | sim_no = 1, Tmax = Inf) 28 | plot_event_series(new_hawkes(model_type = 'EXP', 29 | par = par, 30 | data = data)) 31 | } 32 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2016-present George Cushen 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /man/generate_user_magnitude.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulation.R 3 | \name{generate_user_magnitude} 4 | \alias{generate_user_magnitude} 5 | \title{Function for sampling from the powerlaw distribution of user influence 6 | it is the equivalent of the Richter-Gutenberg distribution in the Helmstetter model 7 | the powerlaw distribution was determined from the twitter data, from the #retweets 8 | alpha = 2.016, xmin = 1. Draw n values} 9 | \usage{ 10 | generate_user_magnitude(n, alpha = 2.016, mmin = 1) 11 | } 12 | \arguments{ 13 | \item{n}{The number of samples to be generated} 14 | 15 | \item{alpha}{Powerlaw distribution parameters} 16 | 17 | \item{mmin}{Powerlaw distribution parameters} 18 | } 19 | \value{ 20 | A single number, a random user magnitude 21 | } 22 | \description{ 23 | Function for sampling from the powerlaw distribution of user influence 24 | it is the equivalent of the Richter-Gutenberg distribution in the Helmstetter model 25 | the powerlaw distribution was determined from the twitter data, from the #retweets 26 | alpha = 2.016, xmin = 1. Draw n values 27 | } 28 | \examples{ 29 | generate_user_magnitude(n = 1) 30 | } 31 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | # some utility functions 2 | 3 | check_required_packages <- function(pkg_name) { 4 | pkg_name_to_install <- Filter(function(p) !requireNamespace(p, quietly = TRUE), pkg_name) 5 | if (length(pkg_name_to_install) > 0) { 6 | cat(sprintf("package(s) %s is required, do you want to install them now?", paste(pkg_name_to_install, collapse = ','))) 7 | if (interactive()) { 8 | installation_choice <- menu(c('yes', 'no')) 9 | if (installation_choice == 1) { 10 | utils::install.packages(pkg_name_to_install) 11 | } else { 12 | stop(sprintf("package(s) %s is required. \nPlease run `install.packages(c(%s))` to use this functionality.", 13 | paste(pkg_name_to_install, collapse = ','), paste(sprintf('"%s"', pkg_name_to_install), collapse = ', ')), 14 | call. = FALSE) 15 | } 16 | } else { 17 | stop(sprintf("package(s) %s is required. \nPlease run `install.packages(c(%s))` to use this functionality.", 18 | paste(pkg_name_to_install, collapse = ','), paste(sprintf('"%s"', pkg_name_to_install), collapse = ', ')), 19 | call. = FALSE) 20 | } 21 | } 22 | for (pkg in pkg_name) suppressMessages(library(pkg, character.only = TRUE)) 23 | } 24 | -------------------------------------------------------------------------------- /man/group_fit_series.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/feature.R 3 | \name{group_fit_series} 4 | \alias{group_fit_series} 5 | \title{Given a list of cascades, this function fits each cascade individually by calling [fit_series]. 6 | If the given cascades are in a named list, the names will be regarded as groups and the result will be reformatted as a list of 7 | group fits.} 8 | \usage{ 9 | group_fit_series(data, cores = 1, ...) 10 | } 11 | \arguments{ 12 | \item{data}{A (named) list of data.frame(s) where each data.frame is an event cascade with 13 | event tims and event magnitudes (optional). The list names (if present) will be used for grouping cascades with same names.} 14 | 15 | \item{cores}{The number of cores used for parallel fitting, defaults to 1 (non-parallel)} 16 | 17 | \item{...}{Check the available arguments of {fit_series}} 18 | } 19 | \value{ 20 | A list of model obejcts where each object fits on an invidual cascade in data 21 | } 22 | \description{ 23 | Given a list of cascades, this function fits each cascade individually by calling [fit_series]. 24 | If the given cascades are in a named list, the names will be regarded as groups and the result will be reformatted as a list of 25 | group fits. 26 | } 27 | -------------------------------------------------------------------------------- /R/SEISMIC.R: -------------------------------------------------------------------------------- 1 | # implementation of a common benchmark SEISMIC as a model 2 | 3 | fit_series_by_model.hawkes_SEISMIC <- function(model, cores, init_pars, parallel_type, .init_no, ...) { 4 | return(model) 5 | } 6 | 7 | get_param_names.hawkes_SEISMIC <- function(model) { 8 | '' 9 | } 10 | 11 | #' @export 12 | predict_final_popularity.hawkes_SEISMIC <- function(model, data = NULL, observation_time = NULL) { 13 | if (!is.null(data) && !is.null(observation_time)) { 14 | model$data <- if (is.data.frame(data)) list(data) else data 15 | model$observation_time <- observation_time 16 | } 17 | check_required_packages('seismic') 18 | library(seismic) 19 | sum(sapply(seq_along(model$data), function(i) { 20 | cascade <- model$data[[i]] 21 | observation_time <- if (length(model$observation_time) == length(model$data)) model$observation_time[[i]] else model$observation_time 22 | if (!('magnitude' %in% names(cascade))) stop('User magnitudes are required for SEISMIC!') 23 | infectiousness <- get.infectiousness(cascade$time, cascade$magnitude, observation_time) 24 | # add 1 here as seismic prediction doesn't take the initial tweet into account 25 | pred.cascade(observation_time, infectiousness$infectiousness, cascade$time, cascade$magnitude, n.star = 100)[1, 1] + 1 26 | })) 27 | } 28 | -------------------------------------------------------------------------------- /R/setup.R: -------------------------------------------------------------------------------- 1 | # ************************************************* 2 | # Setup 3 | # ************************************************* 4 | 5 | #' @importFrom utils menu 6 | .onAttach <- function(libname, pkgname) { 7 | if (Sys.getenv('AMPL_PATH') != '' || Sys.which('ampl') != '') { 8 | .globals$execution <- sprintf('export PATH=$PATH:%s; ampl', Sys.getenv('AMPL_PATH')) 9 | } else { 10 | packageStartupMessage("\n********************************************************") 11 | packageStartupMessage(" This package requires AMPL and ipopt") 12 | packageStartupMessage(" But they are not in your PATH environment.") 13 | packageStartupMessage(" Please specify its binary folder path in ~/.Renviron") 14 | packageStartupMessage(" Please also make sure the ipopt binary is in the ") 15 | packageStartupMessage(" same folder.") 16 | packageStartupMessage("********************************************************\n") 17 | packageStartupMessage('It seems AMPL is not found in your PATH environment, do you want to install it now?') 18 | if (interactive()) { 19 | installation_choice <- menu(c('yes', 'no')) 20 | if (installation_choice == 1) { 21 | ampl_path <- readline(prompt = paste0('Enter the path where AMPL should be place [', Sys.getenv('HOME'), ']: ')) 22 | setup_ampl(ampl_path) 23 | } else { 24 | warning('AMPL is missing! You might not be able to fit models.') 25 | } 26 | } else { 27 | warning('AMPL is missing! You might not be able to fit models.') 28 | } 29 | } 30 | } 31 | -------------------------------------------------------------------------------- /man/get_hawkes_neg_likelihood_value.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fit.R 3 | \name{get_hawkes_neg_likelihood_value} 4 | \alias{get_hawkes_neg_likelihood_value} 5 | \title{Compute the negative log-likelihood values of a given model on a list of given 6 | event cascades.} 7 | \usage{ 8 | get_hawkes_neg_likelihood_value( 9 | model, 10 | ..., 11 | par, 12 | data, 13 | model_type, 14 | observation_time 15 | ) 16 | } 17 | \arguments{ 18 | \item{model}{An object of a specific model class where the `data` and the `par` fields 19 | are required.} 20 | 21 | \item{...}{Further arguments passed to ampl} 22 | 23 | \item{par}{Hawkes model parameters} 24 | 25 | \item{data}{A list of data.frames of event cascades} 26 | 27 | \item{model_type}{The Hawkes model type} 28 | 29 | \item{observation_time}{The observation time of the given event cascades} 30 | } 31 | \value{ 32 | A single number, the negative log-likelihood of the given model on data 33 | } 34 | \description{ 35 | Compute the negative log-likelihood values of a given model on a list of given 36 | event cascades. 37 | } 38 | \examples{ 39 | \dontrun{ 40 | data <- generate_series(model_type = 'EXP', 41 | par = c(K = 0.9, theta = 1), 42 | sim_no = 10, Tmax = Inf) 43 | fitted <- fit_series(data, 'EXP', observation_time = Inf) 44 | data_test <- generate_series(model_type = 'EXP', 45 | par = c(K = 0.9, theta = 1), 46 | sim_no = 10, Tmax = Inf) 47 | get_hawkes_neg_likelihood_value(fitted, data = data_test) 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /R/ampl_output.R: -------------------------------------------------------------------------------- 1 | ampl_output_from_r <- function(names, var, type) { 2 | name <- paste(names, collapse = ' ') 3 | output_string_head <- paste0(ifelse(length(names) == 1, "param ", "param: "), 4 | name, ":= ") 5 | # based on the class of given var 6 | if (type == 'atomic') { 7 | output_string_tail <- var 8 | } else if (type == 'vector') { 9 | output_string_tail <- paste(seq_along(var), var, collapse = ' ') 10 | } else if (type == 'data.frame') { 11 | tmp_string_array <- rep(NA, times = nrow(var) * (ncol(var) + 1)) 12 | k <- 1 13 | for (i in seq(nrow(var))) { 14 | tmp_string_array[k] <- '\n' 15 | for (j in seq(ncol(var))) { 16 | tmp_string_array[k+j] <- var[i, j] 17 | } 18 | k <- k + ncol(var) + 1 19 | } 20 | output_string_tail <- paste0(tmp_string_array, collapse = ' ') 21 | } else { 22 | stop('Unkown type to output as ampl data file!') 23 | } 24 | 25 | # paste together 26 | paste0(output_string_head, output_string_tail, ';\n') 27 | } 28 | 29 | output_dat <- function(model, file) { 30 | if (missing(file)) { 31 | file <- prepare_tmp_file(type = 'dat') 32 | } 33 | # allow model-specific data output 34 | declarations <- get_ampl_data_output(model) 35 | output_string <- paste0(declarations, collapse = '') 36 | write(output_string, file = file) 37 | return(file) 38 | } 39 | 40 | output_mod <- function(model, file) { 41 | if (missing(file)) { 42 | file <- prepare_tmp_file(type = 'mod') 43 | } 44 | # allow model-specific model output 45 | declarations <- get_ampl_model_output(model) 46 | output <- paste0(declarations, collapse = '') 47 | write(output, file = file) 48 | return(file) 49 | } 50 | -------------------------------------------------------------------------------- /vignettes/evently-profiling-users.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Profiling Twitter users with diffusions" 3 | author: "Quyu Kong" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Profiling Twitter users with diffusions} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | ```{r setup, include = FALSE} 13 | library(evently) 14 | library(ggplot2) 15 | library(tsne) 16 | knitr::opts_chunk$set( 17 | collapse = TRUE, 18 | comment = "#>" 19 | ) 20 | ``` 21 | 22 | This vignette gives a tutorial on profiling Twitter users with their initiated diffusions via modeling methods provided by `evently`. 23 | We use the dataset `auspol` shipped with `evently` in this task. It is a list of data frames (`r length(auspol)` in total) where each data frame represents a diffusion cascade. For each cascade, three fields are presented: `time` is the retweeting time relative to the original tweet (i.e., the first event); `user` is the corresponding Twitter user of the event; `magnitude` is the number of followers the Twitter user has. 24 | 25 | ```{r} 26 | head(auspol, n = 3) 27 | ``` 28 | 29 | 30 | ```{r, eval=F} 31 | names(auspol) <- sapply(auspol, function(data) data$user[[1]]) 32 | auspol_group_fits_by_user <- group_fit_series(data = auspol, model_type = 'mPL', observation_times = Inf, cores = 10) 33 | 34 | head(auspol_group_fits_by_user, n = 3) 35 | ``` 36 | 37 | ```{r, eval=F} 38 | # keep only users with more than 5 cascades 39 | auspol_group_fits_by_user <- Filter(function(x) length(x) >= 5, auspol_group_fits_by_user) 40 | dist_matrix <- fits_dist_matrix(auspol_group_fits_by_user) 41 | 42 | positions <- tsne(dist_matrix, k = 2) 43 | ``` 44 | 45 | 46 | ```{r, eval=F} 47 | ggplot(as.data.frame(positions), aes(V1, V2)) + 48 | geom_point() + 49 | theme_void() 50 | ``` 51 | 52 | -------------------------------------------------------------------------------- /man/new_hawkes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/hawkes.R 3 | \name{new_hawkes} 4 | \alias{new_hawkes} 5 | \title{Create a new hawkes model with given arguments} 6 | \usage{ 7 | new_hawkes( 8 | model_type, 9 | par = NULL, 10 | data = NULL, 11 | init_par = NULL, 12 | observation_time = NULL, 13 | lower_bound = NULL, 14 | upper_bound = NULL, 15 | model_vars = NULL, 16 | limit_event = NULL 17 | ) 18 | } 19 | \arguments{ 20 | \item{model_type}{A string indicates the model tyep, e.g. EXP for a Hawkes process 21 | with an exponential kernel} 22 | 23 | \item{par}{A named vector denotes the model parameters where the names are model 24 | parameters and the values are the corresponding parameter values} 25 | 26 | \item{data}{A list of data.frame(s) where each data.frame is an event cascade with event 27 | tims and event magnitudes (optional)} 28 | 29 | \item{init_par}{Initial parameter values used in fitting} 30 | 31 | \item{observation_time}{The event cascades observation time. It is assumed that all cascades in data 32 | are observed until a common time.} 33 | 34 | \item{lower_bound}{Model parameter lower bounds. A named vector where names are model parameters and 35 | values are the lowest possible values.} 36 | 37 | \item{upper_bound}{Model parameter upper bounds. A named vector where names are model parameters and 38 | values are the largest possible values.} 39 | 40 | \item{model_vars}{A named list of extra variables provided to hawkes objects} 41 | 42 | \item{limit_event}{choose how to optimize the computation by reducing the number of events added in log-likelihood functions.} 43 | } 44 | \value{ 45 | A model object with class [hawkes] and [hawkes_`model_type`] where `model_type` is replaced 46 | by the given model_type 47 | } 48 | \description{ 49 | Create a new hawkes model with given arguments 50 | } 51 | \examples{ 52 | data <- list(data.frame(time = c(0, 0.5, 1))) 53 | new_hawkes(model_type = 'EXP', par = c(K = 0.9, theta = 1), 54 | data = data, observation_time = Inf) 55 | } 56 | -------------------------------------------------------------------------------- /docs/bootstrap-toc.css: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | 6 | /* modified from https://github.com/twbs/bootstrap/blob/94b4076dd2efba9af71f0b18d4ee4b163aa9e0dd/docs/assets/css/src/docs.css#L548-L601 */ 7 | 8 | /* All levels of nav */ 9 | nav[data-toggle='toc'] .nav > li > a { 10 | display: block; 11 | padding: 4px 20px; 12 | font-size: 13px; 13 | font-weight: 500; 14 | color: #767676; 15 | } 16 | nav[data-toggle='toc'] .nav > li > a:hover, 17 | nav[data-toggle='toc'] .nav > li > a:focus { 18 | padding-left: 19px; 19 | color: #563d7c; 20 | text-decoration: none; 21 | background-color: transparent; 22 | border-left: 1px solid #563d7c; 23 | } 24 | nav[data-toggle='toc'] .nav > .active > a, 25 | nav[data-toggle='toc'] .nav > .active:hover > a, 26 | nav[data-toggle='toc'] .nav > .active:focus > a { 27 | padding-left: 18px; 28 | font-weight: bold; 29 | color: #563d7c; 30 | background-color: transparent; 31 | border-left: 2px solid #563d7c; 32 | } 33 | 34 | /* Nav: second level (shown on .active) */ 35 | nav[data-toggle='toc'] .nav .nav { 36 | display: none; /* Hide by default, but at >768px, show it */ 37 | padding-bottom: 10px; 38 | } 39 | nav[data-toggle='toc'] .nav .nav > li > a { 40 | padding-top: 1px; 41 | padding-bottom: 1px; 42 | padding-left: 30px; 43 | font-size: 12px; 44 | font-weight: normal; 45 | } 46 | nav[data-toggle='toc'] .nav .nav > li > a:hover, 47 | nav[data-toggle='toc'] .nav .nav > li > a:focus { 48 | padding-left: 29px; 49 | } 50 | nav[data-toggle='toc'] .nav .nav > .active > a, 51 | nav[data-toggle='toc'] .nav .nav > .active:hover > a, 52 | nav[data-toggle='toc'] .nav .nav > .active:focus > a { 53 | padding-left: 28px; 54 | font-weight: 500; 55 | } 56 | 57 | /* from https://github.com/twbs/bootstrap/blob/e38f066d8c203c3e032da0ff23cd2d6098ee2dd6/docs/assets/css/src/docs.css#L631-L634 */ 58 | nav[data-toggle='toc'] .nav > .active > ul { 59 | display: block; 60 | } 61 | -------------------------------------------------------------------------------- /man/generate_series.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulation.R 3 | \name{generate_series} 4 | \alias{generate_series} 5 | \title{Main function to generate a Hawkes process sequence. It allows intermediary 6 | saves and continuing a stopped simulation. Creates a CSV file with two 7 | columns, each row is an event: (magnitude, time)} 8 | \usage{ 9 | generate_series( 10 | model, 11 | par, 12 | model_type, 13 | sim_no = 1, 14 | cores = 1, 15 | Tmax = Inf, 16 | maxEvents = NULL, 17 | M = NULL, 18 | tol = 1e-05, 19 | return_as_object = F, 20 | init_history = NULL 21 | ) 22 | } 23 | \arguments{ 24 | \item{model}{A model class object with par and model_type presented. par and 25 | model_type are not requird once this is given} 26 | 27 | \item{par}{A named vector of model parameters, K, alpha, beta, mmin, c, theta - parameters of the Hawkes kernel} 28 | 29 | \item{model_type}{Model type} 30 | 31 | \item{sim_no}{The number of simulated cascades} 32 | 33 | \item{cores}{The number of cores (processes) used for simulation} 34 | 35 | \item{Tmax}{Maximum time of simulation.} 36 | 37 | \item{maxEvents}{Maximum number of events to be simulated.} 38 | 39 | \item{M}{Magnitude of the initial event} 40 | 41 | \item{tol}{Simulation stops when intensity smaller than tol.} 42 | 43 | \item{return_as_object}{wether return the cascades within a model object} 44 | 45 | \item{init_history}{If given, the simulation will start after the last 46 | event in the given init_history} 47 | } 48 | \value{ 49 | A list of data.frames where each data.frame is a simulated event 50 | cascade with the given model by default. Or a model object with the data.frames 51 | if return_as_object is True 52 | } 53 | \description{ 54 | Main function to generate a Hawkes process sequence. It allows intermediary 55 | saves and continuing a stopped simulation. Creates a CSV file with two 56 | columns, each row is an event: (magnitude, time) 57 | } 58 | \examples{ 59 | generate_series(model_type = 'EXP', 60 | par = c(K = 0.9, theta = 1), 61 | sim_no = 10, Tmax = Inf) 62 | } 63 | -------------------------------------------------------------------------------- /docs/docsearch.js: -------------------------------------------------------------------------------- 1 | $(function() { 2 | 3 | // register a handler to move the focus to the search bar 4 | // upon pressing shift + "/" (i.e. "?") 5 | $(document).on('keydown', function(e) { 6 | if (e.shiftKey && e.keyCode == 191) { 7 | e.preventDefault(); 8 | $("#search-input").focus(); 9 | } 10 | }); 11 | 12 | $(document).ready(function() { 13 | // do keyword highlighting 14 | /* modified from https://jsfiddle.net/julmot/bL6bb5oo/ */ 15 | var mark = function() { 16 | 17 | var referrer = document.URL ; 18 | var paramKey = "q" ; 19 | 20 | if (referrer.indexOf("?") !== -1) { 21 | var qs = referrer.substr(referrer.indexOf('?') + 1); 22 | var qs_noanchor = qs.split('#')[0]; 23 | var qsa = qs_noanchor.split('&'); 24 | var keyword = ""; 25 | 26 | for (var i = 0; i < qsa.length; i++) { 27 | var currentParam = qsa[i].split('='); 28 | 29 | if (currentParam.length !== 2) { 30 | continue; 31 | } 32 | 33 | if (currentParam[0] == paramKey) { 34 | keyword = decodeURIComponent(currentParam[1].replace(/\+/g, "%20")); 35 | } 36 | } 37 | 38 | if (keyword !== "") { 39 | $(".contents").unmark({ 40 | done: function() { 41 | $(".contents").mark(keyword); 42 | } 43 | }); 44 | } 45 | } 46 | }; 47 | 48 | mark(); 49 | }); 50 | }); 51 | 52 | /* Search term highlighting ------------------------------*/ 53 | 54 | function matchedWords(hit) { 55 | var words = []; 56 | 57 | var hierarchy = hit._highlightResult.hierarchy; 58 | // loop to fetch from lvl0, lvl1, etc. 59 | for (var idx in hierarchy) { 60 | words = words.concat(hierarchy[idx].matchedWords); 61 | } 62 | 63 | var content = hit._highlightResult.content; 64 | if (content) { 65 | words = words.concat(content.matchedWords); 66 | } 67 | 68 | // return unique words 69 | var words_uniq = [...new Set(words)]; 70 | return words_uniq; 71 | } 72 | 73 | function updateHitURL(hit) { 74 | 75 | var words = matchedWords(hit); 76 | var url = ""; 77 | 78 | if (hit.anchor) { 79 | url = hit.url_without_anchor + '?q=' + escape(words.join(" ")) + '#' + hit.anchor; 80 | } else { 81 | url = hit.url + '?q=' + escape(words.join(" ")); 82 | } 83 | 84 | return url; 85 | } 86 | -------------------------------------------------------------------------------- /man/parse_raw_tweets_to_cascades.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tweet.R 3 | \name{parse_raw_tweets_to_cascades} 4 | \alias{parse_raw_tweets_to_cascades} 5 | \title{This function extracts cascades from a given jsonl file where each line is a tweet 6 | json object. Please refer to the Twitter developer documentation: 7 | https://developer.twitter.com/en/docs/tweets/data-dictionary/overview/tweet-object} 8 | \usage{ 9 | parse_raw_tweets_to_cascades( 10 | paths, 11 | batch = 1e+05, 12 | cores = 1, 13 | output_path = NULL, 14 | keep_user = F, 15 | keep_absolute_time = F, 16 | keep_text = F, 17 | keep_retweet_count = F, 18 | progress = T, 19 | return_as_list = T, 20 | save_temp = F, 21 | keep_temp_files = T, 22 | api_version = 1 23 | ) 24 | } 25 | \arguments{ 26 | \item{paths}{Full file paths to the tweets jsonl files} 27 | 28 | \item{batch}{Number of tweets to be read for processing at each iteration, choose 29 | the best number for your memory load. Defaults to at most 10000 tweets each iteration.} 30 | 31 | \item{cores}{Number of cores to be used for processing each batch in parallel.} 32 | 33 | \item{output_path}{If provided, the index.csv and data.csv files which define the cascaddes 34 | will be generated. In index.csv, each row is a cascade where events can be obtained from data.csv 35 | by corresponding indics (start_ind to end_ind). Defaults to NULL.} 36 | 37 | \item{keep_user}{Twitter user ids will be kept.} 38 | 39 | \item{keep_absolute_time}{Keep the absolute tweeting times.} 40 | 41 | \item{keep_text}{Keep the tweet text.} 42 | 43 | \item{keep_retweet_count}{Keep the retweet_count field.} 44 | 45 | \item{progress}{The progress will be reported if set to True (default)} 46 | 47 | \item{return_as_list}{If true then a list of cascades (data.frames) will be returned.} 48 | 49 | \item{save_temp}{If temporary files should be generated while processing. Processing can be resumed on failures.} 50 | 51 | \item{keep_temp_files}{If temporary files should be kept after index and data files generated.} 52 | 53 | \item{api_version}{Version of Twitter API used for collecting the tweets.} 54 | } 55 | \value{ 56 | If return_as_list is TRUE then a list of data.frames where each data.frame is a retweet cascade. 57 | Otherwise there will be no return. 58 | } 59 | \description{ 60 | This function extracts cascades from a given jsonl file where each line is a tweet 61 | json object. Please refer to the Twitter developer documentation: 62 | https://developer.twitter.com/en/docs/tweets/data-dictionary/overview/tweet-object 63 | } 64 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(as.character,hawkes_model_type) 4 | S3method(get_a1,default) 5 | S3method(get_a1,hawkes_EXP) 6 | S3method(get_a1,hawkes_EXPN) 7 | S3method(get_a1,hawkes_PL) 8 | S3method(get_a1,hawkes_PLN) 9 | S3method(get_a1,hawkes_mEXP) 10 | S3method(get_a1,hawkes_mEXPN) 11 | S3method(get_a1,hawkes_mPL) 12 | S3method(get_a1,hawkes_mPLN) 13 | S3method(get_branching_factor,default) 14 | S3method(get_branching_factor,hawkes_EXP) 15 | S3method(get_branching_factor,hawkes_EXPN) 16 | S3method(get_branching_factor,hawkes_PL) 17 | S3method(get_branching_factor,hawkes_PLN) 18 | S3method(get_branching_factor,hawkes_mEXP) 19 | S3method(get_branching_factor,hawkes_mEXPN) 20 | S3method(get_branching_factor,hawkes_mPL) 21 | S3method(get_branching_factor,hawkes_mPLN) 22 | S3method(get_model_intensity_at,default) 23 | S3method(get_model_intensity_at,hawkes_EXP) 24 | S3method(get_model_intensity_at,hawkes_EXPN) 25 | S3method(get_model_intensity_at,hawkes_PL) 26 | S3method(get_model_intensity_at,hawkes_PLN) 27 | S3method(get_model_intensity_at,hawkes_mEXP) 28 | S3method(get_model_intensity_at,hawkes_mEXPN) 29 | S3method(get_model_intensity_at,hawkes_mPL) 30 | S3method(get_model_intensity_at,hawkes_mPLN) 31 | S3method(get_viral_score,default) 32 | S3method(get_viral_score,hawkes) 33 | S3method(predict_final_popularity,default) 34 | S3method(predict_final_popularity,hawkes) 35 | S3method(predict_final_popularity,hawkes_EXP) 36 | S3method(predict_final_popularity,hawkes_EXPN) 37 | S3method(predict_final_popularity,hawkes_PL) 38 | S3method(predict_final_popularity,hawkes_PLN) 39 | S3method(predict_final_popularity,hawkes_SEISMIC) 40 | S3method(predict_final_popularity,hawkes_mEXP) 41 | S3method(predict_final_popularity,hawkes_mEXPN) 42 | S3method(predict_final_popularity,hawkes_mPL) 43 | S3method(predict_final_popularity,hawkes_mPLN) 44 | S3method(print,hawkes) 45 | S3method(print,hawkes.group.fits) 46 | export(fit_series) 47 | export(fits_dist_matrix) 48 | export(generate_features) 49 | export(generate_series) 50 | export(generate_user_magnitude) 51 | export(get_a1) 52 | export(get_branching_factor) 53 | export(get_hawkes_neg_likelihood_value) 54 | export(get_model_intensity_at) 55 | export(get_viral_score) 56 | export(group_fit_series) 57 | export(melt_snowflake) 58 | export(new_hawkes) 59 | export(parse_raw_tweets_to_cascades) 60 | export(plot_event_series) 61 | export(plot_kernel_function) 62 | export(predict_final_popularity) 63 | export(set_tmp_folder) 64 | export(setup_ampl) 65 | import(parallel) 66 | importFrom(stats,runif) 67 | importFrom(utils,download.file) 68 | importFrom(utils,hasName) 69 | importFrom(utils,menu) 70 | importFrom(utils,read.csv) 71 | importFrom(utils,untar) 72 | importFrom(utils,unzip) 73 | -------------------------------------------------------------------------------- /R/snowflake.R: -------------------------------------------------------------------------------- 1 | # generate a twitter-snowflake id, based on 2 | # https://github.com/twitter/snowflake/blob/master/src/main/scala/com/twitter/service/snowflake/IdWorker.scala 3 | make_snowflake <- function(timestamp_ms, datacenter_id, worker_id, sequence_id, twepoch = bit64::as.integer64('1288834974657')) { 4 | check_required_packages('bit64') 5 | base <- bit64::as.integer64(2) 6 | datacenter_id_bits <- 5 7 | worker_id_bits <- 5 8 | sequence_id_bits <- 12 9 | max_datacenter_id <- 1 * base^datacenter_id_bits 10 | max_worker_id <- 1 * base^worker_id_bits 11 | max_sequence_id <- 1 * base^sequence_id_bits 12 | max_timestamp <- base^(64 - datacenter_id_bits - worker_id_bits - sequence_id_bits) 13 | 14 | stopifnot(is.character(timestamp_ms) || bit64::is.integer64(timestamp_ms)) 15 | timestamp_ms <- bit64::as.integer64(timestamp_ms) 16 | sid <- ((timestamp_ms - twepoch) %% max_timestamp) * base^datacenter_id_bits * base^worker_id_bits * base^sequence_id_bits 17 | sid <- sid + (datacenter_id %% max_datacenter_id) * base^worker_id_bits * base^sequence_id_bits 18 | sid <- sid + (worker_id %% max_worker_id) * base^sequence_id_bits 19 | sid <- sid + sequence_id %% max_sequence_id 20 | sid 21 | } 22 | 23 | #' Inversely transform a Twitter id back to its components (timestamp, datacentre id, 24 | #' worker id and sequence id). 25 | #' @param snowflake_id a list of Twitter ids 26 | #' @param twepoch time epoch. Defaults to 1288834974657 27 | #' @return A list of timestamp, datacentre id, worker id and sequence id 28 | #' @export 29 | melt_snowflake <- function(snowflake_id, twepoch = bit64::as.integer64('1288834974657')) { 30 | check_required_packages('bit64') 31 | base <- bit64::as.integer64(2) 32 | datacenter_id_bits <- 5 33 | worker_id_bits <- 5 34 | sequence_id_bits <- 12 35 | max_datacenter_id <- 1 * base^datacenter_id_bits 36 | max_worker_id <- 1 * base^worker_id_bits 37 | max_sequence_id <- 1 * base^sequence_id_bits 38 | max_timestamp <- base^(64 - datacenter_id_bits - worker_id_bits - sequence_id_bits) 39 | 40 | stopifnot(is.character(snowflake_id) || bit64::is.integer64(snowflake_id)) 41 | snowflake_id <- bit64::as.integer64(snowflake_id) 42 | sequence_id <- snowflake_id %% max_sequence_id 43 | worker_id <- (snowflake_id %/% base^sequence_id_bits) %% max_worker_id 44 | datacenter_id <- (snowflake_id %/% base^sequence_id_bits %/% base^worker_id_bits) %% max_datacenter_id 45 | timestamp_ms <- snowflake_id %/% base^sequence_id_bits %/% base^worker_id_bits %/% base^datacenter_id_bits 46 | timestamp_ms <- timestamp_ms + twepoch 47 | 48 | list(timestamp_ms = timestamp_ms, 49 | datacenter_id = datacenter_id, 50 | worker_id = worker_id, 51 | sequence_id = sequence_id) 52 | } 53 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | # For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag. 2 | # https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions 3 | on: 4 | push: 5 | branches: 6 | - main 7 | - master 8 | pull_request: 9 | branches: 10 | - main 11 | - master 12 | 13 | name: R-CMD-check 14 | 15 | jobs: 16 | R-CMD-check: 17 | runs-on: ${{ matrix.config.os }} 18 | 19 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 20 | 21 | strategy: 22 | fail-fast: false 23 | matrix: 24 | config: 25 | - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} 26 | - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} 27 | - {os: ubuntu-20.04, r: '3.6', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} 28 | 29 | env: 30 | R_REMOTES_NO_ERRORS_FROM_WARNINGS: true 31 | RSPM: ${{ matrix.config.rspm }} 32 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 33 | 34 | steps: 35 | - uses: actions/checkout@v2 36 | 37 | - uses: r-lib/actions/setup-r@v1 38 | with: 39 | r-version: ${{ matrix.config.r }} 40 | 41 | - uses: r-lib/actions/setup-pandoc@v1 42 | 43 | - name: Query dependencies 44 | run: | 45 | install.packages('remotes') 46 | saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) 47 | writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") 48 | shell: Rscript {0} 49 | 50 | - name: Cache R packages 51 | if: runner.os != 'Windows' 52 | uses: actions/cache@v2 53 | with: 54 | path: ${{ env.R_LIBS_USER }} 55 | key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} 56 | restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- 57 | 58 | - name: Install system dependencies 59 | if: runner.os == 'Linux' 60 | run: | 61 | while read -r cmd 62 | do 63 | eval sudo $cmd 64 | done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') 65 | - name: Install dependencies 66 | run: | 67 | remotes::install_deps(dependencies = TRUE) 68 | remotes::install_cran("rcmdcheck") 69 | shell: Rscript {0} 70 | 71 | - name: Check 72 | env: 73 | _R_CHECK_CRAN_INCOMING_REMOTE_: false 74 | run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran", "--no-build-vignettes"), error_on = "warning", check_dir = "check") 75 | shell: Rscript {0} 76 | 77 | - name: Upload check results 78 | if: failure() 79 | uses: actions/upload-artifact@main 80 | with: 81 | name: ${{ runner.os }}-r${{ matrix.config.r }}-results 82 | path: check 83 | -------------------------------------------------------------------------------- /R/plot.R: -------------------------------------------------------------------------------- 1 | # this script implements methods for plotting figures given fitted models 2 | 3 | #' Plot a Hawkes process and its intensity function 4 | #' @param model A model object where data, model_type and par are required 5 | #' @param cascade This cascade data.frame will be used if provided 6 | #' @param cascade_index Determine which cascade in the list of cascades to plot 7 | #' default to the first cascade 8 | #' @return A ggplot object 9 | #' @export 10 | #' @examples 11 | #' par <- c(K = 0.95, theta = 1) 12 | #' data <- generate_series(model_type = 'EXP', 13 | #' par = par, 14 | #' sim_no = 1, Tmax = Inf) 15 | #' plot_event_series(new_hawkes(model_type = 'EXP', 16 | #' par = par, 17 | #' data = data)) 18 | plot_event_series <- function(model, cascade = NULL, cascade_index = 1) { 19 | check_required_packages('ggplot2') 20 | if (!is.null(cascade)) { 21 | stopifnot(is.data.frame(cascade) || (is.list(cascade) && is.data.frame(cascade[[1]]))) 22 | model$data <- if (is.data.frame(cascade)) list(cascade) else cascade 23 | } 24 | check_required_hawkes_fields(model, c('model_type', 'data', 'par')) 25 | 26 | cascade <- model$data[[cascade_index]] 27 | g <- ggplot2::ggplot() + 28 | ggplot2::stat_function(data = data.frame(x = c(0, max(cascade$time) * 1.2)), ggplot2::aes(.data$x), n = 1000, 29 | fun = Vectorize(function(t) get_model_intensity_at(model, t = t)), color = 'red') 30 | built_g <- ggplot2::ggplot_build(g) 31 | max_intensity <- max(built_g$data[[1]]$y) 32 | g + 33 | ggplot2::geom_point(data = cascade, 34 | ggplot2::aes(x = .data$time, 35 | y = .data$magnitude / max(.data$magnitude) * max_intensity /2 + max_intensity), 36 | size = 4) + 37 | ggplot2::geom_segment(data = cascade, linetype = 2, 38 | ggplot2::aes(x = .data$time, 39 | y = .data$magnitude / max(.data$magnitude) * max_intensity/2 + max_intensity, 40 | xend = .data$time, yend = 0)) + 41 | ggplot2::xlab('time') + ggplot2::ylab('intensity') 42 | } 43 | 44 | #' Plot the kernel functions of Hawkes processes 45 | #' @param fitted_models A list of fitted model objects to plot the kernel functions 46 | #' @return A ggplot object 47 | #' @export 48 | plot_kernel_function <- function(fitted_models) { 49 | check_required_packages('ggplot2') 50 | library(ggplot2) 51 | cut_off_intensity <- 1e-3 52 | lapply(fitted_models, function(model) check_required_hawkes_fields(model, c('model_type', 'par'))) 53 | data <- list(data.frame(magnitude = 1, time = 0)) # dummy data to get the kernel function from a Hawkes intensity function 54 | 55 | kernel_functions <- lapply(fitted_models, function(model) { 56 | model$data <- list(data.frame(magnitude = 0, time = 0)) 57 | Vectorize(function(t) get_model_intensity_at(model, t = t)) 58 | }) 59 | cut_off_time <- max(sapply(kernel_functions, function(f) { 60 | uniroot(f = function(x) f(x) - cut_off_intensity, interval = c(0, 1e6))$root 61 | })) 62 | g <- ggplot2::ggplot(data = data.frame(x = c(0, cut_off_time)), aes(x)) 63 | for (f_i in seq_along(kernel_functions)) { 64 | g <- g + stat_function(fun = kernel_functions[[f_i]], aes(color = !!as.character(f_i))) 65 | } 66 | g + xlab('relative time') + ylab('kernel function value') + labs(color='model') 67 | } 68 | -------------------------------------------------------------------------------- /R/EXP.R: -------------------------------------------------------------------------------- 1 | # this script implements methods for Hawkes with EXP kernel (unmarked, EXP and marked, mEXP) 2 | 3 | get_param_names.hawkes_EXP <- function(model) { 4 | c('K', 'theta') 5 | } 6 | 7 | get_ampl_likelihood.hawkes_EXP <- function(model) { 8 | paste('sum {cn in 1..HL} ( (1 - 0^(L[cn]-J0[cn]-1)) * (sum {i in J0[cn]+1..L[cn]-1} (', 9 | 'log(K * theta * sum {j in ind[cn,i]..i-1} (exp(-1 * theta * (time[cn,i] - time[cn,j]))) + 1e-100)', 10 | '))', 11 | '- K * sum {i in 1..L[cn]-1} ((1 - exp(-1 * theta * (time[cn,L[cn]] - time[cn,i])))));') 12 | } 13 | 14 | get_ampl_constraints.hawkes_EXP <- function(model) { 15 | 'subject to branching_factor: K <= 1;' 16 | } 17 | 18 | get_param_names.hawkes_mEXP <- function(model) { 19 | c('K', 'beta', 'theta') 20 | } 21 | 22 | get_ampl_likelihood.hawkes_mEXP <- function(model) { 23 | paste('sum {cn in 1..HL} ( (1 - 0^(L[cn]-J0[cn]-1)) * (sum {i in J0[cn]+1..L[cn]-1} (', 24 | 'log(K * theta * sum {j in ind[cn,i]..i-1} (magnitude[cn,j]^beta * exp(-1 * theta * (time[cn,i] - time[cn,j]))) + 1e-100)', 25 | '))', 26 | '- K * sum {i in 1..L[cn]-1} (magnitude[cn,i]^beta * (1 - exp(-1 * theta * (time[cn,L[cn]] - time[cn,i])))));') 27 | } 28 | 29 | get_ampl_constraints.hawkes_mEXP <- function(model) { 30 | 'subject to branching_factor: K * 1.016 + beta <= 1.016;' 31 | } 32 | 33 | #' @export 34 | get_branching_factor.hawkes_EXP <- function(model) { 35 | model$par[['K']] 36 | } 37 | 38 | #' @export 39 | get_branching_factor.hawkes_mEXP <- function(model) { 40 | # assuming alpha = 2.016 41 | (model$par[['K']] * 1.016) / (1.016 - model$par[['beta']]) 42 | } 43 | 44 | #' @export 45 | get_a1.hawkes_EXP <- function(model) { 46 | processed_data <- preprocess_data(model$data, model$observation_time) 47 | vapply(processed_data, function(history) { 48 | sum(1 / (exp((history$time[nrow(history)] - history$time[-nrow(history)]) * model$par[['theta']]))) * model$par[['K']] 49 | }, FUN.VALUE = NA_real_) 50 | } 51 | 52 | #' @export 53 | get_a1.hawkes_mEXP <- function(model) { 54 | processed_data <- preprocess_data(model$data, model$observation_time) 55 | vapply(processed_data, function(history) { 56 | sum((history$magnitude[-nrow(history)]) ^ model$par[['beta']] / (exp((history$time[nrow(history)] - history$time[-nrow(history)]) * model$par[['theta']]))) * model$par[['K']] 57 | }, FUN.VALUE = NA_real_) 58 | } 59 | 60 | #' @export 61 | predict_final_popularity.hawkes_EXP <- function(model, data = NULL, observation_time = NULL) { 62 | NextMethod() 63 | } 64 | 65 | #' @export 66 | predict_final_popularity.hawkes_mEXP <- function(model, data = NULL, observation_time = NULL) { 67 | NextMethod() 68 | } 69 | 70 | #' @export 71 | get_model_intensity_at.hawkes_EXP <- function(model, t, cascade_index = 1) { 72 | get_model_intensity_at.hawkes_mEXP(list(model_type = 'mEXP', par = c(model$par, beta = 0), data = model$data), 73 | t = t, cascade_index = cascade_index) 74 | } 75 | 76 | #' @export 77 | get_model_intensity_at.hawkes_mEXP <- function(model, t, cascade_index = 1) { 78 | event <- model$data[[cascade_index]] 79 | event <- event[event$time <= t, ] 80 | par <- model$par 81 | mi <- event$magnitude 82 | ti <- event$time 83 | 84 | fun_f <- par[["K"]] 85 | 86 | # ro(m_i) part - the influence of the user of the event 87 | fun_ro <- (mi) ^ par[["beta"]] 88 | 89 | # psi(t, ti) part - the decaying / relaxation kernel 90 | fun_psi <- par[["theta"]] * (exp(-par[["theta"]] * (t - ti))) 91 | 92 | val <- fun_f * fun_ro * fun_psi 93 | 94 | sum(val) 95 | } 96 | -------------------------------------------------------------------------------- /man/fit_series.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fit.R 3 | \name{fit_series} 4 | \alias{fit_series} 5 | \title{Fit a Hawkes process or HawkesN process model on one or many event cascades 6 | and learn model parameters.} 7 | \usage{ 8 | fit_series( 9 | data, 10 | model_type, 11 | cores = 1, 12 | init_pars = NULL, 13 | .init_no = NULL, 14 | observation_time = NULL, 15 | lower_bound = NULL, 16 | upper_bound = NULL, 17 | limit_event = NULL, 18 | model_vars = NULL, 19 | parallel_type = "PSOCK", 20 | ... 21 | ) 22 | } 23 | \arguments{ 24 | \item{data}{A list of data.frame(s) where each data.frame is an event cascade with event 25 | tims and event magnitudes (optional)} 26 | 27 | \item{model_type}{A string representing the model type, e.g. EXP for Hawkes processes with 28 | an exponential kernel function} 29 | 30 | \item{cores}{The number of cores used for parallel fitting, defaults to 1 (non-parallel)} 31 | 32 | \item{init_pars}{A data.frame of initial parameters passed to the fitting program. Parameters should be 33 | aligned with required ones for the corresponding "model_type". The default initial parameters will 34 | be used if not provided.} 35 | 36 | \item{.init_no}{If initi_pars is not provided, currently 10 random starting parameters are generated 37 | for fitting. This controls which random points are used. Defaults to NULL} 38 | 39 | \item{observation_time}{The event cascades observation time(s). This can either be a single number indicating 40 | a common observation time for all cascades or a vector of observation times which has the same length as 41 | the number of cascades.} 42 | 43 | \item{lower_bound}{Model parameter lower bounds. A named vector where names are model parameters and 44 | values are the lowest possible values.} 45 | 46 | \item{upper_bound}{Model parameter upper bounds. A named vector where names are model parameters and 47 | values are the largest possible values.} 48 | 49 | \item{limit_event}{Define the way to optimize the computation by reducing the number of events added in log-likelihood (LL) functions, 50 | defaults to NULL, i.e., no optimization. To limit the number of events computed, a list with `type` and `value` shoud be provided. 51 | For example, limit_event = list(type = "event", value = 10) limits the LL fitting to 10 events, 52 | limit_event = list(type = "time", value = 10) limits the LL fitting to the events within past 10 time units. 53 | The best practice to trade-off the computation could be to limit to the largest number of events that one can afford.} 54 | 55 | \item{model_vars}{A named list of extra variables provided to hawkes objects} 56 | 57 | \item{parallel_type}{One of "PSOCK" or "FORK". Default to "PSOCK". See "Details" in makeCluster {parallel}.} 58 | 59 | \item{...}{Further arguments passed to ampl} 60 | } 61 | \value{ 62 | A model object where the [par] is fitted on [data]. [convergence] indicates the fitting convergence 63 | status and [value] is the negative log-likelihood value of the fitted model on [data]. 64 | } 65 | \description{ 66 | Fit a Hawkes process or HawkesN process model on one or many event cascades 67 | and learn model parameters. 68 | } 69 | \examples{ 70 | \dontrun{ 71 | data <- generate_series(model_type = 'EXP', 72 | par = c(K = 0.9, theta = 1), 73 | sim_no = 10, Tmax = Inf) 74 | fitted <- fit_series(data, 'EXP', observation_time = Inf) 75 | fitted$par # fitted parameters 76 | fitted$convergence # convergence status 77 | fitted$value # negative log-likelihood value 78 | } 79 | } 80 | -------------------------------------------------------------------------------- /R/PLN.R: -------------------------------------------------------------------------------- 1 | # this script implements methods for HawkesN with PL kernel (unmarked, PLN, and marked, mPLN) 2 | 3 | get_param_names.hawkes_PLN <- function(model) { 4 | c('K', 'c', 'theta', 'N') 5 | } 6 | 7 | get_ampl_likelihood.hawkes_PLN <- function(model) { 8 | paste( 9 | 'sum {cn in 1..HL} ( (1 - 0^(L[cn]-J0[cn]-1)) * (sum {i in J0[cn]+1..L[cn]-1} (', 10 | 'log(N-i+1) - log(N)', 11 | '+ log(K) + log(sum{j in ind[cn,i]..i-1} ((time[cn,i] - time[cn,j] + c) ^ (-1-theta)) + 1e-100 ))', 12 | ')', 13 | '- K * sum {i in 1..L[cn]-1} (sum{j in i..L[cn]-1}( (N - j) * ( (time[cn,j] - time[cn,i] + c)^(-1*theta) - (time[cn,j+1] - time[cn,i] + c)^(-1*theta) ))) / (theta * N));' 14 | ) 15 | } 16 | 17 | get_ampl_constraints.hawkes_PLN <- function(model) { 18 | '' 19 | } 20 | 21 | 22 | get_param_names.hawkes_mPLN <- function(model) { 23 | c('K', 'beta', 'c', 'theta', 'N') 24 | } 25 | 26 | get_ampl_likelihood.hawkes_mPLN <- function(model) { 27 | paste( 28 | 'sum {cn in 1..HL} ( (1 - 0^(L[cn]-J0[cn]-1)) * (sum {i in J0[cn]+1..L[cn]-1} (', 29 | 'log(N-i+1) - log(N)', 30 | '+ log(K) + log(sum{j in ind[cn,i]..i-1} (magnitude[cn,j]^beta * (time[cn,i] - time[cn,j] + c) ^ (-1-theta)) + 1e-100 ))', 31 | ')', 32 | '- K * sum {i in 1..L[cn]-1} ( magnitude[cn,i]^beta * sum{j in i..L[cn]-1}( (N - j) * ( (time[cn,j] - time[cn,i] + c)^(-1*theta) - (time[cn,j+1] - time[cn,i] + c)^(-1*theta) ))) / (theta * N));' 33 | ) 34 | } 35 | 36 | get_ampl_constraints.hawkes_mPLN <- function(model) { 37 | '' 38 | } 39 | 40 | #' @export 41 | get_branching_factor.hawkes_PLN <- function(model) { 42 | model$par[['K']]* (1 / model$par[['theta']]) * (1 / model$par[['c']])^model$par[['theta']] 43 | } 44 | 45 | #' @export 46 | get_branching_factor.hawkes_mPLN <- function(model) { 47 | # assuming alpha = 2.016 48 | (model$par[['K']] * 1.016 / (1.016-model$par[['beta']]) ) * (1 / model$par[['theta']]) * (1 / model$par[['c']])^model$par[['theta']] 49 | } 50 | 51 | #' @export 52 | get_a1.hawkes_PLN <- function(model) { 53 | stop('This method does not exist for PLN') 54 | } 55 | 56 | #' @export 57 | get_a1.hawkes_mPLN <- function(model) { 58 | stop('This method does not exist for mPLN') 59 | } 60 | 61 | #' @export 62 | predict_final_popularity.hawkes_PLN <- function(model, data = NULL, observation_time = NULL) { 63 | stop('This method does not exist for PLN') 64 | } 65 | 66 | #' @export 67 | predict_final_popularity.hawkes_mPLN <- function(model, data = NULL, observation_time = NULL) { 68 | stop('This method does not exist for mPLN') 69 | } 70 | 71 | #' @export 72 | get_model_intensity_at.hawkes_PLN <- function(model, t, cascade_index = 1) { 73 | get_model_intensity_at.hawkes_mPLN(list(model_type = 'mPLN', par = c(model$par, beta = 0), data = model$data), 74 | t = t, cascade_index = cascade_index) 75 | } 76 | 77 | #' @export 78 | get_model_intensity_at.hawkes_mPLN <- function(model, t, cascade_index = 1) { 79 | event <- model$data[[cascade_index]][model$data[[cascade_index]]$time <= t, ] 80 | par <- model$par 81 | mi <- event$magnitude 82 | ti <- event$time 83 | 84 | ## compute correponding Nt at the current time t 85 | Nt <- min(sum(ti <= t), par[["N"]]) 86 | 87 | # f(p_j) part - virality of a video. Constant for a given video 88 | fun_f <- par[["K"]] * (1 - Nt / par[["N"]]) 89 | 90 | # ro(m_i) part - the influence of the user of the event 91 | fun_ro <- (mi) ^ par[["beta"]] 92 | 93 | # psi(t, ti) part - the decaying / relaxation kernel 94 | fun_psi <- 1 / (t - ti + par[["c"]])^(1+par[["theta"]]) 95 | 96 | val <- fun_f * fun_ro * fun_psi 97 | 98 | sum(val) 99 | } 100 | -------------------------------------------------------------------------------- /R/EXPN.R: -------------------------------------------------------------------------------- 1 | # this script implements methods for HawkesN with EXP kernel (unmarked, EXPN, and marked, mEXPN) 2 | 3 | get_param_names.hawkes_EXPN <- function(model) { 4 | c('K', 'theta', 'N') 5 | } 6 | 7 | get_ampl_likelihood.hawkes_EXPN <- function(model) { 8 | paste( 9 | 'sum {cn in 1..HL} (( (1 - 0^(L[cn]-J0[cn]-1)) * (sum {i in J0[cn]+1..L[cn]-1} (log(N-i+1))', 10 | '- (L[cn] - J0[cn] - 1) * log(N) + (L[cn] - J0[cn] - 1) * log(K * theta) + sum{i in J0[cn]+1..L[cn]-1} (log(sum{j in ind[cn,i]..i-1} (exp(-1 * theta * (time[cn,i] - time[cn,j]))) + 1e-100 )))', 11 | '- K * sum {i in 1..L[cn]-1} (sum{j in i..L[cn]-1}((N - j) / N * (exp(-1*theta*(time[cn,j] - time[cn,i])) - exp(-1*theta * (time[cn,j+1] - time[cn,i])))))));' 12 | ) 13 | } 14 | 15 | get_ampl_constraints.hawkes_EXPN <- function(model) { 16 | '' # no constraint for HawkesN 17 | } 18 | 19 | get_param_names.hawkes_mEXPN <- function(model) { 20 | c('K', 'beta', 'theta', 'N') 21 | } 22 | 23 | get_ampl_likelihood.hawkes_mEXPN <- function(model) { 24 | paste( 25 | 'sum {cn in 1..HL} (( (1 - 0^(L[cn]-J0[cn]-1)) * (sum {i in J0[cn]+1..L[cn]-1} (log(N-i+1))', 26 | '- (L[cn] - J0[cn] - 1) * log(N) + (L[cn] - J0[cn] - 1) * log(K * theta) + sum{i in J0[cn]+1..L[cn]-1} (log(sum{j in ind[cn,i]..i-1} (exp(beta * log(magnitude[cn,j] + 1e-100)) * exp(-1 * theta * (time[cn,i] - time[cn,j]))) + 1e-100 )))', 27 | '- K * sum {i in 1..L[cn]-1} (exp(beta * log(magnitude[cn,i] + 1e-100)) * sum{j in i..L[cn]-1}((N - j) / N * (exp(-1*theta*(time[cn,j] - time[cn,i])) - exp(-1*theta * (time[cn,j+1] - time[cn,i])))))));' 28 | ) 29 | } 30 | 31 | get_ampl_constraints.hawkes_mEXPN <- function(model) { 32 | '' # no constraint for HawkesN 33 | } 34 | 35 | #' @export 36 | get_branching_factor.hawkes_EXPN <- function(model) { 37 | model$par[['K']] 38 | } 39 | 40 | #' @export 41 | get_branching_factor.hawkes_mEXPN <- function(model) { 42 | # assuming alpha = 2.016 43 | (model$par[['K']] * 1.016) / (1.016 - model$par[['beta']]) 44 | } 45 | 46 | #' @export 47 | get_a1.hawkes_EXPN <- function(model) { 48 | stop('This method does not exist for EXPN') 49 | } 50 | 51 | #' @export 52 | get_a1.hawkes_mEXPN <- function(model) { 53 | stop('This method does not exist for mEXPN') 54 | } 55 | 56 | #' @export 57 | predict_final_popularity.hawkes_EXPN <- function(model, data = NULL, observation_time = NULL) { 58 | stop('This method does not exist for EXPN') 59 | } 60 | 61 | #' @export 62 | predict_final_popularity.hawkes_mEXPN <- function(model, data = NULL, observation_time = NULL) { 63 | stop('This method does not exist for mEXPN') 64 | } 65 | 66 | #' @export 67 | get_model_intensity_at.hawkes_EXPN <- function(model, t, cascade_index = 1) { 68 | get_model_intensity_at.hawkes_mEXPN(list(model_type = 'mEXPN', par = c(model$par, beta = 0), data = model$data), 69 | t = t, cascade_index = cascade_index) 70 | } 71 | 72 | #' @export 73 | get_model_intensity_at.hawkes_mEXPN <- function(model, t, cascade_index = 1) { 74 | event <- model$data[[cascade_index]] 75 | event <- event[event$time <= t, ] 76 | par <- model$par 77 | mi <- event$magnitude 78 | ti <- event$time 79 | 80 | ## compute correponding Nt at the current time t 81 | Nt <- min(sum(ti <= t), par[["N"]]) 82 | 83 | 84 | # f(p_j) part - virality of a diffusion. Constant for a given diffusion. Furthermore, discount for available events. 85 | fun_f <- par[["K"]] * (1 - Nt / par[["N"]]) 86 | 87 | # ro(m_i) part - the influence of the user of the event 88 | fun_ro <- mi ^ par[["beta"]] 89 | 90 | # psi(t, ti) part - the decaying / relaxation kernel 91 | fun_psi <- par[["theta"]] * (exp(-par[["theta"]] * (t - ti))) 92 | 93 | val <- fun_f * fun_ro * fun_psi 94 | 95 | sum(val) 96 | } 97 | -------------------------------------------------------------------------------- /docs/pkgdown.js: -------------------------------------------------------------------------------- 1 | /* http://gregfranko.com/blog/jquery-best-practices/ */ 2 | (function($) { 3 | $(function() { 4 | 5 | $('.navbar-fixed-top').headroom(); 6 | 7 | $('body').css('padding-top', $('.navbar').height() + 10); 8 | $(window).resize(function(){ 9 | $('body').css('padding-top', $('.navbar').height() + 10); 10 | }); 11 | 12 | $('[data-toggle="tooltip"]').tooltip(); 13 | 14 | var cur_path = paths(location.pathname); 15 | var links = $("#navbar ul li a"); 16 | var max_length = -1; 17 | var pos = -1; 18 | for (var i = 0; i < links.length; i++) { 19 | if (links[i].getAttribute("href") === "#") 20 | continue; 21 | // Ignore external links 22 | if (links[i].host !== location.host) 23 | continue; 24 | 25 | var nav_path = paths(links[i].pathname); 26 | 27 | var length = prefix_length(nav_path, cur_path); 28 | if (length > max_length) { 29 | max_length = length; 30 | pos = i; 31 | } 32 | } 33 | 34 | // Add class to parent
  • , and enclosing
  • if in dropdown 35 | if (pos >= 0) { 36 | var menu_anchor = $(links[pos]); 37 | menu_anchor.parent().addClass("active"); 38 | menu_anchor.closest("li.dropdown").addClass("active"); 39 | } 40 | }); 41 | 42 | function paths(pathname) { 43 | var pieces = pathname.split("/"); 44 | pieces.shift(); // always starts with / 45 | 46 | var end = pieces[pieces.length - 1]; 47 | if (end === "index.html" || end === "") 48 | pieces.pop(); 49 | return(pieces); 50 | } 51 | 52 | // Returns -1 if not found 53 | function prefix_length(needle, haystack) { 54 | if (needle.length > haystack.length) 55 | return(-1); 56 | 57 | // Special case for length-0 haystack, since for loop won't run 58 | if (haystack.length === 0) { 59 | return(needle.length === 0 ? 0 : -1); 60 | } 61 | 62 | for (var i = 0; i < haystack.length; i++) { 63 | if (needle[i] != haystack[i]) 64 | return(i); 65 | } 66 | 67 | return(haystack.length); 68 | } 69 | 70 | /* Clipboard --------------------------*/ 71 | 72 | function changeTooltipMessage(element, msg) { 73 | var tooltipOriginalTitle=element.getAttribute('data-original-title'); 74 | element.setAttribute('data-original-title', msg); 75 | $(element).tooltip('show'); 76 | element.setAttribute('data-original-title', tooltipOriginalTitle); 77 | } 78 | 79 | if(ClipboardJS.isSupported()) { 80 | $(document).ready(function() { 81 | var copyButton = ""; 82 | 83 | $(".examples, div.sourceCode").addClass("hasCopyButton"); 84 | 85 | // Insert copy buttons: 86 | $(copyButton).prependTo(".hasCopyButton"); 87 | 88 | // Initialize tooltips: 89 | $('.btn-copy-ex').tooltip({container: 'body'}); 90 | 91 | // Initialize clipboard: 92 | var clipboardBtnCopies = new ClipboardJS('[data-clipboard-copy]', { 93 | text: function(trigger) { 94 | return trigger.parentNode.textContent; 95 | } 96 | }); 97 | 98 | clipboardBtnCopies.on('success', function(e) { 99 | changeTooltipMessage(e.trigger, 'Copied!'); 100 | e.clearSelection(); 101 | }); 102 | 103 | clipboardBtnCopies.on('error', function() { 104 | changeTooltipMessage(e.trigger,'Press Ctrl+C or Command+C to copy'); 105 | }); 106 | }); 107 | } 108 | })(window.jQuery || window.$) 109 | -------------------------------------------------------------------------------- /R/MULTI.R: -------------------------------------------------------------------------------- 1 | # this script implements methods for Hawkes with multiple parts: a specific kernel function + a background rate type 2 | 3 | get_param_names.hawkes_MULTI <- function(model) { 4 | decay_type <- model$model_type$hawkes_decay_type 5 | immigrant_type <- model$model_type$hawkes_immigrant_type 6 | 7 | c(get_param_names(new_hawkes(model_type = decay_type)), 8 | get_param_names(new_hawkes(model_type = immigrant_type))) 9 | } 10 | 11 | get_ampl_likelihood.hawkes_MULTI <- function(model) { 12 | combined_type <- 13 | paste( 14 | model$model_type$hawkes_decay_type, 15 | model$model_type$hawkes_immigrant_type, 16 | sep = '_' 17 | ) 18 | switch ( 19 | combined_type, 20 | 'EXP_CONST' = paste( 21 | 'sum {cn in 1..HL} ( (1 - 0^(L[cn]-J0[cn]-1)) * (sum {i in J0[cn]+1..L[cn]-1} (log(lambda + K * theta * sum {j in ind[cn,i]..i-1} (exp(-1 * theta * (time[cn,i] - time[cn,j]))) + 1e-100)))', 22 | '- lambda * (time[cn,L[cn]] - time[cn, 1]) - K * sum {i in 1..L[cn]-1} ((1 - exp(-1 * theta * (time[cn,L[cn]] - time[cn,i])))));' 23 | ), 24 | 'PL_CONST' = paste( 25 | 'sum {cn in 1..HL} ( (1 - 0^(L[cn]-J0[cn]-1)) * (sum {i in J0[cn]+1..L[cn]-1} (log(lambda + K*sum {j in ind[cn,i]..i-1} ((time[cn,i] - time[cn,j] + c) ^ (-1-theta)) + 1e-100)))', 26 | '- lambda * (time[cn,L[cn]] - time[cn, 1]) - K * sum {i in 1..L[cn]-1} (( (1 / c)^theta - ( 1 / (time[cn,L[cn]] - time[cn,i] + c))^theta )) / theta);' 27 | ), 28 | 'mEXP_CONST' = paste( 29 | 'sum {cn in 1..HL} ( (1 - 0^(L[cn]-J0[cn]-1)) * (sum {i in J0[cn]+1..L[cn]-1} (log(lambda + K * theta * sum {j in ind[cn,i]..i-1} (magnitude[cn,j]^beta * exp(-1 * theta * (time[cn,i] - time[cn,j]))) + 1e-100)', 30 | '))', 31 | '- lambda * (time[cn,L[cn]] - time[cn, 1]) - K * sum {i in 1..L[cn]-1} (magnitude[cn,i]^beta * (1 - exp(-1 * theta * (time[cn,L[cn]] - time[cn,i])))));' 32 | ), 33 | 'mPL_CONST' = paste( 34 | 'sum {cn in 1..HL} ( (1 - 0^(L[cn]-J0[cn]-1)) * (sum {i in J0[cn]+1..L[cn]-1} (log(lambda + K * sum {j in ind[cn,i]..i-1} (magnitude[cn,j]^beta * (time[cn,i] - time[cn,j] + c) ^ (-1-theta)) + 1e-100))', 35 | ')', 36 | '- lambda * (time[cn,L[cn]] - time[cn, 1]) - K * sum {i in 1..L[cn]-1} (magnitude[cn,i]^beta * ( (1 / c)^theta - ( 1 / (time[cn,L[cn]] - time[cn,i] + c))^theta )) / theta);' 37 | ), 38 | 'EXPN_CONST' = stop('HawkesN models don\'t work with background intensities.'), 39 | 'PLN_CONST' = stop('HawkesN models don\'t work with background intensities.'), 40 | 'mEXPN_CONST' = stop('HawkesN models don\'t work with background intensities.'), 41 | 'mPLN_CONST' = stop('HawkesN models don\'t work with background intensities.'), 42 | stop('Unknown model type!') 43 | ) 44 | } 45 | 46 | get_ampl_constraints.hawkes_MULTI <- function(model) { 47 | decay_type <- model$model_type$hawkes_decay_type 48 | immigrant_type <- model$model_type$hawkes_immigrant_type 49 | 50 | c(get_ampl_constraints(new_hawkes(model_type = decay_type)), 51 | get_ampl_constraints(new_hawkes(model_type = immigrant_type))) 52 | } 53 | 54 | generate_random_points.hawkes_MULTI <- function(model) { 55 | decay_type <- model$model_type$hawkes_decay_type 56 | immigrant_type <- model$model_type$hawkes_immigrant_type 57 | 58 | cbind(generate_random_points(new_hawkes(model_type = decay_type)), 59 | generate_random_points(new_hawkes(model_type = immigrant_type))) 60 | } 61 | 62 | get_lower_bound.hawkes_MULTI <- function(model) { 63 | decay_type <- model$model_type$hawkes_decay_type 64 | immigrant_type <- model$model_type$hawkes_immigrant_type 65 | 66 | c(get_lower_bound(new_hawkes(model_type = decay_type)), 67 | get_lower_bound(new_hawkes(model_type = immigrant_type))) 68 | } 69 | 70 | get_upper_bound.hawkes_MULTI <- function(model) { 71 | decay_type <- model$model_type$hawkes_decay_type 72 | immigrant_type <- model$model_type$hawkes_immigrant_type 73 | 74 | c(get_upper_bound(new_hawkes(model_type = decay_type)), 75 | get_upper_bound(new_hawkes(model_type = immigrant_type))) 76 | } 77 | -------------------------------------------------------------------------------- /R/PL.R: -------------------------------------------------------------------------------- 1 | # this script implements methods for Hawkes with PL kernel (unmarked, PL, and marked, mPL) 2 | 3 | get_param_names.hawkes_PL <- function(model) { 4 | c('K', 'c', 'theta') 5 | } 6 | 7 | get_ampl_likelihood.hawkes_PL <- function(model) { 8 | paste( 9 | 'sum {cn in 1..HL} ( (1 - 0^(L[cn]-J0[cn]-1)) * (sum {i in J0[cn]+1..L[cn]-1} (', 10 | 'log(K * sum {j in ind[cn,i]..i-1} ((time[cn,i] - time[cn,j] + c) ^ (-1-theta)) + 1e-100))', 11 | ')', 12 | '- K * sum {i in 1..L[cn]-1} (( (1 / c)^theta - ( 1 / (time[cn,L[cn]] - time[cn,i] + c))^theta )) / theta);' 13 | ) 14 | } 15 | 16 | get_ampl_constraints.hawkes_PL <- function(model) { 17 | 'subject to branching_factor: K * (1 / theta) * (1 / c)^theta <= 1;' 18 | } 19 | 20 | 21 | get_param_names.hawkes_mPL <- function(model) { 22 | c('K', 'beta', 'c', 'theta') 23 | } 24 | 25 | get_ampl_likelihood.hawkes_mPL <- function(model) { 26 | paste( 27 | 'sum {cn in 1..HL} ( (1 - 0^(L[cn]-J0[cn]-1)) * (sum {i in J0[cn]+1..L[cn]-1} (', 28 | 'log(K * sum {j in ind[cn,i]..i-1} (magnitude[cn,j]^beta * (time[cn,i] - time[cn,j] + c) ^ (-1-theta)) + 1e-100))', 29 | ')', 30 | '- K * sum {i in 1..L[cn]-1} (magnitude[cn,i]^beta * ( (1 / c)^theta - ( 1 / (time[cn,L[cn]] - time[cn,i] + c))^theta )) / theta);' 31 | ) 32 | } 33 | 34 | get_ampl_constraints.hawkes_mPL <- function(model) { 35 | 'subject to branching_factor: ( K * 1.016 / (1.016-beta) ) * (1 / theta) * (1 / c)^theta <= 1;' 36 | } 37 | 38 | #' @export 39 | get_branching_factor.hawkes_PL <- function(model) { 40 | model$par[['K']]* (1 / model$par[['theta']]) * (1 / model$par[['c']])^model$par[['theta']] 41 | } 42 | 43 | #' @export 44 | get_branching_factor.hawkes_mPL <- function(model) { 45 | # assuming alpha = 2.016 46 | (model$par[['K']] * 1.016 / (1.016-model$par[['beta']]) ) * (1 / model$par[['theta']]) * (1 / model$par[['c']])^model$par[['theta']] 47 | } 48 | 49 | #' @export 50 | get_a1.hawkes_PL <- function(model) { 51 | processed_data <- preprocess_data(model$data, model$observation_time) 52 | vapply(processed_data, function(history) { 53 | sum(1 / (model$par[['theta']] * ((history$time[nrow(history)] + model$par[['c']] - history$time[-nrow(history)]) ^ model$par[['theta']]))) * model$par[['K']] 54 | }, FUN.VALUE = NA_real_) 55 | } 56 | 57 | #' @export 58 | get_a1.hawkes_mPL <- function(model) { 59 | processed_data <- preprocess_data(model$data, model$observation_time) 60 | vapply(processed_data, function(history) { 61 | sum((history$magnitude[-nrow(history)]) ^ model$par[['beta']] / (model$par[['theta']] * ((history$time[nrow(history)] + model$par[['c']] - history$time[-nrow(history)]) ^ model$par[['theta']]))) * model$par[['K']] 62 | }, FUN.VALUE = NA_real_) 63 | } 64 | 65 | #' @export 66 | predict_final_popularity.hawkes_PL <- function(model, data = NULL, observation_time = NULL) { 67 | NextMethod() 68 | } 69 | 70 | #' @export 71 | predict_final_popularity.hawkes_mPL <- function(model, data = NULL, observation_time = NULL) { 72 | NextMethod() 73 | } 74 | 75 | #' @export 76 | get_model_intensity_at.hawkes_PL <- function(model, t, cascade_index = 1) { 77 | get_model_intensity_at.hawkes_mPL(list(model_type = 'mPL', par = c(model$par, beta = 0), data = model$data), 78 | t = t, cascade_index = cascade_index) 79 | } 80 | 81 | #' @export 82 | get_model_intensity_at.hawkes_mPL <- function(model, t, cascade_index = 1) { 83 | event <- model$data[[cascade_index]] 84 | event <- event[event$time <= t, ] 85 | par <- model$par 86 | mi <- event$magnitude 87 | ti <- event$time 88 | 89 | # f(p_j) part - virality of a video. Constant for a given video 90 | fun_f <- par[["K"]] 91 | 92 | # ro(m_i) part - the influence of the user of the event 93 | fun_ro <- (mi) ^ par[["beta"]] 94 | 95 | # psi(t, ti) part - the decaying / relaxation kernel 96 | fun_psi <- 1 / (t - ti + par[["c"]])^(1+par[["theta"]]) 97 | 98 | val <- fun_f * fun_ro * fun_psi 99 | 100 | sum(val) 101 | } 102 | -------------------------------------------------------------------------------- /tests/testthat/test_simulate.R: -------------------------------------------------------------------------------- 1 | context('Simulation') 2 | 3 | test_that('max time should be smaller Tmax when set', { 4 | max_time <- 1 5 | sim <- generate_series(par = c(K = 2, theta = 1), model_type = 'EXP', Tmax = max_time)[[1]] 6 | expect_lte(sim$time[nrow(sim)], max_time) 7 | }) 8 | 9 | test_that('simulation should accept model class object', { 10 | model <- new_hawkes(par = c(K = 2, theta = 1), model_type = 'EXP') 11 | expect_error(generate_series(model = model, par = c(K = 2, theta = 1), model_type = 'EXP', Tmax = 1)) 12 | data <- generate_series(model = model, Tmax = 1) 13 | expect_true(is.list(data)) 14 | expect_s3_class(data[[1]], 'data.frame') 15 | expect_equal(data[[1]]$magnitude[1], 1) 16 | }) 17 | 18 | test_that('simulation works', { 19 | # EXP 20 | set.seed(888) 21 | par <- c(K = 0.9, theta = 1) 22 | sims <- generate_series(par = par, model_type = 'EXP', Tmax = Inf, sim_no = 1000) 23 | sizes <- sapply(sims, nrow) 24 | expect_lt(abs(mean(sizes) - 1/(1-get_branching_factor(new_hawkes(par = par, model_type = 'EXP')))), 0.2) 25 | }) 26 | 27 | test_that('compute intensity values correctly', { 28 | cascade <- data.frame(time = c(0, 1), magnitude = c(1, 2)) 29 | model1 <- new_hawkes(model_type = 'EXP', par = c(K = 0.9, theta = 1), data = cascade) 30 | v1 <- get_model_intensity_at(model1, t = 3) 31 | model2 <- new_hawkes(model_type = 'mEXP', par = c(K = 0.9, beta = 0.5, theta = 1), data = cascade) 32 | v2 <- get_model_intensity_at(model2, t = 3) 33 | model3 <- new_hawkes(model_type = 'PL', par = c(K = 0.9, theta = 1, c = 2), data = cascade) 34 | v3 <- get_model_intensity_at(model3, t = 3) 35 | model4 <- new_hawkes(model_type = 'mPL', par = c(K = 0.9, beta = 0.5, theta = 1, c = 2), data = cascade) 36 | v4 <- get_model_intensity_at(model4, t = 3) 37 | model5 <- new_hawkes(model_type = 'EXPN', par = c(K = 0.9, theta = 1, N = 10), data = cascade) 38 | v5 <- get_model_intensity_at(model5, t = 3) 39 | model6 <- new_hawkes(model_type = 'mEXPN', par = c(K = 0.9, beta = 0.5, theta = 1, N = 10), data = cascade) 40 | v6 <- get_model_intensity_at(model6, t = 3) 41 | model7 <- new_hawkes(model_type = 'PLN', par = c(K = 0.9, theta = 1, c = 2, N = 10), data = cascade) 42 | v7 <- get_model_intensity_at(model7, t = 3) 43 | model8 <- new_hawkes(model_type = 'mPLN', par = c(K = 0.9, beta = 0.5, theta = 1, c = 2, N = 10), data = cascade) 44 | v8 <- get_model_intensity_at(model8, t = 3) 45 | 46 | expect_lt(abs(v1 - 0.1666101), 1e-4) 47 | expect_lt(abs(v2 - 0.2170621), 1e-4) 48 | expect_lt(abs(v3 - 0.09225), 1e-4) 49 | expect_lt(abs(v4 - 0.1155495), 1e-4) 50 | 51 | expect_lt(abs(v5 - 0.1332881), 1e-4) 52 | expect_lt(abs(v6 - 0.1736496), 1e-4) 53 | expect_lt(abs(v7 - 0.0738), 1e-4) 54 | expect_lt(abs(v8 - 0.09243961), 1e-4) 55 | }) 56 | 57 | test_that('simulation with immgrants works', { 58 | # test CONST 59 | set.seed(888) 60 | par <- c(K = 0, theta = 1, lambda = 0.5) 61 | sims <- generate_series(par = par, model_type = c('CONST', 'EXP'), Tmax = 10, sim_no = 1000) 62 | sizes <- sapply(sims, nrow) 63 | expect_lt(abs(mean(sizes) - 10*par[['lambda']] - 1), 0.2) # HPP of intensity 5 64 | 65 | set.seed(888) 66 | par <- c(K = 0, theta = 1, lambda = 0.5) 67 | sims <- generate_series(par = par, model_type = c('CONST'), Tmax = 10, sim_no = 1000) 68 | sizes <- sapply(sims, nrow) 69 | expect_lt(abs(mean(sizes) - 10*par[['lambda']] - 1), 0.2) # HPP of intensity 5 70 | }) 71 | 72 | test_that('simulate with a given history works', { 73 | hist <- data.frame(magnitude = seq(3), time = seq(0, 2)) 74 | sim <- generate_series(par = c(K = 0.8, theta = 1), model_type = 'EXP', init_history = hist) 75 | expect_true(all(sim[[1]][1:3,] == hist)) 76 | }) 77 | 78 | test_that('simulate with background rate should work', { 79 | kernel.type <- "EXP" 80 | exo.type <- "CONST" 81 | set.seed(888) 82 | par <- c(K = 0.5, theta = 1, lambda = 0.25) 83 | 84 | hists <- generate_series(model_type = c(exo.type, kernel.type), par = par, 85 | sim_no = 1, Tmax = 100) 86 | expect_false(is.unsorted(hists[[1]]$time)) 87 | }) 88 | -------------------------------------------------------------------------------- /tests/testthat/test_model.R: -------------------------------------------------------------------------------- 1 | context('Model class') 2 | 3 | test_that('model object shoud be created', { 4 | model <- new_hawkes(par = c(K = 1, theta = 0.3), model_type = 'EXP') 5 | expect_s3_class(model, c('hawkes_EXP')) 6 | expect_s3_class(model, c('hawkes')) 7 | }) 8 | 9 | test_that('model object shoud not be created due to wrong parameters', { 10 | expect_warning(new_hawkes(par = c(1, 0.3), model_type = 'EXP')) 11 | expect_error(new_hawkes(par = c(K = 1, theta = 0.3, N = 100), model_type = 'EXP')) 12 | }) 13 | 14 | test_that('branching factors and viral scores are correctly computed', { 15 | model1 <- new_hawkes(par = c(K = 0.1, theta = 0.3), model_type = 'EXP') 16 | model2 <- new_hawkes(par = c(K = 0.1, beta = 1, theta = 0.3), model_type = 'mEXP') 17 | model3 <- new_hawkes(par = c(K = 0.1, c = 0.2, theta = 0.3), model_type = 'PL') 18 | model4 <- new_hawkes(par = c(K = 0.1, beta = 1, c = 0.2, theta = 0.3), model_type = 'mPL') 19 | 20 | model5 <- new_hawkes(par = c(K = 0.1, theta = 0.3, N = 100), model_type = 'EXPN') 21 | model6 <- new_hawkes(par = c(K = 0.1, beta = 1, theta = 0.3, N = 100), model_type = 'mEXPN') 22 | model7 <- new_hawkes(par = c(K = 0.1, c = 0.2, theta = 0.3, N = 100), model_type = 'PLN') 23 | model8 <- new_hawkes(par = c(K = 0.1, beta = 1, c = 0.2, theta = 0.3, N = 100), model_type = 'mPLN') 24 | 25 | model9 <- new_hawkes(par = c(K = 0.5, beta = 0.4, theta = 0.3), model_type = 'mEXP') 26 | model10 <- new_hawkes(par = c(K = 0.5, theta = 0.3), model_type = 'EXP') 27 | expect_equal(get_branching_factor(model1), 0.1, tolerance = 1e-6) 28 | expect_equal(get_viral_score(model1), 0.1 / (1 - 0.1), tolerance = 1e-6) 29 | expect_equal(get_branching_factor(model2), 6.35, tolerance = 1e-6) 30 | expect_equal(get_viral_score(model2, m_0 = 2), Inf, tolerance = 1e-6) 31 | expect_equal(get_viral_score(model2, m_0 = 0), 0, tolerance = 1e-6) 32 | expect_equal(get_branching_factor(model3), 0.5402189, tolerance = 1e-6) 33 | expect_equal(get_viral_score(model3), 0.5402189/(1 - 0.5402189), tolerance = 1e-6) 34 | expect_equal(get_branching_factor(model4), 34.3039, tolerance = 1e-6) 35 | 36 | expect_equal(get_branching_factor(model5), 0.1, tolerance = 1e-6) 37 | expect_equal(get_branching_factor(model6), 6.35, tolerance = 1e-6) 38 | expect_equal(get_branching_factor(model7), 0.5402189, tolerance = 1e-6) 39 | expect_equal(get_branching_factor(model8), 34.3039, tolerance = 1e-6) 40 | 41 | expect_equal(get_viral_score(model9, m_0 = 100), 100^0.4*get_branching_factor(model10)/(1-get_branching_factor(model9)), tolerance = 1e-6) 42 | }) 43 | 44 | test_that('fianl popularities are correctly computed', { 45 | data <- list(data.frame(time = seq(0, 5), magnitude = rep(1, 6)), 46 | data.frame(time = seq(0, 5), magnitude = rep(1, 6))) 47 | model <- new_hawkes(model_type = 'EXP', par = c(K=0.8, theta = 1), data = data, observation_time = 10) 48 | expect_equal(predict_final_popularity(model), c(12.08506), tolerance = 1e-6) 49 | 50 | model <- new_hawkes(model_type = 'mEXP', par = c(K=0.8, beta = 0.1, theta = 1), data = data, observation_time = 10) 51 | expect_equal(predict_final_popularity(model), c(12.151), tolerance = 1e-6) 52 | 53 | model <- new_hawkes(model_type = 'mEXP', par = c(K=1, beta = 0.1, theta = 1), data = data, observation_time = 10) 54 | expect_warning(expect_equal(predict_final_popularity(model), c(Inf), tolerance = 1e-6)) 55 | 56 | model <- new_hawkes(model_type = 'PL', par = c(K=0.8, theta = 1, c = 1), data = data, observation_time = 10) 57 | expect_equal(predict_final_popularity(model), c(8.9461760*2), tolerance = 1e-6) 58 | 59 | model <- new_hawkes(model_type = 'mPL', par = c(K=0.8, beta = 0.1, theta = 1, c = 1), data = data, observation_time = 10) 60 | expect_equal(predict_final_popularity(model), c(11.2300334*2), tolerance = 1e-6) 61 | 62 | model <- new_hawkes(model_type = 'EXPN', par = c(K=0.8, theta = 1, N = 100), data = data, observation_time = 10) 63 | expect_error(predict_final_popularity(model)) 64 | }) 65 | 66 | test_that('SEISMIC prediction works', { 67 | library(seismic) 68 | data(tweet) 69 | pred.time <- 1000 70 | infectiousness <- get.infectiousness(tweet[, 1], tweet[, 2], pred.time) 71 | pred <- pred.cascade(pred.time, infectiousness$infectiousness, tweet[, 1], tweet[, 2], n.star = 100)[1,1] + 1 72 | names(tweet) <- c('time', 'magnitude') 73 | fitted <- fit_series(data = tweet, model_type = 'SEISMIC', observation_time = pred.time) 74 | expect_lt(abs(pred - predict_final_popularity(fitted)), 1e-7) 75 | }) 76 | -------------------------------------------------------------------------------- /docs/bootstrap-toc.js: -------------------------------------------------------------------------------- 1 | /*! 2 | * Bootstrap Table of Contents v0.4.1 (http://afeld.github.io/bootstrap-toc/) 3 | * Copyright 2015 Aidan Feldman 4 | * Licensed under MIT (https://github.com/afeld/bootstrap-toc/blob/gh-pages/LICENSE.md) */ 5 | (function() { 6 | 'use strict'; 7 | 8 | window.Toc = { 9 | helpers: { 10 | // return all matching elements in the set, or their descendants 11 | findOrFilter: function($el, selector) { 12 | // http://danielnouri.org/notes/2011/03/14/a-jquery-find-that-also-finds-the-root-element/ 13 | // http://stackoverflow.com/a/12731439/358804 14 | var $descendants = $el.find(selector); 15 | return $el.filter(selector).add($descendants).filter(':not([data-toc-skip])'); 16 | }, 17 | 18 | generateUniqueIdBase: function(el) { 19 | var text = $(el).text(); 20 | var anchor = text.trim().toLowerCase().replace(/[^A-Za-z0-9]+/g, '-'); 21 | return anchor || el.tagName.toLowerCase(); 22 | }, 23 | 24 | generateUniqueId: function(el) { 25 | var anchorBase = this.generateUniqueIdBase(el); 26 | for (var i = 0; ; i++) { 27 | var anchor = anchorBase; 28 | if (i > 0) { 29 | // add suffix 30 | anchor += '-' + i; 31 | } 32 | // check if ID already exists 33 | if (!document.getElementById(anchor)) { 34 | return anchor; 35 | } 36 | } 37 | }, 38 | 39 | generateAnchor: function(el) { 40 | if (el.id) { 41 | return el.id; 42 | } else { 43 | var anchor = this.generateUniqueId(el); 44 | el.id = anchor; 45 | return anchor; 46 | } 47 | }, 48 | 49 | createNavList: function() { 50 | return $(''); 51 | }, 52 | 53 | createChildNavList: function($parent) { 54 | var $childList = this.createNavList(); 55 | $parent.append($childList); 56 | return $childList; 57 | }, 58 | 59 | generateNavEl: function(anchor, text) { 60 | var $a = $(''); 61 | $a.attr('href', '#' + anchor); 62 | $a.text(text); 63 | var $li = $('
  • '); 64 | $li.append($a); 65 | return $li; 66 | }, 67 | 68 | generateNavItem: function(headingEl) { 69 | var anchor = this.generateAnchor(headingEl); 70 | var $heading = $(headingEl); 71 | var text = $heading.data('toc-text') || $heading.text(); 72 | return this.generateNavEl(anchor, text); 73 | }, 74 | 75 | // Find the first heading level (`

    `, then `

    `, etc.) that has more than one element. Defaults to 1 (for `

    `). 76 | getTopLevel: function($scope) { 77 | for (var i = 1; i <= 6; i++) { 78 | var $headings = this.findOrFilter($scope, 'h' + i); 79 | if ($headings.length > 1) { 80 | return i; 81 | } 82 | } 83 | 84 | return 1; 85 | }, 86 | 87 | // returns the elements for the top level, and the next below it 88 | getHeadings: function($scope, topLevel) { 89 | var topSelector = 'h' + topLevel; 90 | 91 | var secondaryLevel = topLevel + 1; 92 | var secondarySelector = 'h' + secondaryLevel; 93 | 94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector); 95 | }, 96 | 97 | getNavLevel: function(el) { 98 | return parseInt(el.tagName.charAt(1), 10); 99 | }, 100 | 101 | populateNav: function($topContext, topLevel, $headings) { 102 | var $context = $topContext; 103 | var $prevNav; 104 | 105 | var helpers = this; 106 | $headings.each(function(i, el) { 107 | var $newNav = helpers.generateNavItem(el); 108 | var navLevel = helpers.getNavLevel(el); 109 | 110 | // determine the proper $context 111 | if (navLevel === topLevel) { 112 | // use top level 113 | $context = $topContext; 114 | } else if ($prevNav && $context === $topContext) { 115 | // create a new level of the tree and switch to it 116 | $context = helpers.createChildNavList($prevNav); 117 | } // else use the current $context 118 | 119 | $context.append($newNav); 120 | 121 | $prevNav = $newNav; 122 | }); 123 | }, 124 | 125 | parseOps: function(arg) { 126 | var opts; 127 | if (arg.jquery) { 128 | opts = { 129 | $nav: arg 130 | }; 131 | } else { 132 | opts = arg; 133 | } 134 | opts.$scope = opts.$scope || $(document.body); 135 | return opts; 136 | } 137 | }, 138 | 139 | // accepts a jQuery object, or an options object 140 | init: function(opts) { 141 | opts = this.helpers.parseOps(opts); 142 | 143 | // ensure that the data attribute is in place for styling 144 | opts.$nav.attr('data-toggle', 'toc'); 145 | 146 | var $topContext = this.helpers.createChildNavList(opts.$nav); 147 | var topLevel = this.helpers.getTopLevel(opts.$scope); 148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel); 149 | this.helpers.populateNav($topContext, topLevel, $headings); 150 | } 151 | }; 152 | 153 | $(function() { 154 | $('nav[data-toggle="toc"]').each(function(i, el) { 155 | var $nav = $(el); 156 | Toc.init($nav); 157 | }); 158 | }); 159 | })(); 160 | -------------------------------------------------------------------------------- /docs/authors.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Authors • evently 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 55 | 56 | 57 | 58 | 59 | 60 | 61 |
    62 |
    63 | 109 | 110 | 111 | 112 |
    113 | 114 |
    115 |
    116 |
    117 |

    Authors

    118 |
    119 | 120 |
      121 |
    • 122 |

      Quyu Kong. Author, maintainer. 123 |

      124 |
      • 125 |
    • 126 |

      Marian-Andrei Rizoiu. Author. 127 |

      128 |
      • 129 |
    130 | 131 |
    132 | 133 |
    134 | 135 | 136 | 137 |
    138 |
    139 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    140 |
    141 | 142 |
    143 |

    Site built with pkgdown 1.6.1.

    144 |
    145 | 146 |
    147 |
    148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | -------------------------------------------------------------------------------- /docs/404.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Page not found (404) • evently 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 55 | 56 | 57 | 58 | 59 | 60 | 61 |
    62 |
    63 | 109 | 110 | 111 | 112 |
    113 | 114 |
    115 |
    116 |
    117 |

    Page not found (404)

    118 |
    119 | 120 | Content not found. Please use links in the navbar. 121 | 122 |
    123 | 124 | 129 | 130 |
    131 | 132 | 133 | 134 |
    135 |
    136 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    137 |
    138 | 139 |
    140 |

    Site built with pkgdown 1.6.1.

    141 |
    142 | 143 |
    144 |
    145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | -------------------------------------------------------------------------------- /docs/articles/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Articles • evently 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 55 | 56 | 57 | 58 | 59 | 60 | 61 |
    62 |
    63 | 109 | 110 | 111 | 112 |
    113 | 114 |
    115 |
    116 |
    117 |

    Articles

    118 |
    119 | 120 |
    121 |

    All vignettes

    122 |

    123 | 124 |
    125 |
    Profiling Twitter users with diffusions
    126 |
    127 |
    128 |
    129 |
    130 |
    131 | 132 | 133 |
    134 |
    135 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    136 |
    137 | 138 |
    139 |

    Site built with pkgdown 1.6.1.

    140 |
    141 | 142 |
    143 |
    144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | -------------------------------------------------------------------------------- /docs/reference/evently.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Fitting Hawkes processes with AMPL — evently • evently 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 57 | 58 | 59 | 60 | 61 | 62 | 63 |
    64 |
    65 | 111 | 112 | 113 | 114 |
    115 | 116 |
    117 |
    118 |
    119 |

    Fitting Hawkes processes with AMPL

    120 | 121 | 122 |
    123 | 124 |
    125 |

    To learn more about evently, start with the vignettes: 126 | `browseVignettes(package = "evently")`

    127 |
    128 | 129 | 130 | 131 | 132 |
    133 | 138 |
    139 | 140 | 141 |
    142 |
    143 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    144 |
    145 | 146 |
    147 |

    Site built with pkgdown 1.6.1.

    148 |
    149 | 150 |
    151 |
    152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | -------------------------------------------------------------------------------- /R/model.R: -------------------------------------------------------------------------------- 1 | # this script define methods for the model class 2 | 3 | # default model class methods 4 | 5 | # translate the given model types to the right S3 class name. 6 | # The model types could be a combination of different models 7 | interpret_model_type <- function(model_type) { 8 | IMMIGRANT_TYPES <- c('CONST') 9 | DECAY_TYPES <- c('EXPN', 'EXP', 'mEXP', 'mEXPN', 'PL', 'mPL', 'PLN', 'mPLN') 10 | if (class(model_type) == 'hawkes_model_type') { 11 | return(model_type) 12 | } else if (length(model_type) == 1 && is.character(model_type)) { 13 | if (model_type %in% IMMIGRANT_TYPES) return(hawkes_model_type(hawkes_immigrant_type = model_type)) 14 | else return(hawkes_model_type(hawkes_decay_type = model_type)) 15 | } else if (length(model_type) == 2) { 16 | if (is.null(names(model_type))) { 17 | return(hawkes_model_type(hawkes_decay_type = DECAY_TYPES[DECAY_TYPES %in% model_type], 18 | hawkes_immigrant_type = IMMIGRANT_TYPES[IMMIGRANT_TYPES %in% model_type])) 19 | } else { 20 | stopifnot(all(c('hawkes_decay_type', 'hawkes_immigrant_type') %in% names(model_type))) 21 | return(hawkes_model_type(hawkes_decay_type = model_type[['hawkes_decay_type']], 22 | hawkes_immigrant_type = model_type[['hawkes_immigrant_type']])) 23 | } 24 | } else { 25 | stop('Unknown model type!') 26 | } 27 | } 28 | 29 | hawkes_model_type <- function(hawkes_decay_type = NULL, hawkes_immigrant_type = NULL) { 30 | ret <- list() 31 | if (!is.null(hawkes_decay_type)) ret$hawkes_decay_type <- hawkes_decay_type 32 | if (!is.null(hawkes_immigrant_type)) ret$hawkes_immigrant_type <- hawkes_immigrant_type 33 | class(ret) <- 'hawkes_model_type' 34 | ret 35 | } 36 | 37 | #' @export 38 | as.character.hawkes_model_type <- function(x, ...) { 39 | paste(unlist(x), collapse = '_') 40 | } 41 | 42 | get_ampl_likelihood.default <- function(model) { 43 | stop('Unknown model type!') 44 | } 45 | 46 | get_ampl_constraints.default <- function(model) { 47 | stop('Unknown model type!') 48 | } 49 | 50 | #' @export 51 | get_branching_factor.default <- function(model) { 52 | stop('Unknown model type!') 53 | } 54 | 55 | #' @export 56 | predict_final_popularity.default <- function(model, data, observation_time) { 57 | stop('Unknown model type!') 58 | } 59 | 60 | #' @export 61 | get_a1.default <- function(model) { 62 | stop('Unknown model type!') 63 | } 64 | 65 | #' @export 66 | get_viral_score.default <- function(model, m_0 = NULL) { 67 | stop('Unknown model type!') 68 | } 69 | 70 | #' @export 71 | get_model_intensity_at.default <- function(model, t, cascade_index = 1) { 72 | stop('Unknown model type!') 73 | } 74 | 75 | fit_series_by_model.default <- function(model, cores, init_pars, parallel_type, .init_no, ...) { 76 | stop('Unknown model type!') 77 | } 78 | 79 | # function dispatchers 80 | generate_random_points <- function(obj) { 81 | UseMethod('generate_random_points', obj) 82 | } 83 | 84 | get_param_names <- function(obj) { 85 | UseMethod('get_param_names') 86 | } 87 | 88 | get_lower_bound <- function(obj) { 89 | UseMethod('get_lower_bound') 90 | } 91 | 92 | get_upper_bound <- function(obj) { 93 | UseMethod('get_upper_bound') 94 | } 95 | 96 | get_ampl_likelihood <- function(obj) { 97 | UseMethod('get_ampl_likelihood') 98 | } 99 | 100 | get_ampl_constraints <- function(obj) { 101 | UseMethod('get_ampl_constraints') 102 | } 103 | 104 | #' Branching factor is the expected number of events generated 105 | #' by a single event. 106 | #' @param model A model object for computing the branching factor. 107 | #' @return A single number, the branching factor of the given model 108 | #' @export 109 | get_branching_factor <- function(model) { 110 | UseMethod('get_branching_factor') 111 | } 112 | 113 | #' Predict the final popularity (event count) of give histories and 114 | #' its model parameters. 115 | #' @param model A model object provides data, model_type, observation_time 116 | #' and model parameters 117 | #' @param data A given cascade whose final popularity will be predicted 118 | #' @param observation_time The observation time of the given cascade 119 | #' @return a vector of predicted final popularities whose length is the same 120 | #' as the number of cascades in the provided model object 121 | #' @export 122 | predict_final_popularity <- function(model, data = NULL, observation_time = NULL) { 123 | UseMethod('predict_final_popularity') 124 | } 125 | 126 | #' Calculating the expected size of first level of descendants 127 | #' @param model A model object provides data, model_type, observation_time 128 | #' and model parameters 129 | #' @return a vector of the expected sizes of first level of descendants of the 130 | #' given cascades 131 | #' @export 132 | get_a1 <- function(model) { 133 | UseMethod('get_a1') 134 | } 135 | 136 | #' Viral score is the total reaction of the system to a single promotion, 137 | #' i.e. the expected cascade size started by a single event of magnitude 138 | #' @param model A model object for computing the branching factor. 139 | #' @param m_0 The magnitude of the initial post for computing its viral score. 140 | #' The first magnitude value in model$data[[1]] will be used if not provided. 141 | #' @return A single number, the viral score of the given model 142 | #' @export 143 | get_viral_score <- function(model, m_0 = NULL) { 144 | UseMethod('get_viral_score') 145 | } 146 | 147 | #' Compute the intensity value of a given model at time t 148 | #' @param model A model object for computing the intensity value 149 | #' @param t The given time to compute the intensity 150 | #' @param cascade_index Determine which cascade in the list of cascades to compute, defaults to 1 151 | #' @return A single number, the intensity value of the given model evaluated at t 152 | #' @export 153 | get_model_intensity_at <- function(model, t, cascade_index = 1) { 154 | UseMethod('get_model_intensity_at') 155 | } 156 | 157 | get_ampl_data_output <- function(obj) { 158 | UseMethod('get_ampl_data_output') 159 | } 160 | 161 | get_ampl_model_output <- function(obj) { 162 | UseMethod('get_ampl_model_output') 163 | } 164 | 165 | get_ampl_execution_options <- function(model) { 166 | UseMethod('get_ampl_execution_options') 167 | } 168 | 169 | fit_series_by_model <- function(model, cores, init_pars, parallel_type, .init_no, ...) { 170 | UseMethod('fit_series_by_model') 171 | } 172 | -------------------------------------------------------------------------------- /R/fit.R: -------------------------------------------------------------------------------- 1 | # This script hosts functions that handle the data preprocessing and model selection. 2 | 3 | #' Fit a Hawkes process or HawkesN process model on one or many event cascades 4 | #' and learn model parameters. 5 | #' 6 | #' @param data A list of data.frame(s) where each data.frame is an event cascade with event 7 | #' tims and event magnitudes (optional) 8 | #' @param model_type A string representing the model type, e.g. EXP for Hawkes processes with 9 | #' an exponential kernel function 10 | #' @param cores The number of cores used for parallel fitting, defaults to 1 (non-parallel) 11 | #' @param init_pars A data.frame of initial parameters passed to the fitting program. Parameters should be 12 | #' aligned with required ones for the corresponding "model_type". The default initial parameters will 13 | #' be used if not provided. 14 | #' @param .init_no If initi_pars is not provided, currently 10 random starting parameters are generated 15 | #' for fitting. This controls which random points are used. Defaults to NULL 16 | #' @param observation_time The event cascades observation time(s). This can either be a single number indicating 17 | #' a common observation time for all cascades or a vector of observation times which has the same length as 18 | #' the number of cascades. 19 | #' @param lower_bound Model parameter lower bounds. A named vector where names are model parameters and 20 | #' values are the lowest possible values. 21 | #' @param upper_bound Model parameter upper bounds. A named vector where names are model parameters and 22 | #' values are the largest possible values. 23 | #' @param limit_event Define the way to optimize the computation by reducing the number of events added in log-likelihood (LL) functions, 24 | #' defaults to NULL, i.e., no optimization. To limit the number of events computed, a list with `type` and `value` shoud be provided. 25 | #' For example, limit_event = list(type = "event", value = 10) limits the LL fitting to 10 events, 26 | #' limit_event = list(type = "time", value = 10) limits the LL fitting to the events within past 10 time units. 27 | #' The best practice to trade-off the computation could be to limit to the largest number of events that one can afford. 28 | #' @param model_vars A named list of extra variables provided to hawkes objects 29 | #' @param parallel_type One of "PSOCK" or "FORK". Default to "PSOCK". See "Details" in makeCluster {parallel}. 30 | #' @param ... Further arguments passed to ampl 31 | #' @import parallel 32 | #' @return A model object where the [par] is fitted on [data]. [convergence] indicates the fitting convergence 33 | #' status and [value] is the negative log-likelihood value of the fitted model on [data]. 34 | #' @export 35 | #' @examples 36 | #' \dontrun{ 37 | #' data <- generate_series(model_type = 'EXP', 38 | #' par = c(K = 0.9, theta = 1), 39 | #' sim_no = 10, Tmax = Inf) 40 | #' fitted <- fit_series(data, 'EXP', observation_time = Inf) 41 | #' fitted$par # fitted parameters 42 | #' fitted$convergence # convergence status 43 | #' fitted$value # negative log-likelihood value 44 | #' } 45 | fit_series <- function(data, model_type, cores = 1, init_pars = NULL, .init_no = NULL, observation_time = NULL, 46 | lower_bound = NULL, upper_bound = NULL, limit_event = NULL, model_vars = NULL, parallel_type = 'PSOCK', ...) { 47 | data <- preparation(data) 48 | model <- new_hawkes(data = data, model_type = model_type, observation_time = observation_time, 49 | lower_bound = lower_bound, upper_bound = upper_bound, model_vars = model_vars, limit_event = limit_event) 50 | fit_series_by_model(model, cores = cores, init_pars = init_pars, .init_no = .init_no, 51 | parallel_type = parallel_type, ...) 52 | } 53 | 54 | #' Compute the negative log-likelihood values of a given model on a list of given 55 | #' event cascades. 56 | #' 57 | #' @param model An object of a specific model class where the `data` and the `par` fields 58 | #' are required. 59 | #' @param ... Further arguments passed to ampl 60 | #' @param par Hawkes model parameters 61 | #' @param data A list of data.frames of event cascades 62 | #' @param model_type The Hawkes model type 63 | #' @param observation_time The observation time of the given event cascades 64 | #' @return A single number, the negative log-likelihood of the given model on data 65 | #' @export 66 | #' @examples 67 | #' \dontrun{ 68 | #' data <- generate_series(model_type = 'EXP', 69 | #' par = c(K = 0.9, theta = 1), 70 | #' sim_no = 10, Tmax = Inf) 71 | #' fitted <- fit_series(data, 'EXP', observation_time = Inf) 72 | #' data_test <- generate_series(model_type = 'EXP', 73 | #' par = c(K = 0.9, theta = 1), 74 | #' sim_no = 10, Tmax = Inf) 75 | #' get_hawkes_neg_likelihood_value(fitted, data = data_test) 76 | #' } 77 | get_hawkes_neg_likelihood_value <- function(model, ..., par, data, model_type, observation_time) { 78 | # par and data are required for computing log-likelihood values 79 | if (!missing(model) && missing(model_type)) { 80 | if (!missing(par)) model$par <- par 81 | if (!missing(data)) model$data <- convert_data_format(data) 82 | check_required_hawkes_fields(model, c('par', 'data')) 83 | } else if (missing(par) || missing(data) || missing(model_type)) { 84 | stop('Neither an model object nor par,data,model_type are provided!') 85 | } else { 86 | model <- new_hawkes(model_type = model_type, par = par, data = data) 87 | } 88 | if (!missing(observation_time)) model$observation_time <- observation_time 89 | 90 | # a trick to reuse existing functions 91 | # have made sure this won't affect the original model object 92 | model$init_par <- model$par 93 | ampl_run(model, goal = 'nll', ...) 94 | } 95 | 96 | model_selection <- function(models, cores, ...) { 97 | if (length(models) == 1) return(models[[1]]) 98 | 99 | ## score each model -- don't trust the algorithms own value, redo my own. 100 | nLLs <- simplify2array(mclapply(models, function(model) { 101 | get_hawkes_neg_likelihood_value(model, ...) 102 | }, mc.cores = cores), higher = F) 103 | if (all(is.na(nLLs))) stop('something went wrong! All neg.likelihood values are missing') 104 | 105 | models[[which.min(nLLs)]] 106 | } 107 | 108 | preparation <- function(data) { 109 | # check if ampl is available 110 | if (any(Sys.which(c('ampl', 'ipopt')) == '') && Sys.getenv('AMPL_PATH') == '') { 111 | stop('Please set up ampl and ipopt before fitting!') 112 | } 113 | 114 | convert_data_format(data) 115 | } 116 | -------------------------------------------------------------------------------- /docs/reference/auspol.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | `#auspol` hash tagged retweet diffusions — auspol • evently 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 56 | 57 | 58 | 59 | 60 | 61 | 62 |
    63 |
    64 | 110 | 111 | 112 | 113 |
    114 | 115 |
    116 |
    117 |
    118 |

    `#auspol` hash tagged retweet diffusions

    119 | 120 | 121 |
    122 | 123 |
    124 |

    A dataset containing retweet event diffusions relating to tweets hash tagged with `auspol`

    125 |
    126 | 127 | 
    auspol
    128 | 129 | 130 |

    Format

    131 | 132 |

    A list of 3333 data frames with three columns:

    133 |
    time

    Relative retweet times w.r.t the initial tweet

    134 |
    magnitude

    The number of followers a corresponding Twitter user has

    135 |
    user

    An anonymized Twitter user id who created the tweet/retweet

    136 | 137 |
    138 | 139 | 140 |
    141 | 146 |
    147 | 148 | 149 |
    150 |
    151 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    152 |
    153 | 154 |
    155 |

    Site built with pkgdown 1.6.1.

    156 |
    157 | 158 |
    159 |
    160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | -------------------------------------------------------------------------------- /tests/testthat/test_fit.R: -------------------------------------------------------------------------------- 1 | context('Fit on cascades') 2 | 3 | test_that('fit on a dataframe is allowed', { 4 | cascade <- data.frame(time = seq(10), magnitude = seq(10)) 5 | expect_equal(fit_series(cascade, model_type = 'EXP')$convergence, 0) 6 | }) 7 | 8 | test_that('data without magnitudes is allowed', { 9 | cascade <- data.frame(time = seq(10)) 10 | expect_equal(fit_series(cascade, model_type = 'EXP')$convergence, 0) 11 | }) 12 | 13 | test_that('Debug is possible', { 14 | cascade <- data.frame(time = seq(0, 10), magnitude = seq(11)) 15 | expect_error(fit_series(list(cascade), model_type = 'EXP', observation_time = Inf, debug = T), regexp = 'Debugging is on!') 16 | }) 17 | 18 | test_that('Errors for only single event cascades', { 19 | cascade <- data.frame(time = 0, magnitude = 1) 20 | expect_error(fit_series(list(cascade), model_type = 'EXP'), regexp = 'Please double check the observation time!') 21 | }) 22 | 23 | test_that('Data sliced when observation time is smaller than last event time', { 24 | cascade <- data.frame(time = c(0, 5), magnitude = c(1, 1)) 25 | expect_warning(fitted <- fit_series(list(cascade), model_type = 'EXP', observation_time = 1)) 26 | expect_warning(get_hawkes_neg_likelihood_value(fitted)) 27 | }) 28 | 29 | test_that('fitting works', { 30 | set.seed(888) 31 | par <- c(K = 1.3, theta = 1, N = 100) 32 | par_data_frame <- as.data.frame(t(par)) 33 | sims <- generate_series(par = par, model_type = 'EXPN') 34 | sims <- lapply(sims, function(.x) cbind(.x, data.frame(test = rep(1, nrow(.x))))) 35 | fitted <- fit_series(data = sims, model_type = 'EXPN', observation_time = Inf, init_pars = par_data_frame) 36 | expect_equal(fitted$convergence, 0) 37 | expect_equal(nrow(fitted$data[[1]]), nrow(sims[[1]])) 38 | expect_true(all(fitted$init_par == par)) 39 | 40 | # test parallel fitting 41 | par_data_frame <- rbind(par_data_frame, par_data_frame) 42 | fitted <- fit_series(data = sims, model_type = 'EXPN', observation_time = Inf, cores = 2, init_pars = par_data_frame) 43 | expect_equal(fitted$convergence, 0) 44 | expect_equal(nrow(fitted$data[[1]]), nrow(sims[[1]])) 45 | expect_true(all(fitted$init_par == par)) 46 | fitted <- fit_series(data = sims, model_type = 'EXPN', observation_time = Inf, cores = 2, init_pars = par_data_frame, parallel_type = 'FORK') 47 | expect_equal(fitted$convergence, 0) 48 | expect_equal(nrow(fitted$data[[1]]), nrow(sims[[1]])) 49 | expect_true(all(fitted$init_par == par)) 50 | 51 | # a testing data.frame 52 | test_sim <- list(data.frame(time = c(0, 1, 1, 1, 2, 2, 2), magnitude = rep(1, 7))) 53 | fitted <- fit_series(test_sim, model_type = 'EXP', observation_time = 2) 54 | expect_equal(fitted$convergence, 0) 55 | }) 56 | 57 | test_that('fitting works for PL', { 58 | set.seed(888) 59 | par <- c(K = 1.3, c = 1, theta = 1) 60 | sims <- generate_series(par = par, model_type = 'PL') 61 | fitted <- fit_series(data = sims, model_type = 'PL', observation_time = Inf) 62 | expect_equal(fitted$convergence, 0) 63 | expect_equal(nrow(fitted$data[[1]]), nrow(sims[[1]])) 64 | }) 65 | 66 | test_that('simulating and fitting are working for EXPN', { 67 | set.seed(888) 68 | cut_time <- 7 69 | par <- c(K = 1.3, theta = 1, N = 100) 70 | sims <- generate_series(par = par, model_type = 'EXPN', Tmax = cut_time, sim_no = 500) 71 | sims <- lapply(sims, function(.x) .x[.x$time < cut_time, ]) 72 | fitted <- lapply(seq(10), function(i) {fit_series(sims[(50*(i-1) +1):(50*i)], cores = 1, model_type = 'EXPN', lower_bound = c(K = 1e-100, theta = 1e-100, N = 100), upper_bound = c(K = 1e+6, theta = 1e+3, N = 100), observation_time = cut_time)}) 73 | expect_true(fitted[[1]]$init_par[[1]] != fitted[[1]]$par[[1]]) 74 | fitted_par <- do.call(rbind.data.frame, lapply(fitted, function(.x) as.list(.x[['par']]))) 75 | expect_true(all(abs(apply(fitted_par, 2, mean) - par) < 1e-1)) 76 | }) 77 | 78 | test_that('infinity observation time works for EXPN', { 79 | set.seed(888) 80 | par <- c(K = 5, theta = 1, N = 50) 81 | sims <- generate_series(par = par, model_type = 'EXPN', Tmax = Inf, sim_no = 50) 82 | fitted <- fit_series(sims, cores = 1, model_type = 'EXPN', observation_time = Inf) 83 | expect_true(fitted$init_par[[1]] != fitted$par[[1]]) 84 | expect_true(all(abs(fitted$par- par) < 5e-1)) 85 | }) 86 | 87 | test_that('random observation times works for EXPN', { 88 | set.seed(889) 89 | par <- c(K = 5, theta = 0.2, N = 50) 90 | observation_times <- runif(50, 5, 20) 91 | sims <- lapply(seq(50), function(i) generate_series(par = par, model_type = 'EXPN', Tmax = observation_times[i], sim_no = 1)[[1]]) 92 | fitted <- fit_series(sims, cores = 1, model_type = 'EXPN', observation_time = observation_times) 93 | expect_true(fitted$init_par[[1]] != fitted$par[[1]]) 94 | expect_true(all(abs(fitted$par- par) < 5e-1)) 95 | }) 96 | 97 | 98 | test_that('compute holdout log-likelihood works', { 99 | cut_time <- 7 100 | par <- c(K = 1.3, theta = 1) 101 | model <- new_hawkes(model_type = 'EXP', data = list(data.frame(time = 0, magnitude = 1)), observation_time = Inf, par = par) 102 | nll <- get_hawkes_neg_likelihood_value(model) 103 | expect_lt(abs(nll - par[['K']]), 1e-10) 104 | nll <- get_hawkes_neg_likelihood_value(par = model$par, data = model$data, model_type = model$model_type, observation_time = model$observation_time) 105 | expect_lt(abs(nll - par[['K']]), 1e-10) 106 | nll <- get_hawkes_neg_likelihood_value(model, observation_time = 1) 107 | expect_lt(abs(nll - par[['K']] * (1 - exp(-1 * par['theta']))), 1e-5) 108 | nll <- get_hawkes_neg_likelihood_value(par = model$par, data = model$data[[1]], model_type = model$model_type, observation_time = model$observation_time) 109 | expect_lt(abs(nll - par[['K']]), 1e-10) 110 | }) 111 | 112 | test_that('fit with constant background rate works', { 113 | cascade <- data.frame(time = seq(0, 10), magnitude = seq(11)) 114 | fitted <- fit_series(cascade, model_type = c('EXP', 'CONST')) 115 | expect_s3_class(fitted, 'hawkes') 116 | }) 117 | 118 | test_that('fit with limit_event should work', { 119 | cascade <- data.frame(time = seq(0, 10), magnitude = seq(11)) 120 | expect_error(fit_series(cascade, model_type = 'EXP', limit_event = list())) 121 | expect_error(fit_series(cascade, model_type = 'EXP', limit_event = list(type = 'wrongtype'))) 122 | }) 123 | 124 | 125 | test_that('fit DMM should work', { 126 | datas <- list( 127 | data.frame(time = seq(0, 10), magnitude = seq(11)), 128 | data.frame(time = 0, magnitude = 1), 129 | data.frame(time = seq(0, 10), magnitude = seq(11)), 130 | data.frame(time = seq(0, 10), magnitude = seq(11)) 131 | ) 132 | res <- fit_series(datas, model_type = 'DMM') 133 | expect_false(any(is.null(res$par))) 134 | }) 135 | -------------------------------------------------------------------------------- /docs/reference/prepare_tmp_file.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Prepare the temporary auxilixry files for AMPL — prepare_tmp_file • evently 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 56 | 57 | 58 | 59 | 60 | 61 | 62 |
    63 |
    64 | 110 | 111 | 112 | 113 |
    114 | 115 |
    116 |
    117 |
    118 |

    Prepare the temporary auxilixry files for AMPL

    119 | 120 | 121 |
    122 | 123 |
    124 |

    Prepare the temporary auxilixry files for AMPL

    125 |
    126 | 127 | 
    prepare_tmp_file(type)
    128 | 129 |

    Arguments

    130 | 131 | 132 | 133 | 134 | 136 | 137 |
    type

    One of "mod" (AMPL model file), "dat" (AMPL data file), 135 | "run" (AMPL run file) and "res" (file hosts AMPL runned output)

    138 | 139 | 140 |
    141 | 146 |
    147 | 148 | 149 |
    150 |
    151 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    152 |
    153 | 154 |
    155 |

    Site built with pkgdown 1.6.1.

    156 |
    157 | 158 |
    159 |
    160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | -------------------------------------------------------------------------------- /docs/reference/set_tmp_folder.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Set up the folder for placing temporary files, defaults to /tmp — set_tmp_folder • evently 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 56 | 57 | 58 | 59 | 60 | 61 | 62 |
    63 |
    64 | 110 | 111 | 112 | 113 |
    114 | 115 |
    116 |
    117 |
    118 |

    Set up the folder for placing temporary files, defaults to /tmp

    119 | 120 | 121 |
    122 | 123 |
    124 |

    Set up the folder for placing temporary files, defaults to /tmp

    125 |
    126 | 127 | 
    set_tmp_folder(path)
    128 | 129 |

    Arguments

    130 | 131 | 132 | 133 | 134 | 135 | 136 |
    path

    A string of path to the folder where you would like to place temporary files

    137 | 138 | 139 |
    140 | 145 |
    146 | 147 | 148 |
    149 |
    150 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    151 |
    152 | 153 |
    154 |

    Site built with pkgdown 1.6.1.

    155 |
    156 | 157 |
    158 |
    159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | -------------------------------------------------------------------------------- /docs/reference/plot_kernel_function.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Plot the kernel functions of Hawkes processes — plot_kernel_function • evently 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 56 | 57 | 58 | 59 | 60 | 61 | 62 |
    63 |
    64 | 110 | 111 | 112 | 113 |
    114 | 115 |
    116 |
    117 |
    118 |

    Plot the kernel functions of Hawkes processes

    119 | 120 | 121 |
    122 | 123 |
    124 |

    Plot the kernel functions of Hawkes processes

    125 |
    126 | 127 | 
    plot_kernel_function(fitted_models)
    128 | 129 |

    Arguments

    130 | 131 | 132 | 133 | 134 | 135 | 136 |
    fitted_models

    A list of fitted model objects to plot the kernel functions

    137 | 138 |

    Value

    139 | 140 |

    A ggplot object

    141 | 142 |
    143 | 148 |
    149 | 150 | 151 |
    152 |
    153 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    154 |
    155 | 156 |
    157 |

    Site built with pkgdown 1.6.1.

    158 |
    159 | 160 |
    161 |
    162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | -------------------------------------------------------------------------------- /docs/reference/fits_dist_matrix.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Given a list of grouped fits, compute a distance matrix — fits_dist_matrix • evently 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 56 | 57 | 58 | 59 | 60 | 61 | 62 |
    63 |
    64 | 110 | 111 | 112 | 113 |
    114 | 115 |
    116 |
    117 |
    118 |

    Given a list of grouped fits, compute a distance matrix

    119 | 120 | 121 |
    122 | 123 |
    124 |

    Given a list of grouped fits, compute a distance matrix

    125 |
    126 | 127 | 
    fits_dist_matrix(group_fits)
    128 | 129 |

    Arguments

    130 | 131 | 132 | 133 | 134 | 135 | 136 |
    group_fits

    A list of grouped fits returned by group_fit_series

    137 | 138 |

    Value

    139 | 140 |

    A dist matrix of pairwise distances between each group-fit

    141 | 142 |
    143 | 148 |
    149 | 150 | 151 |
    152 |
    153 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    154 |
    155 | 156 |
    157 |

    Site built with pkgdown 1.6.1.

    158 |
    159 | 160 |
    161 |
    162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | -------------------------------------------------------------------------------- /docs/reference/get_a1.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Calculating the expected size of first level of descendants — get_a1 • evently 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 56 | 57 | 58 | 59 | 60 | 61 | 62 |
    63 |
    64 | 110 | 111 | 112 | 113 |
    114 | 115 |
    116 |
    117 |
    118 |

    Calculating the expected size of first level of descendants

    119 | 120 | 121 |
    122 | 123 |
    124 |

    Calculating the expected size of first level of descendants

    125 |
    126 | 127 | 
    get_a1(model)
    128 | 129 |

    Arguments

    130 | 131 | 132 | 133 | 134 | 136 | 137 |
    model

    A model object provides data, model_type, observation_time 135 | and model parameters

    138 | 139 |

    Value

    140 | 141 |

    a vector of the expected sizes of first level of descendants of the 142 | given cascades

    143 | 144 |
    145 | 150 |
    151 | 152 | 153 |
    154 |
    155 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    156 |
    157 | 158 |
    159 |

    Site built with pkgdown 1.6.1.

    160 |
    161 | 162 |
    163 |
    164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | -------------------------------------------------------------------------------- /docs/reference/get_branching_factor.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Branching factor is the expected number of events generated 10 | by a single event. — get_branching_factor • evently 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 45 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 59 | 60 | 61 | 62 | 63 | 64 | 65 |
    66 |
    67 | 113 | 114 | 115 | 116 |
    117 | 118 |
    119 |
    120 |
    121 |

    Branching factor is the expected number of events generated 122 | by a single event.

    123 | 124 | 125 |
    126 | 127 |
    128 |

    Branching factor is the expected number of events generated 129 | by a single event.

    130 |
    131 | 132 | 
    get_branching_factor(model)
    133 | 134 |

    Arguments

    135 | 136 | 137 | 138 | 139 | 140 | 141 |
    model

    A model object for computing the branching factor.

    142 | 143 |

    Value

    144 | 145 |

    A single number, the branching factor of the given model

    146 | 147 |
    148 | 153 |
    154 | 155 | 156 |
    157 |
    158 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    159 |
    160 | 161 |
    162 |

    Site built with pkgdown 1.6.1.

    163 |
    164 | 165 |
    166 |
    167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | -------------------------------------------------------------------------------- /docs/reference/setup_ampl.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Set up the AMPL environment by downloading an AMPL demo version and the compiled 10 | ipopt binary. Only supports UNIX compatible OSs. — setup_ampl • evently 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 45 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 59 | 60 | 61 | 62 | 63 | 64 | 65 |
    66 |
    67 | 113 | 114 | 115 | 116 |
    117 | 118 |
    119 |
    120 |
    121 |

    Set up the AMPL environment by downloading an AMPL demo version and the compiled 122 | ipopt binary. Only supports UNIX compatible OSs.

    123 | 124 | 125 |
    126 | 127 |
    128 |

    Set up the AMPL environment by downloading an AMPL demo version and the compiled 129 | ipopt binary. Only supports UNIX compatible OSs.

    130 |
    131 | 132 | 
    setup_ampl(ampl_path)
    133 | 134 |

    Arguments

    135 | 136 | 137 | 138 | 139 | 140 | 141 |
    ampl_path

    The path where the AMPL folder will be placed

    142 | 143 | 144 |
    145 | 150 |
    151 | 152 | 153 |
    154 |
    155 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    156 |
    157 | 158 |
    159 |

    Site built with pkgdown 1.6.1.

    160 |
    161 | 162 |
    163 |
    164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | -------------------------------------------------------------------------------- /docs/reference/get_model_intensity_at.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Compute the intensity value of a given model at time t — get_model_intensity_at • evently 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 56 | 57 | 58 | 59 | 60 | 61 | 62 |
    63 |
    64 | 110 | 111 | 112 | 113 |
    114 | 115 |
    116 |
    117 |
    118 |

    Compute the intensity value of a given model at time t

    119 | 120 | 121 |
    122 | 123 |
    124 |

    Compute the intensity value of a given model at time t

    125 |
    126 | 127 | 
    get_model_intensity_at(model, t, cascade_index = 1)
    128 | 129 |

    Arguments

    130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 |
    model

    A model object for computing the intensity value

    t

    The given time to compute the intensity

    cascade_index

    Determine which cascade in the list of cascades to compute, defaults to 1

    145 | 146 |

    Value

    147 | 148 |

    A single number, the intensity value of the given model evaluated at t

    149 | 150 |
    151 | 156 |
    157 | 158 | 159 |
    160 |
    161 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    162 |
    163 | 164 |
    165 |

    Site built with pkgdown 1.6.1.

    166 |
    167 | 168 |
    169 |
    170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | -------------------------------------------------------------------------------- /docs/reference/get_viral_score.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Viral score is the total reaction of the system to a single promotion, 10 | i.e. the expected cascade size started by a single event of magnitude — get_viral_score • evently 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 45 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 59 | 60 | 61 | 62 | 63 | 64 | 65 |
    66 |
    67 | 113 | 114 | 115 | 116 |
    117 | 118 |
    119 |
    120 |
    121 |

    Viral score is the total reaction of the system to a single promotion, 122 | i.e. the expected cascade size started by a single event of magnitude

    123 | 124 | 125 |
    126 | 127 |
    128 |

    Viral score is the total reaction of the system to a single promotion, 129 | i.e. the expected cascade size started by a single event of magnitude

    130 |
    131 | 132 | 
    get_viral_score(model, m_0 = NULL)
    133 | 134 |

    Arguments

    135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 145 | 146 |
    model

    A model object for computing the branching factor.

    m_0

    The magnitude of the initial post for computing its viral score. 144 | The first magnitude value in model$data[[1]] will be used if not provided.

    147 | 148 |

    Value

    149 | 150 |

    A single number, the viral score of the given model

    151 | 152 |
    153 | 158 |
    159 | 160 | 161 |
    162 |
    163 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    164 |
    165 | 166 |
    167 |

    Site built with pkgdown 1.6.1.

    168 |
    169 | 170 |
    171 |
    172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | -------------------------------------------------------------------------------- /docs/reference/predict_final_popularity.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Predict the final popularity (event count) of give histories and 10 | its model parameters. — predict_final_popularity • evently 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 45 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 59 | 60 | 61 | 62 | 63 | 64 | 65 |
    66 |
    67 | 113 | 114 | 115 | 116 |
    117 | 118 |
    119 |
    120 |
    121 |

    Predict the final popularity (event count) of give histories and 122 | its model parameters.

    123 | 124 | 125 |
    126 | 127 |
    128 |

    Predict the final popularity (event count) of give histories and 129 | its model parameters.

    130 |
    131 | 132 | 
    predict_final_popularity(model, data = NULL, observation_time = NULL)
    133 | 134 |

    Arguments

    135 | 136 | 137 | 138 | 139 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 |
    model

    A model object provides data, model_type, observation_time 140 | and model parameters

    data

    A given cascade whose final popularity will be predicted

    observation_time

    The observation time of the given cascade

    151 | 152 |

    Value

    153 | 154 |

    a vector of predicted final popularities whose length is the same 155 | as the number of cascades in the provided model object

    156 | 157 |
    158 | 163 |
    164 | 165 | 166 |
    167 |
    168 |

    Developed by Quyu Kong, Marian-Andrei Rizoiu.

    169 |
    170 | 171 |
    172 |

    Site built with pkgdown 1.6.1.

    173 |
    174 | 175 |
    176 |
    177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | -------------------------------------------------------------------------------- /docs/reference/generate_features.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Given a list of group-fits produced by 'group_fit_series', this function generates features 10 | for each group-fit by summarizing the fitted parameters. — generate_features • evently 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 45 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 59 | 60 | 61 | 62 | 63 | 64 | 65 |
    66 |
    67 | 113 | 114 | 115 | 116 |
    117 | 118 |
    119 |
    120 |
    121 |

    Given a list of group-fits produced by 'group_fit_series', this function generates features 122 | for each group-fit by summarizing the fitted parameters.

    123 | 124 | 125 |
    126 | 127 |
    128 |

    Given a list of group-fits produced by 'group_fit_series', this function generates features 129 | for each group-fit by summarizing the fitted parameters.

    130 |
    131 | 132 | 
    generate_features(list_fits, data = FALSE)
    133 | 134 |

    Arguments

    135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 |
    list_fits

    A list of group fits returned by group_fit_series

    data

    A indicator decides if the data features should be included or not.

    146 | 147 |

    Value

    148 | 149 |

    A data frame of features for each group. If features are all -1, it means all the 150 | fits of the group are NAs

    151 | 152 |
    153 | 158 |
    159 | 160 | 161 | 171 |
    172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | --------------------------------------------------------------------------------