Kaprekar's constant - Reddit

library(tidyverse)

dig_sub = function(x) {
  x = str_pad(x, 4, side = "left", pad = 0)
  my_list = str_split(x, pattern = "", simplify = TRUE)
  small = my_list[order(my_list)] |> paste0(collapse = "") |> as.numeric()
  large = my_list[rev(order(my_list))] |> paste0(collapse = "") |> as.numeric()
  list(x, large, small, large - small)
} 

dig_sub(1089)


# it might be more elegant to make a recursive function in a loop, but since wikipedia and
#   experimentation show that seven iterations is enough, and the size is small, we can brute force it.

data.frame(x0 = 0:9999) |>
  rowwise() |>
  mutate(base = x0, .before = 1) |>
  mutate(x1 = dig_sub(x0)[4] |> as.integer(),
         x2 = dig_sub(x1)[4] |> as.integer(),
         x3 = dig_sub(x2)[4] |> as.integer(),
         x4 = dig_sub(x3)[4] |> as.integer(),
         x5 = dig_sub(x4)[4] |> as.integer(),
         x6 = dig_sub(x5)[4] |> as.integer(),
         x7 = dig_sub(x6)[4] |> as.integer(),
         x8 = dig_sub(x7)[4] |> as.integer(),
         x9 = dig_sub(x8)[4] |> as.integer()) |>
  pivot_longer(-base) |>
  filter(value != lag(value, 1, -1), .by = base) |>
  mutate(iteration = row_number() - 1,
         converge_at = max(iteration),
         to_go = converge_at - iteration, .by = base) -> solns

solns |> 
  summarize(conv_iter = max(iterations), .by = base) |>
  mutate(grp = x0 %/% 100,
         obs = ((x0 ) %% 100)) |>
  count(conv_iter) |>
  add_row(conv_iter = Inf, n = 10) |>
  mutate(share = (n / sum(n)) |> scales::percent()) |>
  janitor::adorn_totals()

# animate(
ggplot(solns |> 
         summarize(conv_iter = max(iteration), .by = base) |>
         mutate(grp = base %/% 100,
                obs = ((base ) %% 100)),
       aes(obs, grp, fill = factor(conv_iter))) +
  geom_tile() +
  # geom_tile(alpha = 0) +
  # geom_tile(data = ~filter(., conv_iter == 3)) +
  ggthemes::scale_fill_tableau(direction = -1) +
  # scale_fill_viridis_c(option = "B") +
  scale_x_continuous(labels = ~str_pad(., 2, "left", "0"),
                     breaks = scales::breaks_width(10),
                     minor_breaks = NULL,
                     limits = c(-1, 99.5), expand = c(0,0)) +
  scale_y_reverse(labels = ~str_pad(., 2, "left", "0"),
                  breaks = scales::breaks_width(-10),
                  minor_breaks = NULL,
                  limits = c(99.5, -1), expand = c(0,0)) +
  theme_minimal() +
  facet_wrap(~conv_iter, nrow = 2) +
  # gganimate::transition_states(conv_iter) +
  # gganimate::shadow_wake(wake_length = 1, alpha = NULL) +
  coord_equal() +
  labs(fill = "Cycles", x = "Last 2 digits", y = "First two digits")
# nframes = 8, fps = 1)

solns |>
  slice_max(iteration, by = base) |>
  count(converge_at) |>
  mutate(share = n / sum(n)) |>
  ggplot(aes(converge_at, n, fill = factor(converge_at))) +
  geom_col() +
  geom_text(aes(label = paste(scales::comma(n), 
                              scales::percent(share), sep = "\n")), 
                vjust = -0.5, lineheight = 0.8) +
  ggthemes::scale_fill_tableau(direction = -1) +
  scale_x_continuous(breaks = 0:7, minor_breaks = NULL) +
  scale_y_continuous(expand = expansion(mult = c(0, 0.1))) +
  theme_minimal() +
  labs(fill = "Cycles", x = "# Iterations to Converge")



solns |>
  # filter(base < 2000) |>
  mutate(from = value, to = lead(value), .by = base, .before = 0) |>
  distinct(from, to, to_go) |>
  arrange(to_go, from) |>
  mutate(pos = row_number()) -> temp

temp |>
  left_join(temp |>
              transmute(from, pos_to = pos), join_by(to == from)) |>
  mutate(label = n() > 1, .by = to) -> temp

temp |> filter(label) |>
  distinct(to) |>
  rename(from = to) |>
  left_join(temp, join_by(from)) -> temp2

temp |>
  count(to, to_go) |>
  arrange(to_go, -n, to) |>
  mutate(base = cumsum(n) - n,
         pos = row_number()) -> temp_waterfall
temp_waterfall |> 
  left_join(temp2 |> select(to, from)) |>
  filter(!is.na(from)) |>
  filter(!is.na(to)) |>
  left_join(temp_waterfall |> select(from = to, base_from = base, n_from = n, pos_from = pos)) -> temp_waterfall_links

temp_waterfall |>
  arrange(to_go) |>
  ggplot(aes(x = pos, y = base + n/2, width = 1, height = n, fill = factor(to_go))) +
  geom_tile() +
  geom_curve(aes(x = pos_from, y = base_from + n_from/2,
                 xend = pos, yend = base + n/2), curvature = 0.8, alpha = 0.2,
             data = temp_waterfall_links, show.legend = FALSE) +
  geom_tile() +

  geom_text(aes(label = to, y = 1*base - 50, color = factor(to_go)), angle = 90, hjust = 1, show.legend = FALSE) +
  theme_minimal() +
  ggthemes::scale_fill_tableau(direction = -1) +
  ggthemes::scale_color_tableau(direction = -1) +
  scale_x_continuous(breaks = NULL) +
  labs(x = NULL, y = "Number of antecedents", fill = "Cycles", title = "Converging numbers")

  
ggplot(temp, aes(from, to_go, label = from)) +
  geom_segment(aes(xend = to, yend = to_go - 1), alpha = 0.05, linewidth = 0.2) +
  geom_segment(aes(xend = to, yend = to_go - 1), alpha = 0.5, linewidth = 0.3,
               color = "purple",
               data = temp2) +
  ggrepel::geom_text_repel(aes(x = to, y = to_go - 1, label = to),
            data = ~filter(., label) |>
              distinct(to, to_go), 
            size = 8/.pt, max.iter = 400, nudge_y = -0.1, force_pull = 0.5) +
  scale_y_continuous(breaks = 0:7, minor_breaks = NULL,
                     limits = c(-0.1, 7)) +
  theme_minimal() +
  labs(x = "#", y = "Steps to converge")



temp_waterfall_links |>
  select(to, to_go, from) |>
  mutate(across(c(to,from), ~(. %/% 100), .names = "{.col}_grp"),
         across(c(to,from), ~(. %% 100), .names = "{.col}_obs")) |>
  mutate(conv_iter = to_go-1) -> temp_links


ggplot(solns |> 
         summarize(conv_iter = max(iteration), .by = base) |>
         mutate(grp = base %/% 100,
                obs = ((base ) %% 100)),
       aes(obs, grp, fill = factor(conv_iter))) +
  geom_tile() +
  # geom_segment(aes(x = from_obs, xend = to_obs,
  #                y = from_grp, yend = to_grp), alpha = 0.8,
  #            data = temp_links) +
  # geom_point(aes(x = to_obs, y = to_grp), 
  #            shape = 21, size = 4, fill = NA, alpha = 0.8,
  #            data = temp_links |> distinct(to_obs, to_grp, conv_iter)) +
  ggthemes::scale_fill_tableau(direction = -1) +
  scale_x_continuous(labels = ~str_pad(., 2, "left", "0"),
                     breaks = scales::breaks_width(10),
                     minor_breaks = NULL,
                     limits = c(-1, 99.5), expand = c(0,0)) +
  scale_y_reverse(labels = ~str_pad(., 2, "left", "0"),
                  breaks = scales::breaks_width(-10),
                  minor_breaks = NULL,
                  limits = c(99.5, -1), expand = c(0,0)) +
  theme_minimal() +
  facet_wrap(~conv_iter, nrow = 2) +
  coord_equal() +
  labs(fill = "Cycles", x = "Last 2 digits", y = "First two digits")