{
 "cells": [
  {
   "cell_type": "markdown",
   "id": "2eccae4a",
   "metadata": {},
   "source": [
    "# Ising-Lenz Ergodicity: Generate Time Power-laws in Kappa for Field variation\n",
    "\n",
    "    \n",
    "     (c) 2013, 2014, 2015, 2016, 2025 Süzen\n",
    "     GPL v3 \n",
    "\n",
    "This notebook generates power-laws in the form, $\\Kappa_{G}(t) \\sim C t^{\\alpha}$. Using outputs from generate gamma. power-laws are fitted and results are repored with the bias corrected bootstrap confidence intervals. \n",
    "\n",
    "The resulting dataset is called `ising1DrateErgodicityPowerlawsTime.rds`. \n",
    "\n",
    "$\\Omega_{G}(t)$ : Modified TM G-metric, ergodic convergence.  \n",
    "$\\Gamma_{G}(t)$ : Rate of ergodic convergence.  \n",
    "$\\Kappa_{G}(t)$ : Inverse rate of ergodic convergence.  \n",
    "\n",
    "\n",
    "* Workhorse of the data generation is method `performIS_repeat`. The RDS file is simply \n",
    "an object of list, each member is the output of this method, a named list. See return of this method.\n",
    "Average magnetisations are reported there, 10 repeats\n",
    "* Parameters are hardcoded in paralell method below.\n",
    "     * Sizes at Metropolis (`transP=1`)  and Glauber (`transP=2`) Dynamics `N=512, 1024, 1536`.\n",
    "     * Field ranges `seq(from = 0.5, by = 0.06, length.out = 16)`.\n",
    "     * `J=1.0 ikBT=1.0`.\n",
    "     * MC steps `5e6`.\n",
    "* KS distances for optimal alpha   \n",
    "  `1e4, 5e4, 1e5, 1.5e5, 2e5, 2.5e5, 3e5, 6e5, 8e5, 1e6, 1.25e6, 1.5e6, 2e6`\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 1,
   "id": "8d683416",
   "metadata": {
    "vscode": {
     "languageId": "r"
    }
   },
   "outputs": [
    {
     "name": "stderr",
     "output_type": "stream",
     "text": [
      "Loading required package: isingLenzMC\n",
      "\n"
     ]
    }
   ],
   "source": [
    "rm(list=ls()) \n",
    "require(\"isingLenzMC\"); # Developed and tested on v0.2.5 and R v4.5.1\n",
    "library(parallel)       # Core package\n",
    "\n",
    "source(\"../src/power_utilities.R\");"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 2,
   "id": "4029966f",
   "metadata": {
    "vscode": {
     "languageId": "r"
    }
   },
   "outputs": [],
   "source": [
    "fit_power_law <- function(accept_time, gamma_, burn_in = 6) {\n",
    "  # fit power-law given RunSim's result\n",
    "  t0 <- accept_time\n",
    "  g0 <- 1.0 / gamma_\n",
    "  t0 <- t0[2:length(t0)] # avoid initial inf?\n",
    "  g0 <- g0[2:length(g0)]\n",
    "  t <- log10(t0)\n",
    "  g <- log10(g0)\n",
    "  ix <- which(t > burn_in)\n",
    "  x <- t[ix]\n",
    "  y <- g[ix]\n",
    "  model <- lm(y ~ x)\n",
    "  alpha <- as.numeric(model$coefficients[2])\n",
    "  C <- as.numeric(model$coefficients[1])\n",
    "  r2 <- summary(model)$adj.r.squared\n",
    "  yhat <- alpha * x + C\n",
    "  pairlist(\n",
    "    alpha = alpha, C = C, accept_times_log = x,\n",
    "    rate_omega_g_log = y, accept_times_log_full = t,\n",
    "    rate_omega_g_log_full = g,\n",
    "    rate_omega_g_log_fit = yhat,\n",
    "    rate_omega_fit = g0[ix],\n",
    "    accept_times_fit = t0[ix],\n",
    "    r2adj = r2\n",
    "  )\n",
    "}\n",
    "\n",
    "ks_distance <- function(pfit, xmin) { # xmin is in log10\n",
    "  z <- sort(pfit$rate_omega_g_log_fit)\n",
    "  fecdf <- ecdf(z)\n",
    "  fecdf_values <- fecdf(z)\n",
    "  theo_cdf <- 1.0 - abs(xmin / z)^(pfit$alpha)\n",
    "  D <- max(abs(theo_cdf - fecdf_values))\n",
    "  D\n",
    "}\n",
    "\n",
    "select_powerlaw <- function(accept_time, gamma_, burn_in = 6) {\n",
    "  # Pick minimal D & corresponding powerlaw\n",
    "  # On the grid xmin_log\n",
    "  xmin_log <- log10(c(1e4, 5e4, 1e5, 1.5e5, 2e5, 2.5e5, 3e5, 6e5, 8e5, 1e6, 1.25e6, 1.5e6, 2e6))\n",
    "  lx <- length(xmin_log)\n",
    "  pfits <- vector(\"list\", lx)\n",
    "  Ds <- vector(\"list\", lx)\n",
    "  for (i in 1:lx) {\n",
    "    pfits[[i]] <- fit_power_law(accept_time, gamma_, burn_in = xmin_log[[i]])\n",
    "    Ds[[i]] <- ks_distance(pfits[[i]], xmin_log[[i]])\n",
    "  }\n",
    "  Ds_numeric <- as.numeric(Ds)\n",
    "  dix <- which(Ds_numeric == min(Ds_numeric))\n",
    "  pairlist(\"Ds\" = Ds_numeric[[dix]], \"pfit\" = pfits[[dix]], \"xmin\" = xmin_log[[dix]], \"naccept\" = length(accept_time), \"dix\" = dix)\n",
    "}\n",
    "\n",
    "library(boot)\n",
    "\n",
    "get_mean_boot95_bca <- function(data) {\n",
    "  # Bias-corrected bootstraped means and 95$ CI.\n",
    "  mean_boot <- function(data, indices) {\n",
    "    return(mean(data[indices]))\n",
    "  }\n",
    "  boot_result <- boot(data = as.numeric(data), statistic = mean_boot, R = 1000)\n",
    "  boot_means <- boot_result$t\n",
    "  ci <- boot::boot.ci(boot_result, type = \"bca\")$bca[4:5]\n",
    "  list(\"mean\" = boot_result$t0, \"lower\" = ci[1], \"upper\" = ci[2], \"ci\" = ci)\n",
    "}"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 3,
   "id": "99d8dfa8",
   "metadata": {
    "vscode": {
     "languageId": "r"
    }
   },
   "outputs": [],
   "source": [
    "time_power_law <- function(result) {\n",
    "    # Compute power-law with bias corrected bootstrap\n",
    "    nrepeat <- length(result$accept_times_repeats)\n",
    "    pfit_objects <- vector(\"list\", nrepeat)\n",
    "    alphas <- vector(\"list\", nrepeat)\n",
    "    Cs <- vector(\"list\", nrepeat)\n",
    "    optDs <- vector(\"list\", nrepeat)\n",
    "    opt_xmins <- vector(\"list\", nrepeat)\n",
    "    naccepts <- vector(\"list\", nrepeat)\n",
    "    adjR2s <- vector(\"list\", nrepeat)\n",
    "    timeslog <- vector(\"list\", nrepeat)\n",
    "    omegaprimeslogs <- vector(\"list\", nrepeat)\n",
    "\n",
    "    for (i in 1:nrepeat) {\n",
    "        t <- result$accept_times_repeats[[i]]\n",
    "        ga <- result$gamma_repeats[[i]]\n",
    "        pl <- select_powerlaw(t, ga)\n",
    "        pfit_objects[[i]] <- pl$pfit\n",
    "        alphas[[i]] <- pl$pfit$alpha\n",
    "        Cs[[i]] <- pl$pfit$C\n",
    "        optDs[[i]] <- pl$D\n",
    "        opt_xmins[[i]] <- pl$xmin\n",
    "        naccepts[[i]] <- pl$naccept\n",
    "        adjR2s[[i]] <- pl$pfit$r2adj\n",
    "        timeslog[[i]] <- pl$pfit$accept_times_log_full\n",
    "        omegaprimeslogs[[i]] <- pl$pfit$rate_omega_g_log_full\n",
    "    }\n",
    "\n",
    "\n",
    "\n",
    "\n",
    "    # alpha\n",
    "    alpha_s <- get_mean_boot95_bca(as.numeric(alphas))\n",
    "    alpha_mean <- alpha_s$mean\n",
    "    alpha_boot95ci <- c(alpha_s$lower, alpha_s$upper)\n",
    "    # C\n",
    "    C_s <- get_mean_boot95_bca(as.numeric(Cs))\n",
    "    C_mean <- C_s$mean\n",
    "    C_boot95ci <- c(C_s$lower, C_s$upper)\n",
    "\n",
    "    # xmin\n",
    "    xmin_s <- get_mean_boot95_bca(as.numeric(opt_xmins))\n",
    "    xmin_mean <- xmin_s$mean\n",
    "    xmin_boot95ci <- c(xmin_s$lower, xmin_s$upper)\n",
    "\n",
    "    # adjR2\n",
    "    adjR2_s <- get_mean_boot95_bca(as.numeric(adjR2s))\n",
    "    adjR2_mean <- adjR2_s$mean\n",
    "    adjR2_boot95ci <- c(adjR2_s$lower, adjR2_s$upper)\n",
    "\n",
    "    # optD\n",
    "    optDs_s <- get_mean_boot95_bca(as.numeric(optDs))\n",
    "    optDs_mean <- optDs_s$mean\n",
    "    optDs_boot95ci <- c(optDs_s$lower, optDs_s$upper)\n",
    "\n",
    "\n",
    "    meta_info <- list(\n",
    "        \"N\" = result$N,\n",
    "        \"dynamics\" = result$dynamics,\n",
    "        \"ikBT\" = result$ikBT,\n",
    "        \"alpha_mean\" = alpha_mean,\n",
    "        \"alpha_lower\" = alpha_boot95ci[1],\n",
    "        \"alpha_upper\" = alpha_boot95ci[2],\n",
    "        \"C_mean\" = C_mean,\n",
    "        \"C_lower\" = C_boot95ci[1],\n",
    "        \"C_upper\" = C_boot95ci[2],\n",
    "        \"adjR2_mean\" = adjR2_mean,\n",
    "        \"adjR2_lower\" = adjR2_boot95ci[1],\n",
    "        \"adjR2_upper\" = adjR2_boot95ci[2],\n",
    "        \"xmin_mean\" = xmin_mean,\n",
    "        \"xmin_lower\" = xmin_boot95ci[1],\n",
    "        \"xmin_upper\" = xmin_boot95ci[2],\n",
    "        \"optDs_mean\" = optDs_mean,\n",
    "        \"optDs_lower\" = optDs_boot95ci[1],\n",
    "        \"optDs_upper\" = optDs_boot95ci[2],\n",
    "        \"H\" = result$H,\n",
    "        \"J\" = result$J,\n",
    "        \"nrepeat\" = nrepeat\n",
    "    )\n",
    "    meta_info\n",
    "}\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 4,
   "id": "5d055eab",
   "metadata": {
    "vscode": {
     "languageId": "r"
    }
   },
   "outputs": [],
   "source": [
    "ergoRates <- readRDS(\"../datasets/ising1DrateErgodicityFields.rds\")"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 5,
   "id": "da95f752",
   "metadata": {
    "vscode": {
     "languageId": "r"
    }
   },
   "outputs": [],
   "source": [
    "#\n",
    "# Power-laws in the form: Kappa = C t^alpha\n",
    "# Generate chucks of 8  for parallel run.\n",
    "#\n",
    "# ~20m MacM2\n",
    "\n",
    "to_null <- function(x) {\n",
    "    if (is.null(x)) NA else x\n",
    "}\n",
    "\n",
    "for(i in 1:12) {\n",
    "    result_ids <- c(1:8)+(i-1)*8\n",
    "    get_result <- function(i) time_power_law(ergoRates[[i]])\n",
    "    par_result <- mclapply(result_ids, get_result, mc.cores = 8)\n",
    "    for(j in 1:8) {\n",
    "        if(i == 1 & j == 1) {\n",
    "            df_gamma <- as.data.frame(par_result[[j]])\n",
    "        } else {\n",
    "            df_gamma <- rbind.data.frame(df_gamma, as.data.frame(lapply(par_result[[j]], to_null)))\n",
    "        }\n",
    "    }\n",
    "}\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 6,
   "id": "4cd4f72f",
   "metadata": {
    "vscode": {
     "languageId": "r"
    }
   },
   "outputs": [],
   "source": [
    "saveRDS(df_gamma, \"../datasets/ising1DrateErgodicityPowerlawsTimeFields.rds\")"
   ]
  }
 ],
 "metadata": {
  "kernelspec": {
   "display_name": "R",
   "language": "R",
   "name": "ir"
  },
  "language_info": {
   "codemirror_mode": "r",
   "file_extension": ".r",
   "mimetype": "text/x-r-source",
   "name": "R",
   "pygments_lexer": "r",
   "version": "4.5.1"
  }
 },
 "nbformat": 4,
 "nbformat_minor": 5
}
