$ \newcommand{\bF}{\mathbb{F}} \newcommand{\HH}{\mathbb{H}} \newcommand{\NN}{\mathbb{N}} \newcommand{\RR}{\mathbb{R}} \newcommand{\RP}{\mathbb{R}P} \newcommand{\PP}{\mathbb{P}} \newcommand{\ZZ}{\mathbb{Z}} \newcommand{\calA}{\mathcal{A}} \newcommand{\calB}{\mathcal{B}} \newcommand{\calC}{\mathcal{C}} \newcommand{\calD}{\mathcal{D}} \newcommand{\calE}{\mathcal{E}} \newcommand{\calF}{\mathcal{F}} \newcommand{\calG}{\mathcal{G}} \newcommand{\calH}{\mathcal{H}} \newcommand{\calJ}{\mathcal{J}} \newcommand{\calL}{\mathcal{L}} \newcommand{\calM}{\mathcal{M}} \newcommand{\calN}{\mathcal{N}} \newcommand{\calO}{\mathcal{O}} \newcommand{\calP}{\mathcal{P}} \newcommand{\calQ}{\mathcal{Q}} \newcommand{\calS}{\mathcal{S}} \newcommand{\calT}{\mathcal{T}} \newcommand{\calV}{\mathcal{V}} \newcommand{\calX}{\mathcal{X}} \newcommand{\calZ}{\mathcal{Z}} \newcommand{\frakg}{\mathfrak{g}} \newcommand{\balpha}{{\boldsymbol \alpha}} \newcommand{\bbeta}{{\boldsymbol \beta}} \newcommand{\bgamma}{{\boldsymbol \gamma}} \newcommand{\bxi}{{\boldsymbol \xi}} \newcommand{\he}{\hat{e}} \newcommand{\hv}{\hat{v}} \newcommand{\hw}{\hat{w}} \newcommand{\oT}{\overline{T}} \newcommand{\oY}{\overline{Y}} \newcommand{\hDelta}{\widehat \Delta} \newcommand{\hA}{\widehat A} \newcommand{\hT}{\widehat T} \newcommand{\hU}{\widehat U} \newcommand{\hV}{\widehat V} \newcommand{\hX}{\widehat X} \newcommand{\hY}{\widehat Y} \newcommand{\hZ}{\widehat Z} \newcommand{\sfV}{\mathsf{V}} \newcommand{\talpha}{{\widetilde \alpha}} \newcommand{\tbeta}{{\widetilde \beta}} \newcommand{\tgamma}{{\widetilde \gamma}} \newcommand{\tsigma}{{\widetilde \sigma}} \newcommand{\txi}{{\widetilde \xi}} \newcommand{\tSigma}{{\widetilde \Sigma}} \newcommand{\ttau}{{\widetilde \tau}} \newcommand{\ta}{{\widetilde a}} \newcommand{\tb}{{\widetilde b}} \newcommand{\te}{{\widetilde e}} \newcommand{\tv}{{\widetilde v}} \newcommand{\tA}{{\widetilde A}} \newcommand{\tC}{{\widetilde C}} \newcommand{\tD}{{\widetilde D}} \newcommand{\tM}{{\widetilde M}} \newcommand{\tN}{{\widetilde N}} \newcommand{\tT}{{\widetilde T}} \newcommand{\tU}{{\widetilde U}} \newcommand{\tX}{{\widetilde X}} \newcommand{\tY}{{\widetilde Y}} % shortcuts \newcommand{\norm}[1]{\left\| {#1} \right\|} \newcommand{\abs}[1]{\left\lvert {#1} \right\rvert} \newcommand{\wght}[1]{\lvert {#1} \rvert} \newcommand{\I}[1]{\langle #1 \rangle} \newcommand{\bd}{\partial} \newcommand{\from}{\colon\thinspace} \newcommand{\inject}{\hookrightarrow} \newcommand{\inv}{^{-1}} \newcommand{\pmone}{\ensuremath{\{\pm 1\}}} \newcommand{\surject}{\twoheadrightarrow} \newcommand{\GP}[2]{\left( #1 \, . \, #2 \right)} \newcommand{\FN}{F_{N}} \newcommand{\dsym}{d^{\rm \, sym}} \newcommand{\margin}[1]{\marginpar{\scriptsize #1}} \newcommand{\dbtilde}[1]{\widetilde{\raisebox{0pt}[0.85\height]{$\widetilde{#1}$}}} \newcommand{\vsub}{\rotatebox[origin=c]{-90}{$\subseteq$}} % complexes \newcommand{\FF}{\mathrm{FF}} \newcommand{\ZF}{\mathcal{Z}\mathrm{F}} \newcommand{\coS}{\mathrm{CoS(\FN)}} $ 
#| '!! shinylive warning !!': |
#|   shinylive does not work in self-contained HTML documents.
#|   Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 950
# Homeomorphisms of the circle, and isotopies between them
#
# Every homeomorphism f of the circle S^1 = R/Z is described by a LIFT
# F: R -> R, with p(F(x)) = f(p(x)) where p(x) = e^(2 pi i x). For a
# homeomorphism, F(x + 1) = F(x) + k with k = +1 (orientation-preserving, F
# increasing) or k = -1 (orientation-reversing, F decreasing).
#
# The app:
#   * colors the circle by position (a cyclic rainbow, plus numbered marks
#     0..7 at x = 0, 1/8, ..., 7/8) and redraws each color where f sends it;
#   * draws the lift F on [0, 1] next to the diagonal;
#   * runs the straight-line isotopy F_s = (1 - s) F + s G, where the target G
#     is the identity (G(x) = x) for an orientation-preserving map, and the
#     standard reflection z -> conj(z) (G(x) = -x) for an orientation-
#     reversing one. Both F and G climb by the same k per unit, so every F_s
#     does too, and F_s is monotone: each f_s is a homeomorphism.
#   * can force the straight line to the IDENTITY for an orientation-reversing
#     map, to watch it fail: halfway along, F_s is constant on the circle's worth
#     of x and the whole circle collapses (degree -1 cannot become +1).
#
# Run with: shiny::runApp("circle_homeo_app")   (from the Ahnika folder)

library(shiny)
library(ggplot2)
library(dplyr)
library(tibble)

# ---- the homeomorphisms, as lifts F: [0, 1] -> R --------------------------------
#
# Angles are in TURNS (1 turn = 360 degrees), so x and F(x) are in turns.

lift_rotation   <- function(x, theta) x + theta                 # z -> e^(2 pi i theta) z
lift_reflection <- function(x, alpha) 2 * alpha - x             # across the line at angle alpha
lift_wiggle     <- function(x, theta, A) x + theta + A * sin(2 * pi * x)
lift_wiggle_ref <- function(x, theta, A) -(x + theta + A * sin(2 * pi * x))

# Disk automorphism z -> (z - a) / (1 - conj(a) z), restricted to the circle.
# It is an orientation-preserving homeomorphism of S^1 that bunches points up
# near the direction of a. Its lift is the continuous (unwrapped) angle / 2 pi.
lift_mobius <- function(x, r, dir) {
  a <- r * exp(2i * pi * dir)
  z <- exp(2i * pi * x)
  w <- (z - a) / (1 - Conj(a) * z)
  ang <- Arg(w) / (2 * pi)
  ang <- ang + cumsum(c(0, -round(diff(ang))))  # unwrap: remove jumps of +-1
  ang - floor(ang[1])                            # start in [0, 1)
}

map_choices <- c(
  "Rotation" = "rotation",
  "Reflection across a line" = "reflection",
  "Wiggle: x + θ + A sin(2πx)" = "wiggle",
  "Wiggle, then reflect: −(x + θ + A sin(2πx))" = "wiggle_ref",
  "Disk automorphism (z − a)/(1 − āz)" = "mobius"
)

# The lift of the chosen map at the points x (vectorized), and its degree k.
lift_of <- function(x, input) {
  th <- input$theta / 360; A <- input$A
  switch(input$map,
    rotation   = list(F = lift_rotation(x, th), k = 1),
    reflection = list(F = lift_reflection(x, input$alpha / 360), k = -1),
    wiggle     = list(F = lift_wiggle(x, th, A), k = 1),
    wiggle_ref = list(F = lift_wiggle_ref(x, th, A), k = -1),
    mobius     = list(F = lift_mobius(x, input$r, input$dir / 360), k = 1)
  )
}

# ---- drawing ----------------------------------------------------------------------

N  <- 720                                   # sample points on the circle
xs <- seq(0, 1, length.out = N + 1)         # closed: xs[N + 1] = 1 ~ xs[1] = 0
hue <- function(x) hsv(h = x %% 1, s = 0.8, v = 0.92)
marks <- (0:7) / 8

# One colored circle: the point x is drawn at angle 2 pi * pos(x) with color
# hue(x). Segments between consecutive samples carry the color of their start.
# `radius` lets the domain and image be drawn as concentric rings if wanted.
ring_df <- function(pos, radius = 1) {
  ang <- 2 * pi * pos
  tibble(x = radius * cos(ang[-length(ang)]), y = radius * sin(ang[-length(ang)]),
         xend = radius * cos(ang[-1]), yend = radius * sin(ang[-1]),
         col = hue(xs[-length(xs)]))
}

circle_plot <- function(pos, pos_marks, title, warn = NULL) {
  r <- ring_df(pos)
  m <- tibble(x = 1.17 * cos(2 * pi * pos_marks), y = 1.17 * sin(2 * pi * pos_marks),
              px = cos(2 * pi * pos_marks), py = sin(2 * pi * pos_marks),
              lab = 0:7, col = hue(marks))
  p <- ggplot() +
    annotate("path", x = cos(seq(0, 2 * pi, length.out = 200)),
             y = sin(seq(0, 2 * pi, length.out = 200)), colour = "grey90", linewidth = 6) +
    geom_segment(data = r, aes(x, y, xend = xend, yend = yend, colour = col),
                 linewidth = 4, lineend = "round") +
    geom_point(data = m, aes(px, py), colour = "white", size = 3.2) +
    geom_point(data = m, aes(px, py, colour = col), size = 2.2) +
    geom_text(data = m, aes(x, y, label = lab, colour = col), size = 5, fontface = "bold") +
    scale_colour_identity() +
    coord_fixed(xlim = c(-1.35, 1.35), ylim = c(-1.35, 1.35)) +
    labs(title = title, subtitle = warn) +
    theme_void(base_size = 14) +
    theme(plot.title = element_text(hjust = 0.5, face = "bold"),
          plot.subtitle = element_text(hjust = 0.5, colour = "#A32D2D"),
          plot.background = element_rect(fill = "white", colour = NA))
  p
}

lift_plot <- function(F0, Fs, G, s) {
  d <- bind_rows(
    tibble(x = xs, y = F0, which = "F (the chosen map)"),
    tibble(x = xs, y = G,  which = "G (the target)"),
    tibble(x = xs, y = Fs, which = sprintf("F_s, s = %.2f", s))
  ) |>
    mutate(which = factor(which, levels = unique(which)))
  seg <- tibble(x = xs[-length(xs)], xend = xs[-1], y = Fs[-length(Fs)], yend = Fs[-1],
                col = hue(xs[-length(xs)]))
  ggplot() +
    geom_line(data = filter(d, which != levels(which)[3]),
              aes(x, y, linetype = which), colour = "grey45", linewidth = 0.7) +
    geom_segment(data = seg, aes(x, y, xend = xend, yend = yend, colour = col), linewidth = 1.8) +
    scale_colour_identity() +
    scale_linetype_manual(values = c("dashed", "dotted"), name = NULL) +
    labs(x = "x (turns)", y = "lift (turns)",
         title = "Lifts on [0, 1]",
         subtitle = "Colored curve: F_s. Over each unit interval it climbs by k = ±1.") +
    theme_minimal(base_size = 13) +
    theme(legend.position = "bottom",
          plot.background = element_rect(fill = "white", colour = NA))
}

# ---- UI ---------------------------------------------------------------------------

ui <- fluidPage(
  titlePanel("Homeomorphisms of the circle"),
  sidebarLayout(
    sidebarPanel(
      width = 3,
      selectInput("map", "Homeomorphism f", choices = map_choices, selected = "wiggle"),
      conditionalPanel("input.map == 'rotation' || input.map == 'wiggle' || input.map == 'wiggle_ref'",
        sliderInput("theta", "θ (degrees)", min = -180, max = 180, value = 60, step = 1)),
      conditionalPanel("input.map == 'wiggle' || input.map == 'wiggle_ref'",
        sliderInput("A", "Wiggle amplitude A", min = 0, max = 0.25, value = round(1 / (4 * pi), 3),
                    step = 0.001),
        helpText("Homeomorphism exactly when A ≤ 1/(2π) ≈ 0.159.",
                 "The default is 1/(4π) ≈ 0.080.")),
      conditionalPanel("input.map == 'reflection'",
        sliderInput("alpha", "Axis angle α (degrees)", min = 0, max = 180, value = 30, step = 1)),
      conditionalPanel("input.map == 'mobius'",
        sliderInput("r", "|a| (how strongly points bunch up)", min = 0, max = 0.95,
                    value = 0.6, step = 0.01),
        sliderInput("dir", "Direction of a (degrees)", min = 0, max = 360, value = 0, step = 1)),
      hr(),
      h4("Isotopy"),
      sliderInput("s", "s", min = 0, max = 1, value = 0, step = 0.01,
                  animate = animationOptions(interval = 80)),
      helpText("F_s = (1 − s) F + s G. The target G is the identity for an",
               "orientation-preserving f, and the reflection z ↦ z̄ for an",
               "orientation-reversing one."),
      checkboxInput("force_id", "Orientation-reversing f: aim at the identity anyway", FALSE),
      helpText("Watch it fail: at s = 1/2 the whole circle collapses to a point.")
    ),
    mainPanel(
      width = 9,
      fluidRow(
        column(6, plotOutput("domain", height = "380px")),
        column(6, plotOutput("image", height = "380px"))
      ),
      fluidRow(
        column(7, plotOutput("lift", height = "330px")),
        column(5, h4("Status"), tableOutput("status"),
               helpText("Left: the circle, each point colored by where it starts.",
                        "Right: each color redrawn where f_s sends it. Numbers",
                        "0–7 mark x = 0, 1/8, …, 7/8; they run counterclockwise",
                        "after an orientation-preserving map and clockwise after",
                        "an orientation-reversing one."))
      )
    )
  )
)

# ---- server -----------------------------------------------------------------------

server <- function(input, output, session) {

  # The chosen map, its degree, the target G, and F_s.
  st <- reactive({
    L  <- lift_of(xs, input)
    Lm <- lift_of(marks, input)
    to_id <- L$k == 1 || isTRUE(input$force_id)
    G  <- if (to_id) xs else -xs
    Gm <- if (to_id) marks else -marks
    s  <- input$s
    Fs  <- (1 - s) * L$F + s * G
    Fsm <- (1 - s) * Lm$F + s * Gm
    dF  <- diff(Fs)
    mono <- all(dF > 1e-12) || all(dF < -1e-12)
    # F_s defines a map of the circle only if F_s(x + 1) - F_s(x) is an integer.
    deg <- Fs[length(Fs)] - Fs[1]
    circle_map <- abs(deg - round(deg)) < 1e-9
    list(F = L$F, k = L$k, G = G, Fs = Fs, Fsm = Fsm, s = s, to_id = to_id,
         degree = deg, circle_map = circle_map,
         homeo = circle_map && mono && abs(round(deg)) == 1,
         min_slope = min(dF) * N, max_slope = max(dF) * N)
  })

  output$domain <- renderPlot(circle_plot(xs, marks, "Domain: the circle"), res = 96)

  output$image <- renderPlot({
    S <- st()
    warn <- if (!S$circle_map) {
      sprintf("F_s(x+1) − F_s(x) = %.2f is not an integer: no map of the circle", S$degree)
    } else if (!S$homeo) "f_s is not a homeomorphism here" else NULL
    circle_plot(S$Fs, S$Fsm, sprintf("Image under f_s  (s = %.2f)", S$s), warn)
  }, res = 96)

  output$lift <- renderPlot({ S <- st(); lift_plot(S$F, S$Fs, S$G, S$s) }, res = 96)

  output$status <- renderTable({
    S <- st()
    tibble(
      ` ` = c("orientation of f", "isotopy target G", "degree of f_s  (F_s(1) − F_s(0))",
              "slope of F_s: min, max", "f_s a homeomorphism?"),
      value = c(if (S$k == 1) "preserving (k = +1)" else "reversing (k = −1)",
                if (S$to_id) "identity, G(x) = x" else "reflection z ↦ z̄, G(x) = −x",
                if (S$circle_map) format(round(S$degree)) else
                  sprintf("%.3f (not an integer: F_s is not a circle map)", S$degree),
                sprintf("%.3f, %.3f", S$min_slope, S$max_slope),
                if (S$homeo) "yes" else if (!S$circle_map) "no: not even a map of the circle"
                else "no: F_s is not monotone")
    )
  }, striped = TRUE, spacing = "s")
}

shinyApp(ui, server)