{"id":20551764,"url":"https://github.com/benmarwick/signatselect","last_synced_at":"2025-04-14T11:32:33.343Z","repository":{"id":142934368,"uuid":"179234151","full_name":"benmarwick/signatselect","owner":"benmarwick","description":"signatselect: Identifying signatures of selection","archived":false,"fork":false,"pushed_at":"2019-12-03T20:47:37.000Z","size":3813,"stargazers_count":12,"open_issues_count":1,"forks_count":4,"subscribers_count":2,"default_branch":"master","last_synced_at":"2025-03-28T00:44:18.099Z","etag":null,"topics":["archaeological-science","archaeology","evolution"],"latest_commit_sha":null,"homepage":"","language":"R","has_issues":true,"has_wiki":null,"has_pages":null,"mirror_url":null,"source_name":null,"license":"other","status":null,"scm":"git","pull_requests_enabled":true,"icon_url":"https://github.com/benmarwick.png","metadata":{"files":{"readme":"README.Rmd","changelog":null,"contributing":null,"funding":null,"license":"LICENSE","code_of_conduct":"CODE_OF_CONDUCT.md","threat_model":null,"audit":null,"citation":null,"codeowners":null,"security":null,"support":null,"governance":null,"roadmap":null,"authors":null,"dei":null,"publiccode":null,"codemeta":null}},"created_at":"2019-04-03T07:25:59.000Z","updated_at":"2024-11-14T18:40:44.000Z","dependencies_parsed_at":"2023-04-08T00:37:23.931Z","dependency_job_id":null,"html_url":"https://github.com/benmarwick/signatselect","commit_stats":{"total_commits":47,"total_committers":5,"mean_commits":9.4,"dds":0.574468085106383,"last_synced_commit":"3ae3c71b2ad2a538acc7405f7a966d9ec0f4849c"},"previous_names":[],"tags_count":0,"template":false,"template_full_name":null,"repository_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/benmarwick%2Fsignatselect","tags_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/benmarwick%2Fsignatselect/tags","releases_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/benmarwick%2Fsignatselect/releases","manifests_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/benmarwick%2Fsignatselect/manifests","owner_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners/benmarwick","download_url":"https://codeload.github.com/benmarwick/signatselect/tar.gz/refs/heads/master","host":{"name":"GitHub","url":"https://github.com","kind":"github","repositories_count":248872007,"owners_count":21175335,"icon_url":"https://github.com/github.png","version":null,"created_at":"2022-05-30T11:31:42.601Z","updated_at":"2022-07-04T15:15:14.044Z","host_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub","repositories_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories","repository_names_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repository_names","owners_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners"}},"keywords":["archaeological-science","archaeology","evolution"],"created_at":"2024-11-16T02:33:33.415Z","updated_at":"2025-04-14T11:32:33.317Z","avatar_url":"https://github.com/benmarwick.png","language":"R","funding_links":[],"categories":[],"sub_categories":[],"readme":"---\noutput: github_document\n---\n\n\u003c!-- README.md is generated from README.Rmd. Please edit that file --\u003e\n\n```{r setup, include = FALSE}\nknitr::opts_chunk$set(\n  warning = FALSE,\n  message = FALSE,\n  collapse = TRUE,\n  comment = \"#\u003e\",\n  fig.path = \"man/figures/README-\",\n  fig.retina = 2,\n  out.width = \"100%\"\n)\n```\n# signatselect: Identifying signatures and strengths of selection  \n\n[![Travis build status](https://travis-ci.org/benmarwick/signatselect.svg?branch=master)](https://travis-ci.org/benmarwick/signatselect) [![Binder](http://mybinder.org/badge_logo.svg)](http://beta.mybinder.org/v2/gh/benmarwick/signatselect/master?urlpath=rstudio) \n\nThe goal of signatselect is to provide two functions useful for investigating change over time in artefact assemblages (and genetic time-series data):\n\n- `fit()` the frequency increment test as simple statistical test to aid in the detection and quantification of selective processes in the archaeological record. This is adapted directly from the algorithm published in Feder, A. F., Kryazhimskiy, S., \u0026 Plotkin, J. B. (2014). Identifying signatures of selection in genetic time series. _Genetics_, 196(2), 509-522. \u003chttps://doi.org/10.1534/genetics.113.158220\u003e and Newberry's implementation of Feder's FIT for R at \u003chttps://github.com/mnewberry/ldrift\u003e for their paper Newberry, et al. (2017). Detecting evolutionary forces in language change. _Nature_, 551(7679), 223–226. \u003chttps://doi.org/10.1038/nature24455\u003e \n\n- `tsinfer()` to estimate the population size and the selection coefficient favoring one variant over another from time-series variant-frequency data. This is adapted from Feder et al. (2014) and Hezekiah Akiva Bacovcin's \u003chttps://github.com/bacovcin/tsinfer-R\u003e, who adapted it from Sergey Kryazhimskiy's OCaml language version of `tsinfer` at \u003chttps://github.com/skryazhi/tsinfer\u003e. \n\n## Installation\n\nYou can install the development version of signatselect from GitHub with:\n\n``` r\n# install.packages(\"pak\")\npak::pkg_install(\"benmarwick/signatselect\")\n```\n\n## Examples\n\n### The Frequency Increment Test\n\nHere is an example of the `fit()`, the frequency increment test:\n\n```{r fit-example}\n# install.packages(\"tidyverse\")\nsuppressPackageStartupMessages(library(tidyverse))\n\n  # data slightly modified from Feder et al. Table S2 \n  feder_table_2 \u003c- \n  tibble(time = c(415 , 505 , 585 , 665 , 745 , 825 , 910),\n         freq = c(0.06956522, 0.23125000, 0.62352941, 0.78494624, 0.93333333, 0.97979798, 0.98979592))\n```\n\nLet's take a look:\n\n```{r fit-plot, out.width=\"50%\", fig.align='center'}\n  ggplot(feder_table_2,\n         aes(time, freq)) +\n  geom_line() +\n  geom_point(size = 5) +\n  theme_minimal()\n```\n\nThere's a trend of increasing frequencies, but is it a result of selection? Let's see:\n\n```{r fit-test}\nlibrary(signatselect)\n\n    fit(\n      time = feder_table_2$time,\n      v = feder_table_2$freq\n    )\n```\n\nThe result of the FIT, with the low p-value, indicates that selection is occuring in this time series.\n\nHow about the null situation, can we credibly detect a situation with no selection? Here's a random uniform distribution of a variant: \n\n```{r h0-fit-example, out.width=\"50%\", fig.align='center'}\n  no_selection \u003c- \n  tibble(time = c(415 , 505 , 585 , 665 , 745 , 825 , 910),\n         freq = runif(7))\n\n  ggplot(no_selection,\n         aes(time, freq)) +\n  geom_line() +\n  geom_point(size = 5) +\n  theme_minimal()\n```\n\n```{r no-fit-test}\n    fit(\n      time = no_selection$time,\n      v = no_selection$freq\n    )\n```\n\nAnd we see a high p-value, indicating no selection in this time series.\n\n### Infer population size and selection coefficient from time-series variant-frequency data\n\nHere is an example of `tsinfer()` to estimate the population size and the selection coefficient favoring one variant over another from time-series variant-frequency data. Here's some sample data: \n\n- `tvec` contains sample times   \n- `bvec` contains the number of samples of the focal variant (must be integers) and,   \n- `nvec` containes total number of samples at each time point (must be integers)   \n\n```{r}\n  # data adapted from https://github.com/skryazhi/tsinfer\n  tvec = c(0, 10, 20)\n  bvec = c(2000, 4000, 6000)\n  nvec = c(10000, 10000, 10000)\n```\n\nNow we compute the test result:\n  \n```{r}\n  tsinfer_output \u003c- \n  tsinfer(\n    tvec = tvec,\n    bvec = bvec,\n    nvec = nvec,\n    verbose = FALSE\n  )\n\n# and take a look at the result \ntsinfer_output\n```\n\nThe selection coefficient for non-neutral model is in `s`, and so the value here is `r round(tsinfer_output$s, 3)`. The population size for non-neutral model is in `alpha`, and here is `r round(tsinfer_output$alpha, 4)`\n\n## An archaeological application\n\n### The frequency increment test\n\nHere is an example of using the FIT to identify pottery types that indicate selection. We are using frequencies of different decorative motifs in the Merzbach assemblage, Neolithic Germany (Crema et al. 2016; many other papers). We can load the data from the `evoarchdata` package on GitHub:\n\n```{r}\n# pak::pkg_install(\"benmarwick/evoarchdata\")\nlibrary(evoarchdata)\ndata(\"ceramics_lbk_merzbach\")\n\n# take a look\nceramics_lbk_merzbach\n```\n\nHere's a sample of some of the pottery decorations, from [Shennan and Wilkinson (2001)](https://www.jstor.org/stable/2694174):\n\n```{r out.width=\"50%\", fig.align='center', echo = FALSE}\nknitr::include_graphics(\"man/figures/README-decorative-motifs.png\")\n```\n\nHere's an overview of how each motif changes over time in this assemblage:\n\n```{r}\n# get ordered factor of decoration types so we can order the plots nicely \n\ndecoration_types \u003c- \nnames(ceramics_lbk_merzbach)[-1] %\u003e%\n  enframe() %\u003e% \n  separate(value, into = c('a', 'b'), 2) %\u003e% \n  mutate(b = parse_number(b)) %\u003e% \n  arrange(b) %\u003e% \n  unite(decorations, c(a,b), sep = \"\") %\u003e% \n  pull(decorations)\n\n# see how the freqs of each change over time\nceramics_lbk_merzbach_long \u003c-\n  ceramics_lbk_merzbach %\u003e%\n  gather(variable, value, -Phase) %\u003e% \n  mutate(Phase = fct_relevel(Phase, ceramics_lbk_merzbach$Phase)) %\u003e% \n  mutate(variable = fct_relevel(variable, decoration_types))\n\n# plot\nggplot(ceramics_lbk_merzbach_long,\n       aes(Phase,\n           value)) +\n  geom_line(aes(group = 1)) +\n  geom_point() +\n  facet_wrap(~variable,\n             scales = \"free_y\") +\n  theme_minimal(base_size = 8) +\n  ggtitle(str_glue('Ceramic decoration frequency data from Merzbach, Germany'))\n```\n\nThere are many decoration types, so let's narrow it down to ones that have a maximum frequency of at least `r max_n \u003c- 50; max_n`. \n\n```{r}\nceramics_lbk_merzbach_long_subset \u003c-\n  ceramics_lbk_merzbach_long %\u003e% \n  group_by(variable) %\u003e% \n  filter(max(value) \u003e max_n)\n\n# keep these decorations\ndecorations_to_keep \u003c- unique(as.character(ceramics_lbk_merzbach_long_subset$variable))\n\n# plot\nggplot(ceramics_lbk_merzbach_long_subset,\n       aes(Phase,\n           value)) +\n  geom_line(aes(group = 1)) +\n  geom_point() +\n  facet_wrap(~variable,\n             scales = \"free_y\") +\n  theme_minimal(base_size = 8)\n```\n\nWe can also view these in the classic archaeological visualiation, the battleship plot:\n\n```{r out.width=\"50%\", fig.align='center'}\nphases \u003c-  unique(ceramics_lbk_merzbach_long_subset$Phase)\n\nlibrary(plotrix)\n\nceramics_lbk_merzbach_matrix \u003c- \nceramics_lbk_merzbach_long_subset %\u003e% \n  spread(variable, value) %\u003e% \n  select(-Phase) %\u003e% \n  as.matrix() \n\nrow.names(ceramics_lbk_merzbach_matrix) \u003c- phases\n\nbattleship.plot(ceramics_lbk_merzbach_matrix,\n                yaxlab = phases,\n                col = \"grey\",\n                main=str_glue(\"Merzbach ceramic decoration types (max N \u003e {max_n})\"))\n```\n\nTo prepare the data for the FIT we need to reshape it to a long form, compute frequency as ratio of count of type of a interest to all other types, and drop decoration types with less than threee time points (we need a min of three time points to compute the FIT).\n\n```{r}\n# reshape data for each decoration type to go into test:\nceramics_lbk_merzbach_prop \u003c- \n  ceramics_lbk_merzbach %\u003e% \n  select(Phase, decorations_to_keep)\n\ndf \u003c- ceramics_lbk_merzbach_prop[ , 2:ncol(ceramics_lbk_merzbach_prop)]\ntime \u003c- utils:::.roman2numeric(ceramics_lbk_merzbach_prop$Phase)\n\n# compute frequency as ratio of count of type of interest to all other types\nlist_of_dfs \u003c- vector(\"list\", ncol(df))\nnames(list_of_dfs) \u003c- names(df)\n\nfor(i in 1:ncol(df)){\n  tmp \u003c-\n    data.frame(time = time,\n               count_this_one = df[[i]],\n               count_others = rowSums(df[, (seq_len(ncol(df)))[-i]   ]))\n  \n  # compute frequency\n  tmp$frequency = with(tmp, count_this_one / count_others)\n  \n  # collect results and exclude rows with zero counts for this type i\n  list_of_dfs[[i]] \u003c- tmp[which(tmp$count_this_one != 0 ), ]\n}\n\n# we need a min of three time points to compute the FIT, so drop decoration types with less than 3\nlist_of_dfs_three_or_more \u003c- \n  keep(list_of_dfs, ~nrow(.x) \u003e= 3)\n```\n  \nWe can prepare safe version of the FIT so we can use it in loops without breaking out of the loop when there is an error for one iteration\n\n```{r}\nfit_safely \u003c- \n  safely(fit, \n         otherwise = data.frame(fit_stat = NA,\n                                fit_p = NA))\n```\n\nNow we can compute the FIT for each pottery decoration type:\n\n```{r, fig.align='center'}\n# apply test to each decoration type\ndf_fit_test_results \u003c-\n  list_of_dfs_three_or_more %\u003e%\n  bind_rows(.id = \"type\") %\u003e%\n  nest(-type) %\u003e%\n  mutate(fit_test = map(data,\n                        ~fit_safely(time = .x$time,\n                                    v =    .x$frequency))) %\u003e%\n  mutate(fit_p = map(fit_test, ~.x$result %\u003e% bind_rows)) %\u003e%\n  unnest(fit_p) %\u003e%\n  mutate(sig = ifelse(fit_p \u003c= 0.05, \"selection\", \"neutral\"))\n\nceramics_lbk_merzbach_long_sig \u003c-\n  ceramics_lbk_merzbach_long_subset %\u003e%\n  ungroup %\u003e% \n  left_join(df_fit_test_results %\u003e% \n              select(type, sig), by = c(\"variable\" = \"type\")) %\u003e%\n  mutate(Phase_num = utils:::.roman2numeric(as.character(Phase))) %\u003e% \n  mutate(variable = fct_relevel(variable, decoration_types)) %\u003e% \n  arrange(variable, Phase_num)\n\n# plot to indicate which styles show selection and which do not. \nggplot(ceramics_lbk_merzbach_long_sig,\n       aes(Phase_num,\n           value,\n           colour = sig,\n           shape = sig,\n           group = variable)) +\n  geom_point(size = 3) +\n  scale_color_viridis_d(name = \"\", \n                        begin = 0.25, \n                        end = 0.75) +\n  geom_line() +\n  facet_wrap(~variable,\n             scales = \"free_y\") +\n  guides(shape = FALSE) +\n  theme_minimal(base_size = 8) +\n  ggtitle(str_glue('Application of the FIT to decoration frequency data from Merzbach.\\nShowing only decoration types that have a maximum frequency of at least {max_n}'))\n```\n\nWe can subset each time series to see if we can identify episodes of selection among decoration types that might not show overall selection. First we need a function to isolate a data frame of rolling groups of three time points:\n\n```{r}\n# Function to get df with rolling groups of n\n# from https://stackoverflow.com/a/5543632/1036500\nn \u003c- 5\ndf_with_rolling_idx \u003c- function(df, window = n) {\n  nr \u003c- nrow(df)\n  w \u003c- window       # window size\n  i \u003c- 1:nr         # indices of the rows\n  iw \u003c-\n    embed(i, w)[, w:1]   # matrix of rolling-window indices of length w\n  wnum \u003c- rep(1:nrow(iw), each = w)   # window number\n  inds \u003c-\n    i[c(t(iw))]         # the indices flattened, to use below\n  zw \u003c- sapply(df, '[', inds)\n  zw \u003c- transform(data.frame(zw), w = wnum)\n  return(zw)\n}\n```\n\nNow we can compute the FIT on sections of the time series for each decoration type to identify time coordinates where selection has occurred, even when the overall series does not indicate selection:\n\n```{r}\nmerzbach_long_sig_mid_time_point \u003c- \nlist_of_dfs %\u003e% \n  bind_rows(.id = \"type\") %\u003e% # to get rolling window of n\n  nest(-type) %\u003e%\n  mutate(rolled = map(data, df_with_rolling_idx)) %\u003e% \n  unnest(rolled) %\u003e% \n  mutate(unid = str_glue('{type}_{w}')) %\u003e% \n  nest(-unid) %\u003e% \n  mutate(fit_test = map(data,\n                        ~fit_safely(time = .x$time,\n                                    v =    .x$frequency))) %\u003e%\n  mutate(fit_p = map(fit_test, ~.x$result %\u003e% bind_rows)) %\u003e%\n  unnest(fit_p) %\u003e%\n  mutate(sig = ifelse(fit_p \u003c= 0.05, \"selection\", \"neutral\")) %\u003e% \n  unnest(data) \n\n# make type a factor so we can order the plots nicely \nmerzbach_long_sig_mid_time_point$type \u003c- \n  fct_relevel(merzbach_long_sig_mid_time_point$type,\n              decoration_types[decoration_types %in% merzbach_long_sig_mid_time_point$type])\n\n# plot with overall time-series results also\n# harmonize some variable names first\n\nceramics_lbk_merzbach_long_sig_to_plot_with_others \u003c- \n  ceramics_lbk_merzbach_long_sig %\u003e% \n  rename( time = Phase_num,\n          count_this_one = value,\n          type = variable) %\u003e% \n  filter(count_this_one != 0) %\u003e% \n  arrange(type, time) %\u003e% \n  mutate(type = fct_relevel(type, decoration_types))\n\nsig_decorations \u003c- \n  ceramics_lbk_merzbach_long_sig_to_plot_with_others %\u003e% \n  filter(sig == \"selection\") %\u003e% \n  pull(type) %\u003e% \n  as.character() %\u003e% \n  unique()\n\n# here we have the plot showing overall selection, and point-wise selection\nggplot()  +\n  geom_line(data = merzbach_long_sig_mid_time_point %\u003e% \n              filter(sig == \"selection\"),\n            aes(time,\n                count_this_one,\n                group = type),\n            size = 5,\n            colour = \"grey80\",\n            lineend = \"round\") +\n  geom_point(data = merzbach_long_sig_mid_time_point %\u003e% \n               filter(sig == \"selection\"),\n             aes(time,\n                 count_this_one,\n                 group = type),\n             size = 5,\n             colour = \"grey80\") +\n  geom_line(data = ceramics_lbk_merzbach_long_sig_to_plot_with_others,\n            aes(time,\n                count_this_one, \n                group = type,\n                colour = sig)) +\n  geom_point(data = ceramics_lbk_merzbach_long_sig_to_plot_with_others,\n            aes(time,\n                count_this_one, \n                group = type,\n                colour = sig,\n                shape = sig))  +\n  scale_color_viridis_d(name = \"\", \n                        begin = 0.25, \n                        end = 0.75) + \n  guides(shape = FALSE) +\n  facet_wrap( ~ type, scales = \"free_y\") +\n  theme_minimal(base_size = 8) +\n  ggtitle(str_glue('Application of the FIT to decoration frequency data from Merzbach.\\nShading highlights the data points where FIT identifies selection'))\n\n```\n\nThe output is consistent with previous conclusions of the existence of selective forces acting on decorated LBK pottery from these sites [(Kandler and Shennan 2013)](https://doi.org/10.1016/j.jtbi.2013.03.006). We further note that selection is most widespread on the decorations in the later phases of site occupation, an observation also made by [Shennan and Wilkinson (2001)](https://www.jstor.org/stable/2694174) who describe a pro-novelty bias in the later phases, possibly reflecting a concern to establish distinct local identities once the area had filled with people.  \n\n### Estimating the population size and the selection coefficient\n\nWe can compute the selection coefficient and related statistics for the decoration types that we previously identified as having a signal of selection. \n\n```{r}\ndecoration_types_tsinfer_output \u003c- \nlist_of_dfs_three_or_more %\u003e% \n  keep(., names(.) %in% sig_decorations) %\u003e% \n  map(~tsinfer(\n    tvec = .x$time,\n    bvec = .x$count_this_one,\n    nvec = .x$count_others,\n    verbose = FALSE\n  )) %\u003e% \n  bind_rows(.id = \"type\")\n\n# inspect the output\ndecoration_types_tsinfer_output\n```\n\nAnd we can visualise it:\n\n```{r}\n# join with frequency data\nceramics_lbk_merzbach_long_sig_to_plot_with_others_select \u003c- \nceramics_lbk_merzbach_long_sig_to_plot_with_others %\u003e% \n  filter(type %in% sig_decorations) %\u003e% \n  left_join(decoration_types_tsinfer_output) %\u003e% \n  filter(s \u003e 0) %\u003e% \n  mutate(sel_coef = s) %\u003e% \n  mutate(plot_label = str_glue('{type}, s = {round(sel_coef, 3)}'))\n\n# here we have the plot showing overall selection, and point-wise selection\nlibrary(scales)\nggplot(ceramics_lbk_merzbach_long_sig_to_plot_with_others_select)  +\n  geom_line(aes(time,\n                count_this_one, \n                group = plot_label,\n                size = (sel_coef),\n                alpha = rescale(sel_coef))) +\n  geom_point(aes(time,\n                count_this_one, \n                group = plot_label,\n                size =  rescale(sel_coef),\n                alpha = rescale(sel_coef)))  +\n  facet_wrap( ~ plot_label, scales = \"free_y\") +\n  scale_alpha_continuous(guide = FALSE) +\n  scale_size(NULL, range = c(1, 5)) + \n  theme_minimal(base_size = 8) +\n  theme(legend.position=\"none\") + \n  ggtitle(str_glue('Computation of the selection coefficient on decoration frequency data from Merzbach'))\n```\n\nDecoration type B20 returns the highest selection coefficient. Looking back at the illustration of the decoration types above, we note that this is one of the more visually complex decoration types. \n\nPlease note that the `signatselect` project is released with a [Contributor Code of Conduct](CODE_OF_CONDUCT.md). By contributing to this project, you agree to abide by its terms.\n\n\n```{r echo = FALSE, eval=FALSE}\n\n# schematic for FIT\n\n  library(ggplot2)\n  library(viridis)\n  n \u003c- 30\n  mean1 \u003c- 0\n  mean2 \u003c- 0.5\n  sds \u003c- 0.1\n  # create dataset with n brownian distributed points\n  # so rescaled frequencies are independent and approximately \n  # normally distributed with mean 0\n  df1 \u003c- data.frame(x = 1:n, \n                    y = rnorm(n, mean1, sds))\n  # create a ggplot2 scatterplot\n  p1 \u003c- ggplot(df1, aes(x, y)) + \n    geom_point(size = 3,\n               colour = viridis(1)) +\n    geom_line( colour = viridis(1)) +\n    ylim(-1,1) +\n    geom_hline(yintercept = mean1, \n               colour = viridis(1)) +\n    xlab(\"\") +\n    ylab(expression(Y[i])) +\n    theme_minimal() +\n    ggtitle(expression(paste(\"Rescaled variant frequencies under \", bold(\"drift\")))) \n    \n  # add marginal density along the y axis\n  m1 \u003c- \n  ggExtra::ggMarginal(p1,\n                      type = \"density\", \n                      margins = \"y\", \n                      size = 3, \n                      colour = viridis(1),\n                      fill = viridis(1))\n  \n  # create dataset with n brownian distributed points\n  df2 \u003c- data.frame(x = 1:n, \n                   y = rnorm(n, mean2, sds))\n  # create a ggplot2 scatterplot\n  p2 \u003c- ggplot(df2, aes(x, y)) + \n    geom_point(size = 3,\n               colour = viridis(5)[4]) +\n    geom_line(colour = viridis(5)[4]) +\n    geom_hline(yintercept = mean2, \n               colour = viridis(5)[4]) +\n    ylim(-1,1) +\n    theme_minimal() +\n    xlab(\"Sampled time points\") +\n    ylab(expression(Y[i])) +\n    ggtitle(expression(paste(\"Rescaled variant frequencies under \", bold(\"selection\")))) + \n    geom_segment(aes(\n      x =      0,\n      xend =   0,\n      y =      0,\n      yend =   0.5,\n    ),\n    size = 1,\n    colour = viridis(5)[1],\n    arrow = arrow(length = unit(0.25, \"cm\"))\n    ) \n  # add marginal density along the y axis\n  m2 \u003c- \n  ggExtra::ggMarginal(p2,\n                      type = \"density\", \n                      margins = \"y\", \n                      size = 3, \n                      colour = viridis(5)[4],\n                      fill = viridis(5)[4])\n\n\nlibrary(cowplot)\nplot_grid(m1 , m2, ncol = 1)\nggsave(\"man/figures/README-fit-schematic.png\",\n       w = 7, h = 5)\n\n\n```\n\n\n","project_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Fbenmarwick%2Fsignatselect","html_url":"https://awesome.ecosyste.ms/projects/github.com%2Fbenmarwick%2Fsignatselect","lists_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Fbenmarwick%2Fsignatselect/lists"}