Start trying to use a time series model.

.gitignore

@@ -8,6 +8,7 @@ index_files/
 .Rhistory
 .RData
 .Ruserdata
+.Renviron
 
 # Quarto stuff
 /.quarto/

index.qmd

@@ -36,6 +36,7 @@ execute:
   echo: false
   error: false
   freeze: auto
+  fig-width: 6.75
 ---
 
 ```{r}
@@ -72,6 +73,11 @@ RQ: What server attributes correspond with better newcomer retention?
 
 All online communities and accounts trend toward death.
 
+Online fandom communities, for instance...
+
+
+On Reddit, @newellUserMigrationOnline found that the news aggregator had an advantage of potential competitors because of their catalogue of niche communities: people who migrated to alternative platforms tended to post most often proportionally in popular communities.
+
 + Fiesler on online fandom communities [@fieslerMovingLandsOnline2020]
 + TeBlunthuis on competition and mutalism [@teblunthuisIdentifyingCompetitionMutualism2022]
 + Work on "alt-tech" communities.
@@ -229,22 +235,23 @@ arrow::read_feather(
 #| fig-width: 6.75
 accounts_unfilt <- arrow::read_feather("data/scratch/all_accounts.feather", col_select=c("server", "username", "created_at", "last_status_at", "statuses_count", "has_moved", "bot", "suspended", "host")) %>%
   filter(server == host)
-accounts <- accounts_unfilt
+accounts <- accounts_unfilt %>%
   filter(!bot) %>%
   # TODO: what's going on here?
   filter(!is.na(last_status_at)) %>%
   mutate(suspended = replace_na(suspended, FALSE)) %>%
   # sanity check
-  filter(created_at >= "2022-01-01") %>%
+  filter(created_at >= "2021-01-01") %>%
   filter(created_at < "2023-08-01") %>%
   # We don't want accounts that were created and then immediately stopped being active
   filter(statuses_count >= 1) %>%
   filter(last_status_at >= created_at) %>%
   mutate(active = last_status_at >= "2024-01-01") %>%
   mutate(last_status_at = ifelse(active, lubridate::ymd_hms("2024-01-01 00:00:00", tz = "UTC"), last_status_at)) %>%
-  mutate(active_time = difftime(last_status_at, created_at, units="days")) %>%
+  mutate(active_time = difftime(last_status_at, created_at, units="days")) #%>%
-  filter(!has_moved)
+  #filter(!has_moved)
-acc_data <- accounts_unfilt %>%
+acc_data <- accounts %>%
+  #filter(!has_moved) %>%
   mutate(created_month = format(created_at, "%Y-%m")) %>%
   mutate(created_week = floor_date(created_at, unit = "week")) %>%
   mutate(active = active_time >= 45) %>%
@@ -254,7 +261,7 @@ acc_data <- accounts_unfilt %>%
     Active = (sum(active)-sum(has_moved)-sum(suspended))/(n()-sum(has_moved)-sum(suspended)),
     Moved=sum(has_moved)/n(),
     count=n()) %>%
-  pivot_longer(cols=c("Active", "Moved", "Suspended"), names_to="Measure", values_to="value")
+  pivot_longer(cols=c("Active", "Moved"), names_to="Measure", values_to="value") # "Suspended"
 theme_bw_small_labels <- function(base_size = 9) {
   theme_bw(base_size = base_size) %+replace%
     theme(
@@ -270,7 +277,7 @@ theme_bw_small_labels <- function(base_size = 9) {
 p1 <- acc_data %>%
   ggplot(aes(x=as.Date(created_week), group=1)) +
   geom_line(aes(y=value, group=Measure, color=Measure)) +
-  geom_point(aes(y=value, color=Measure)) +
+  geom_point(aes(y=value, color=Measure), size=0.7) +
   scale_y_continuous(limits = c(0, 1.0)) +
   labs(y="Proportion") + scale_x_date(labels=date_format("%Y-%U"), breaks = "4 week") +
   theme_bw_small_labels() +
@@ -295,6 +302,7 @@ p2 <- acc_data %>%
     aes(xintercept = as.numeric(as.Date("2023-07-01"))),
     linetype="dashed", color = "black") +
   #scale_y_continuous(limits = c(0, max(acc_data$count) + 100000)) +
+  scale_y_continuous(labels = scales::comma) + 
   labs(y="Count", x="Created Week") +
   theme_bw_small_labels() + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + scale_x_date(labels=date_format("%Y-%U"), breaks = "4 week")
 #grid.draw(rbind(ggplotGrob(p1), ggplotGrob(p2), size = "last"))
@@ -302,7 +310,80 @@ library(patchwork)
 p1 + p2 + plot_layout(ncol = 1)
 ```
 
-**Mastodon Profiles (2022)**: We collected accounts using data previously collected from posts on public Mastodon timelines from October 2020 to January 2024. We then queried for up-to-date information on those accounts including their most recent status and if the account had moved. This gave us a total of `r nrow(accounts)` accounts, of which `r accounts %>% ` We selected accounts created after January 1, 2022 and before August 1, 2023 and which posted least one status.
+**Mastodon Profiles**: We collected accounts using data previously collected from posts on public Mastodon timelines from October 2020 to January 2024. We then queried for up-to-date information on those accounts including their most recent status and if the account had moved. This gave us a total of `r nrow(accounts)` accounts.
+
+**Moved Profiles**: We found a subset of `r accounts %>% filter(has_moved) %>% nrow` accounts which had moved from one server to another.
+
+# Results
+
+## Activity By Server Size
+
+```{r}
+#| label: fig-active-accounts
+#library(betareg)
+library(lme4)
+activity <- arrow::read_feather(
+    "data/scratch/activity.feather",
+    col_select = c("server", "logins")
+  ) %>%
+  arrange(desc(logins)) %>% 
+  mutate(server_count = logins)
+
+account_data <- inner_join(accounts, activity, by="server") %>%
+  mutate(active = active_time >= 45)
+
+a_data <- account_data %>%
+  #mutate(active = active_time >= 45) %>%
+  group_by(server) %>%
+  summarize(active_prop = sum(active)/n(), active_count = sum(active), count=n()) %>%
+  inner_join(., activity, by="server")
+
+a_model <- glmer(active ~ log1p(logins) + (1|server), data=account_data, family=binomial)
+  #betareg(active_prop ~ log10(count), data = a_data)
+
+logins_seq <- seq(min(log1p(account_data$logins)), max(log1p(account_data$logins)), length.out = 100)
+a_pred <- predict(
+  a_model,
+  newdata = data.frame(logins = logins_seq, server = factor(1)),
+  type = "response",
+  re.form = NA)
+pred_data <- data.frame(logins = logins_seq, active_prop = a_pred)
+
+a_data %>%
+  mutate(logins = log1p(logins)) %>%
+  ggplot(aes(y=active_prop, x=logins)) +
+    geom_point(alpha=0.1) +
+    # help here
+    #geom_line(aes(y = a_pred)) +
+    geom_line(data = pred_data, aes(x = logins, y = active_prop), color = "red") + # Use pred_data for line
+    labs(
+      y = "Active after 45 Days",
+      x = "Accounts"
+    ) +
+    scale_x_continuous(labels = scales::comma) +
+    #scale_y_log10() +
+    theme_bw_small_labels()
+```
+```{r}
+library(fable)
+library(fable.binary)
+
+ad_time <- account_data |>
+  as_tsibble(key=c("username", "server"), index=created_at)
+```
+
+```{r}
+fit <- ad_time |>
+  model(
+    logistic = LOGISTIC(active ~ fourier(K = 5, period = "year"))
+  )
+```
+
+```{r}
+ad_time |>
+  autoplot(active)
+```
+
 
 ```{r}
 #| label: fig-account-activity-prop
@@ -311,24 +392,7 @@ p1 + p2 + plot_layout(ncol = 1)
 #| eval: false
 study_period <- 45
 #formerly accounts_processed_recent
-accounts_unfilt <- arrow::read_feather("data/scratch/all_accounts.feather", col_select=c("server", "host", "username", "created_at", "last_status_at", "statuses_count", "has_moved", "bot", "uri", "suspended")) %>%
-  filter(server == host) %>%
-  filter(bot != TRUE) %>%
-  mutate(suspended = replace_na(suspended, FALSE)) %>%
-  filter(suspended != TRUE) %>%
-  # TODO: what's going on here?
-  filter(!is.na(last_status_at)) %>%
-  # sanity check
-  filter(created_at >= "2023-10-15") %>% filter(created_at < "2024-01-01") %>%
-  # We don't want accounts that were created and then immediately stopped being active
-  filter(statuses_count >= 1) %>%
-  filter(last_status_at >= created_at) %>%
-  mutate(active_time = difftime(last_status_at, created_at, units="days")) %>%
-  select(server, username, created_at, active_time, last_status_at, has_moved) %>%
-  mutate(active = active_time >= study_period) %>%
-  mutate(active_time = ifelse(active_time > study_period, study_period, active_time))
 
-accounts <- accounts_unfilt %>% filter(!has_moved)
 
 server_counts <- arrow::read_feather(
     "data/scratch/accounts.feather", 
@@ -382,19 +446,16 @@ survfit2(Surv(active_time_weeks, status) ~ server_count_bin, data = a) %>%
     breaks = seq(0, max(a$active_time_weeks, na.rm = TRUE), by = 4), 
     labels = seq(0, max(a$active_time_weeks, na.rm = TRUE), by = 4)
   ) +
-  theme_minimal() +
+  theme_bw_small_labels() +
   theme(axis.text.x = element_text(angle = 45, hjust = 1))
 ```
 
-To determine the relationship between server size and user retention, we...
-
 ```{r}
 #| eval: false
 sel_a <- a %>% 
-  #filter(created_at >= "2022-06-27") %>%
+  mutate(is_ms = server == "mastodon.social") %>%
-  #filter(created_at < "2022-08-26") %>% #%>% mutate(jm = as.integer(jm))
+  filter(jm)
-  mutate(is_ms = server == "mastodon.social")
+cx <- coxph(Surv(active_time_weeks, status) ~ log10(server_count), data = sel_a)
-cx <- coxph(Surv(active_time_weeks, status) ~ log10(server_count) + jm, data = sel_a)
 cz <- cox.zph(cx)
 #plot(cz)
 cx
@@ -425,7 +486,7 @@ server_movement_data <- left_join(
   rename(user_count = count) %>% arrange(desc(user_count))
 server_movement_data %>%
   ggplot(aes(x=user_count, y=diff)) +
-  geom_point() + scale_x_log10() + theme_minimal()
+  geom_point() + scale_x_log10() + theme_bw_small_labels()
 ```
 
 If there was no relationship, we would expect these jumps to be random with respect to server size.
@@ -500,11 +561,11 @@ modelsummary(
   m1,
   escape = FALSE,
   coef_rename = c(
-    "sum" = "\\beta_0 Intercept",
+    "sum" = "$\\beta_0$ Intercept",
-    "diff.sum.t-h.user_count" = "\\beta_1 User Count Difference",
+    "diff.sum.t-h.user_count" = "$\\beta_1$ User Count Difference",
-    "nodecov.sum.user_count" = "\\beta_2 User Count (Node Covariate)",
+    "nodecov.sum.user_count" = "$\\beta_2$ User Count (Node Covariate)",
-    "nodematch.sum.in_jm.TRUE" = "\\beta_3 In JoinMastodon (Both True)",
+    "nodematch.sum.in_jm.TRUE" = "$\\beta_3$ In JoinMastodon (Both True)",
-    "nodematch.sum.in_jm.FALSE" = "\\beta_4 In JoinMastodon (Both False)"
+    "nodematch.sum.in_jm.FALSE" = "$\\beta_4$ In JoinMastodon (Both False)"
   ),
 )
 ```

references.bib

@@ -29,6 +29,14 @@
   abstract = {When online platforms rise and fall, sometimes communities fade away, and sometimes they pack their bags and relocate to a new home. To explore the causes and effects of online community migration, we examine transformative fandom, a longstanding, technology-agnostic community surrounding the creation, sharing, and discussion of creative works based on existing media. For over three decades, community members have left and joined many different online spaces, from Usenet to Tumblr to platforms of their own design. Through analysis of 28 in-depth interviews and 1,886 survey responses from fandom participants, we traced these migrations, the reasons behind them, and their impact on the community. Our findings highlight catalysts for migration that provide insights into factors that contribute to success and failure of platforms, including issues surrounding policy, design, and community. Further insights into the disruptive consequences of migrations (such as social fragmentation and lost content) suggest ways that platforms might both support commitment and better support migration when it occurs.}
 }
 
+@article{newellUserMigrationOnline,
+  title = {User {{Migration}} in {{Online Social Networks}}: {{A Case Study}} on {{Reddit During}} a {{Period}} of {{Community Unrest}}},
+  author = {Newell, Edward and Jurgens, David and Saleem, Haji Mohammad and Vala, Hardik and Sassine, Jad and Armstrong, Caitrin and Ruths, Derek},
+  pages = {10},
+  abstract = {Platforms like Reddit have attracted large and vibrant communities, but the individuals in those communities are free to migrate to other platforms at any time. History has borne this out with the mass migration from Slashdot to Digg. The underlying motivations of individuals who migrate between platforms, and the conditions that favor migration online are not well-understood. We examine Reddit during a period of community unrest affecting millions of users in the summer of 2015, and analyze large-scale changes in user behavior and migration patterns to Reddit-like alternative platforms. Using self-reported statements from user comments, surveys, and a computational analysis of the activity of users with accounts on multiple platforms, we identify the primary motivations driving user migration. While a notable number of Reddit users left for other platforms, we found that an important pull factor that enabled Reddit to retain users was its long tail of niche content. Other platforms may reach critical mass to support popular or ``mainstream'' topics, but Reddit's large userbase provides a key advantage in supporting niche topics.},
+  langid = {english}
+}
+
 @inproceedings{teblunthuisIdentifyingCompetitionMutualism2022,
   title = {Identifying Competition and Mutualism between Online Groups},
   booktitle = {International {{AAAI Conference}} on {{Web}} and {{Social Media}} ({{ICWSM}} 2022)},

renv.lock

@@ -80,7 +80,7 @@
     },
     "Matrix": {
       "Package": "Matrix",
-      "Version": "1.6-1.1",
+      "Version": "1.6-5",
       "Source": "Repository",
       "Repository": "CRAN",
       "Requirements": [
@@ -93,7 +93,7 @@
         "stats",
         "utils"
       ],
-      "Hash": "1a00d4828f33a9d690806e98bd17150c"
+      "Hash": "8c7115cd3a0e048bda2a7cd110549f7a"
     },
     "R6": {
       "Package": "R6",
@@ -126,6 +126,19 @@
       ],
       "Hash": "5ea2700d21e038ace58269ecdbeb9ec0"
     },
+    "RcppEigen": {
+      "Package": "RcppEigen",
+      "Version": "0.3.3.9.4",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "Rcpp",
+        "stats",
+        "utils"
+      ],
+      "Hash": "acb0a5bf38490f26ab8661b467f4f53a"
+    },
     "RcppTOML": {
       "Package": "RcppTOML",
       "Version": "0.2.2",
@@ -265,6 +278,28 @@
       ],
       "Hash": "40415719b5a479b87949f3aa0aee737c"
     },
+    "boot": {
+      "Package": "boot",
+      "Version": "1.3-28.1",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "graphics",
+        "stats"
+      ],
+      "Hash": "9a052fbcbe97a98ceb18dbfd30ebd96e"
+    },
+    "brio": {
+      "Package": "brio",
+      "Version": "1.1.4",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R"
+      ],
+      "Hash": "68bd2b066e1fe780bbf62fc8bcc36de3"
+    },
     "broom": {
       "Package": "broom",
       "Version": "1.0.5",
@@ -511,6 +546,34 @@
       ],
       "Hash": "59351f28a81f0742720b85363c4fdd61"
     },
+    "desc": {
+      "Package": "desc",
+      "Version": "1.4.3",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "R6",
+        "cli",
+        "utils"
+      ],
+      "Hash": "99b79fcbd6c4d1ce087f5c5c758b384f"
+    },
+    "diffobj": {
+      "Package": "diffobj",
+      "Version": "0.3.5",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "crayon",
+        "methods",
+        "stats",
+        "tools",
+        "utils"
+      ],
+      "Hash": "bcaa8b95f8d7d01a5dedfd959ce88ab8"
+    },
     "digest": {
       "Package": "digest",
       "Version": "0.6.34",
@@ -1156,6 +1219,32 @@
       ],
       "Hash": "b8552d117e1b808b09a832f589b79035"
     },
+    "lme4": {
+      "Package": "lme4",
+      "Version": "1.1-35.1",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "MASS",
+        "Matrix",
+        "R",
+        "Rcpp",
+        "RcppEigen",
+        "boot",
+        "graphics",
+        "grid",
+        "lattice",
+        "methods",
+        "minqa",
+        "nlme",
+        "nloptr",
+        "parallel",
+        "splines",
+        "stats",
+        "utils"
+      ],
+      "Hash": "07fb0c5b727b15b0ce40feb641498e4e"
+    },
     "lpSolveAPI": {
       "Package": "lpSolveAPI",
       "Version": "5.5.2.0-17.11",
@@ -1224,6 +1313,16 @@
       ],
       "Hash": "18e9c28c1d3ca1560ce30658b22ce104"
     },
+    "minqa": {
+      "Package": "minqa",
+      "Version": "1.2.6",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "Rcpp"
+      ],
+      "Hash": "f48238f8d4740426ca12f53f27d004dd"
+    },
     "modelr": {
       "Package": "modelr",
       "Version": "0.1.11",
@@ -1329,6 +1428,16 @@
       ],
       "Hash": "8d1938040a05566f4f7a14af4feadd6b"
     },
+    "nloptr": {
+      "Package": "nloptr",
+      "Version": "2.0.3",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "testthat"
+      ],
+      "Hash": "277c67a08f358f42b6a77826e4492f79"
+    },
     "openssl": {
       "Package": "openssl",
       "Version": "2.1.1",
@@ -1407,6 +1516,21 @@
       ],
       "Hash": "15da5a8412f317beeee6175fbc76f4bb"
     },
+    "pkgbuild": {
+      "Package": "pkgbuild",
+      "Version": "1.4.3",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "R6",
+        "callr",
+        "cli",
+        "desc",
+        "processx"
+      ],
+      "Hash": "c0143443203205e6a2760ce553dafc24"
+    },
     "pkgconfig": {
       "Package": "pkgconfig",
       "Version": "2.0.3",
@@ -1417,6 +1541,27 @@
       ],
       "Hash": "01f28d4278f15c76cddbea05899c5d6f"
     },
+    "pkgload": {
+      "Package": "pkgload",
+      "Version": "1.3.4",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "cli",
+        "crayon",
+        "desc",
+        "fs",
+        "glue",
+        "methods",
+        "pkgbuild",
+        "rlang",
+        "rprojroot",
+        "utils",
+        "withr"
+      ],
+      "Hash": "876c618df5ae610be84356d5d7a5d124"
+    },
     "png": {
       "Package": "png",
       "Version": "0.1-8",
@@ -1427,6 +1572,13 @@
       ],
       "Hash": "bd54ba8a0a5faded999a7aab6e46b374"
     },
+    "praise": {
+      "Package": "praise",
+      "Version": "1.0.0",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Hash": "a555924add98c99d2f411e37e7d25e9f"
+    },
     "prettyunits": {
       "Package": "prettyunits",
       "Version": "1.2.0",
@@ -1947,6 +2099,35 @@
       ],
       "Hash": "49f1958da2a787ab5dfc833676a0b450"
     },
+    "testthat": {
+      "Package": "testthat",
+      "Version": "3.2.1",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "R6",
+        "brio",
+        "callr",
+        "cli",
+        "desc",
+        "digest",
+        "evaluate",
+        "jsonlite",
+        "lifecycle",
+        "magrittr",
+        "methods",
+        "pkgload",
+        "praise",
+        "processx",
+        "ps",
+        "rlang",
+        "utils",
+        "waldo",
+        "withr"
+      ],
+      "Hash": "4767a686ebe986e6cb01d075b3f09729"
+    },
     "textshaping": {
       "Package": "textshaping",
       "Version": "0.3.7",
@@ -2214,6 +2395,24 @@
       ],
       "Hash": "390f9315bc0025be03012054103d227c"
     },
+    "waldo": {
+      "Package": "waldo",
+      "Version": "0.5.2",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "cli",
+        "diffobj",
+        "fansi",
+        "glue",
+        "methods",
+        "rematch2",
+        "rlang",
+        "tibble"
+      ],
+      "Hash": "c7d3fd6d29ab077cbac8f0e2751449e6"
+    },
     "withr": {
       "Package": "withr",
       "Version": "3.0.0",