1 The effects of Kime-Magnitudes and Kime-Phases

Jointly, the amplitude spectrum (magnitudes) and the phase spectrum (phases) uniquely describe the spacetime representation of a signal. However, the importance of each of these two spectra is not equivalent. In general, the effect of the phase spectrum is more important compared to the corresponding effects of the amplitude spectrum. In other words, the magnitudes are less susceptible to noise or the accuracy of their estimations. The effects of magnitude perturbations are less critical relative to proportional changes in the phase spectrum. For instance, particularly in terms of spacetime locations where the signal is zero, the signal can be reconstructed (by the IFT) relatively accurately using incorrect magnitudes solely by using the correct phases REF. For a real valued signal $f$, suppose the amplitude of its Fourier transform, $FT(f)=\hat{f}$, is $A(\omega) > 0, \forall \omega$, then: \[f(x)=IFT(\hat{f})=Re\left (\frac{1}{2\pi}\int_{R} \underbrace{A(\omega)e^{i\phi(\omega)}}_{\hat{f}(\omega)}\ e^{i\omega x}d\omega \right)= Re\left (\frac{1}{2\pi}\int_{R}A(\omega)e^{i(\phi(\omega)+\omega x)}d\omega\right) = \frac{1}{2\pi}\int_{R} {A(\omega) \cos(\phi(\omega)+\omega x)}d\omega.\]

Thus, the zeros of $f(x)$ occur for $\omega x+ \phi(\omega)=\pm k\frac{\pi}{2}$, $k= 1,2,3,.$.

A solely amplitude driven reconstruction $\left ( f_A(x)=IFT(\hat{f})=\frac{1}{2\pi}\int_{R}\underbrace{A(\omega)}_{no\ phase}\ e^{i\omega x}d\omega \right)$ would yield worse results than a solely-phase based reconstruction $\left ( f_{\phi}(x)=IFT(\hat{f})=\frac{1}{2\pi} \int_{R}\underbrace{e^{i\phi(\omega)}}_{no\ amplitude}\ e^{i\omega x}d\omega\right )$. The latter would have a different total energy from the original signal, however, it would include some signal recognizable features as the zeroth-level curves of the original $f$ and the phase-only reconstruction $f_{\phi}$ signals will be preserved. This suggests that the Fourier phase of a signal is more informative than the Fourier amplitude, i.e., the magnitudes are robust to errors or perturbations.

In X-ray crystallography, crystal structures are bombarded by particles/waves, which are diffracted by the crystal to yield the observed diffraction spots or patterns. Each diffraction spot corresponds to a point in the reciprocal lattice and represents a particle wave with some specific amplitude and a relative phase. Probabilistically, as the particles (e.g., gamma-rays or photons) are reflected from the crystal, their scatter directions are proportional to the square of the wave amplitude, i.e., the square of the wave Fourier magnitude. X-rays capture these amplitudes as counts of particle directions, but miss all information about the relative phases of different diffraction patterns.

Spacekime analytics are analogous to X-ray crystallography, DNA helix modeling, and other applications, where only the Fourier magnitudes (time), i.e., power spectrum, is only observed, but not the phases (kime-directions), which need to be estimated to correctly reconstruct the intrinsic 3D object structure REF, in our case, the correct spacekime analytical inference. Clearly, signal reconstruction based solely on either the amplitudes or the phases is an ill-posed problem, i.e., there will be many alternative solutions. In practice, such signal or inference reconstructions are always application-specific, rely on some a priori knowledge on the process (or objective function), or depend an information-theoretic criteria to derive conditional solutions. Frequently, such solutions are obtained via least squares, maximum entropy criteria, maximum a posterior distributions, Bayesian estimations, or simply by approximating the unknown amplitudes or phases using prior observations, similar processes, or theoretical models.

2 Solving the Missing Kime-Phase Problem

There are many alternative solutions to the problem of estimating the unobserved kime-phases. All solutions depend on the quality of the data (e.g., noise), the signal energy (e.g., strength of association between covariates and outcomes), and the general experimental design. There can be rather large errors in the phase reconstructions, which will in turn affect the final spacekime analytic results. Most phase-problem solutions are based on the idea that having some prior knowledge about the characteristics of the experimental design (case-study phenomenon) and the desired inference (spacekime analytics). For instance, if we artificially load the energy of the case-study (e.g., by lowering the noise, increasing the SNR, or increasing the strength of the relation between explanatory and outcome variables), the phases computed from the this stronger-signal dataset will be more accurate representations than the original phase estimates. Examples of phase-problem solutions include energy modification and fitting and refinement methods.

2.1 Energy Modification Strategies

In general, energy modification techniques rely on prior knowledge, testable hypotheses, or intuition to modify the dataset by strengthening the expected relation we are trying to uncover using spacekime analytics.

2.1.1 Kime-phase noise distribution flattening

In many practical applications, part of the dataset (including both cases and features) include valuable information, whereas the rest of the data may include irrelevant, noisy, or disruptive information.

Clearly, we can’t explicitly untangle these two components, however, we do expect that the irrelevant data portion would yield uninformative/unimportant kime-phases, which may be used to estimate the kime-phase noise-level and noise-distribution. Intuitively, if we modify the dataset to flatten the irrelevant kime-phases, the estimates of the corresponding true-signal kime-phases may be more accurate or more representative. We can think of this process as using kime-phase information from some known strong features to improve the kime-phase information of other particular features. Kime-phase noise distribution flattening requires that the kime-phases be good enough to detect the boundaries between the strong-features and the rest.

2.1.2 Multi-sample Kime-Phase Averaging

It’s natural to assume that multiple instances of the same process would yield similar analytics and inference results. For a large dataset, we can use ensemble methods (e.g., SuperLearner, and CBDA) to iteratively generate independent samples, which would be expected to lead to analogous kime-phase estimated and analytical results. Thus, we expect that when salient features are extracted by spacekime analytics based on independent samples, their kime-phase estimates should be highly associated (e.g., correlated), albeit perhaps not identical. However, weak features would exhibit exactly the opposite effect - their kime-phases may be highly variable (noisy). By averaging the kime-phases, noisy-areas in the dataset may cancel out, whereas, patches of strong-signal may preserve the kime-phase details, which would lead to increased kime forecasting accuracy and reproducibility of the kime analytics.

2.1.3 Histogram equalization

As common experimental designs and similar datasets exhibit analogous characteristics, the corresponding spacekime analytics are also expected to be synergistic. Spacekime inference that does not yield results in some controlled or expected range, may be indicative of incorrect kime-phase estimation. We can use histogram equalization methods to improve the kime-phase estimates. This may be accomplished by altering the distribution of kime-phases to either match the phase distribution of other similar experimental designs or generate more expected spacekime analytical results.

2.2 Data Source Type

library(EBImage)
square_arr <- matrix(nrow=256, ncol=256)
circle_arr <- matrix(nrow=256, ncol=256)

for (i in 1:256) {
  for (j in 1:256) {
    if ( abs(i-128) < 30 && abs(j-128) < 30) 
      square_arr[i,j]=1 # sqrt((i-128)^2+(j-128)^2)/30
    else square_arr[i,j]=0
    if ( sqrt((i-128)^2 + (j-128)^2)<30) 
      circle_arr[i,j]=1 # 1-sqrt((i-128)^2+(j-128)^2)/30
    else circle_arr[i,j]=0
  }
}

# FFT SHIFT
#' This function is useful for visualizing the Fourier transform with the zero-frequency 
#' component in the middle of the spectrum.
#' 
#' @param img_ff A Fourier transform of a 1D signal, 2D image, or 3D volume.
#' @param dim Number of dimensions (-1, 1, 2, 3).
#' @return A properly shifted FT of the array.
#' 
fftshift <- function(img_ff, dim = -1) {

  rows <- dim(img_ff)[1]    
  cols <- dim(img_ff)[2]
  # planes <- dim(img_ff)[3]

  swap_up_down <- function(img_ff) {
    rows_half <- ceiling(rows/2)
    return(rbind(img_ff[((rows_half+1):rows), (1:cols)], img_ff[(1:rows_half), (1:cols)]))
  }

  swap_left_right <- function(img_ff) {
    cols_half <- ceiling(cols/2)
    return(cbind(img_ff[1:rows, ((cols_half+1):cols)], img_ff[1:rows, 1:cols_half]))
  }
  
  #swap_side2side <- function(img_ff) {
  #  planes_half <- ceiling(planes/2)
  #  return(cbind(img_ff[1:rows, 1:cols, ((planes_half+1):planes)], img_ff[1:rows, 1:cols, 1:planes_half]))
  #}

  if (dim == -1) {
    img_ff <- swap_up_down(img_ff)
    return(swap_left_right(img_ff))
  }
  else if (dim == 1) {
    return(swap_up_down(img_ff))
  }
  else if (dim == 2) {
    return(swap_left_right(img_ff))
  }
  else if (dim == 3) {
    # Use the `abind` package to bind along any dimension a pair of multi-dimensional arrays
    # install.packages("abind")
    library(abind)
    
    planes <- dim(img_ff)[3]
    rows_half <- ceiling(rows/2)
    cols_half <- ceiling(cols/2)
    planes_half <- ceiling(planes/2)
    
    img_ff <- abind(img_ff[((rows_half+1):rows), (1:cols), (1:planes)], 
                    img_ff[(1:rows_half), (1:cols), (1:planes)], along=1)
    img_ff <- abind(img_ff[1:rows, ((cols_half+1):cols), (1:planes)], 
                    img_ff[1:rows, 1:cols_half, (1:planes)], along=2)
    img_ff <- abind(img_ff[1:rows, 1:cols, ((planes_half+1):planes)], 
                    img_ff[1:rows, 1:cols, 1:planes_half], along=3)
    return(img_ff)
  }
  else {
    stop("Invalid dimension parameter")
  }
}

2.3 Figure 3.8

# image(square_arr); image(circle_arr)
# display(circle_arr, method = "raster")
display(square_arr, method = "raster")

X1 = fft(square_arr)
X1_mag <- sqrt(Re(X1)^2+Im(X1)^2)
X1_phase  <- atan2(Im(X1), Re(X1))

# FT of Circle # No shift applied here (perhaps should be consistent or just show the difference?)
X2 = fft(circle_arr) # display(Re(X2), method = "raster")
X2_mag <- sqrt(Re(X2)^2+Im(X2)^2) # display(X2_mag, method = "raster") # magnitude only
X2_phase  <- atan2(Im(X2), Re(X2)) # display(X2_phase, method = "raster") # phase only
display(fftshift(X1_mag), method = "raster")

# Take 2: IFT Magnitude= Square and Phase = Square + IID noise (N(0,3/2))
set.seed(1234)
IID_noise <- matrix(rnorm(prod(dim(X1_phase)), mean=0, sd=1.5), nrow=dim(X1_phase)[1])
# dim(IID_noise) # 256 256
Real = X1_mag * cos(X1_phase + IID_noise)
Imaginary = X1_mag * sin(X1_phase + IID_noise)
ift_X1mag_X1phase_Noise = Re(fft(Real+1i*Imaginary, inverse = T)/length(X1))
plot(density(IID_noise), xlim=c(-8,8), col="blue", lwd=2)
lines(density(X1_phase), col="red", lwd=2)

mixed_density <- density(X1_phase + IID_noise)
mixed_density_mod2pi <- density((X1_phase + IID_noise)%%(2*pi) -pi)
display(ift_X1mag_X1phase_Noise, method = "raster")

plot(mixed_density, 
     xlim=c(-8,8), ylim=c(0,0.17), col="blue", lwd=2,  # should density be modulo %%(2*pi)?
     main="Phase Distributions: Raw Square, Square+IID N(m=0,s=3/2), Mixed Phases mod 2*Pi", 
     cex.main=0.8, xlab = "Phase", ylab = "Density")
lines(density(X1_phase), col="red", lwd=4)
lines(mixed_density_mod2pi, col="green", lwd=2)
text(x=3.2, y=-0.005, expression(pi))
text(x=-3.2, y=-0.005, expression(-pi))
legend("center", 
       legend=c("(Raw) Square Phases", "Square + N(0,1.5)", 
                expression(paste("Square + N(0,1.5) mod 2*", pi))),
       col=c("red","blue", "green"), lty=1, lwd=c(4,2,2), cex=1.0, y.intersp=1.0,
       x.intersp=1.0, title = "Phases", bty = "n")

# randomly sample 10 indices to pairwise plot
ind1 <- sample(dim(X1_phase)[1], 10); ind2 <- sample(dim(X1_phase)[2], 10) 
corr <- cor.test((X1_phase)[ind1,ind2], 
                 (X1_phase + IID_noise)[ind1,ind2], method = "pearson", conf.level = 0.99)

plot((X1_phase)[ind1,ind2], (X1_phase + IID_noise)[ind1,ind2],
     main=
       sprintf("Square Image: Raw vs. IID N(m=0,s=3/2) Noise-corrupted Phases: Corr=%s CI=(%s,%s)", 
               round(cor(as.vector(X1_phase), as.vector(X1_phase + IID_noise)), digits=3),
               round(corr$conf.int[1], digits=2),
               round(corr$conf.int[2], digits=2)), 
     cex.main=0.8, xlab = "Raw", ylab = "Phase + N(0,1.5)")
abline(
  lm(as.vector((X1_phase + IID_noise)[ind1,ind2]) ~ as.vector((X1_phase)[ind1,ind2])), 
  col="red", lwd=2)

# Take 2: Same level of noise on Amplitudes:
# IFT Magnitude= Square + 50*IID noise (N(0,3/2)) and Phase = Square
set.seed(1234)
IID_noise <- matrix(rnorm(prod(dim(X1_mag)), mean=0, sd=3/2), nrow=dim(X1_mag)[1])
# dim(IID_noise) # 256 256
corr <- cor.test((X1_mag+50*IID_noise)[ind1,ind2], 
                 (X1_mag)[ind1,ind2], method = "pearson", conf.level = 0.99)
plot(density(X1_mag+50*IID_noise), xlim=c(0,40), ylim=c(0,1.5), col="blue", lwd=2)
lines(density(X1_mag), col="red", lwd=2)

plot(X1_mag[ind1,ind2], abs(X1_mag+50*IID_noise)[ind1,ind2], xlim=c(0,10), ylim=c(0,200),
     main=
       sprintf("Square Image: Mag + 50*IID N(m=0,s=3/2) Noise-corrupted vs. Raw Amplitudes: Corr=%s CI=(%s,%s)", 
               round(cor(as.vector(X1_mag), as.vector(X1_mag + 50*IID_noise)), digits=3),
               round(corr$conf.int[1], digits=2),
               round(corr$conf.int[2], digits=2)), 
     cex.main=0.8, xlab = "Raw", ylab = "Amplitude + 50*N(0,1.5)")
abline(
  lm(as.vector(abs(X1_mag+50*IID_noise)[ind1,ind2]) ~ as.vector((X1_mag)[ind1,ind2])), 
  col="red", lwd=2)

Real = (X1_mag+ 50*IID_noise) * cos(X1_phase)
Imaginary = (X1_mag+ 50*IID_noise) * sin(X1_phase)
ift_X1mag_X1phase_Noise = Re(fft(Real+1i*Imaginary, inverse = T)/length(X1))
display(ift_X1mag_X1phase_Noise, method = "raster")

# Magnitude distributions
mixed_density <- density(abs(X1_mag + 50*IID_noise))
plot(mixed_density, xlim=c(0,200), col="blue", lwd=2, 
     main="Magnitude Distributions: Raw Square, Square+50*N(m=0,s=3/2)", 
     xlab = "Magnitude", ylab = "Density")
lines(density(X1_mag), col="red", lwd=4)
legend("topright", legend=c("(Raw) Square Magnitudes", "Square + 50*N(0,1.5)"),
       col=c("red","blue"), lty=1, lwd=c(4,2), cex=1.0, y.intersp=1.0,
       x.intersp=1.0, title = "Magnitudes", bty = "n")

# Take 3: Linear Transform of the Phases: SquarePhase ~ CirclePhase
# Take 2: IFT Magnitude= Square and Phase = LM(CirclePhase)
lm_Squ_Cir <- lm(as.vector(X1_phase) ~ as.vector(X2_phase))
plot(as.vector(X2_phase), as.vector(X1_phase), col="blue", lwd=2, 
     xlab = "Circle", ylab = "Square",
     main=
       sprintf("Linear Phase Transformation (SquarePhase ~ CirclePhase), Corr(Cir, Squ)=%s",
               round(cor(as.vector(X1_phase) , as.vector(X2_phase)), digits=3))) 
abline(lm_Squ_Cir, col="red", lwd=2)

Real = X1_mag * cos(lm_Squ_Cir$coefficients[1] + lm_Squ_Cir$coefficients[2]*X2_phase)
Imaginary = X1_mag * sin(lm_Squ_Cir$coefficients[1] + lm_Squ_Cir$coefficients[2]*X2_phase)
ift_X1mag_X2phase_LM = Re(fft(Real+1i*Imaginary, inverse = T)/length(X1))
display(ift_X1mag_X2phase_LM, method = "raster")

3 QM Phase Estimation by Probing Measurements in Different Bases

The fundamental rationale for observing only the magnitude of the quantum wavefunction, while phases remain unobservable directly, stems from the structure of quantum mechanics. Physical observables are always real, tied to Hermitian operators, and measurement outcomes depend on probabilities derived from the squared magnitude of the wavefunction, $|\psi(x)|^2$. Global or relative phases do not affect these probabilities, unless they manifest as relative phase differences in superposition states. Global phases cancel out in expectation values, while relative phases influence interference patterns, which are still inferred indirectly through probabilities. Thus, direct phase measurement is impossible. Instead, phases are estimated by observing interference effects across multiple measurement bases.

3.1 Pauli Operators and Bases in Quantum Mechanics

The relationship between Pauli operators and bases is fundamental to quantum mechanics. Pauli operators are matrix representations of Pauli matrices plus the identity matrix that form a basis for $2\times 2$ Hermitian matrices

\[\sigma_x = \begin{pmatrix} 0 & 1 \\ 1 & 0 \end{pmatrix}\ , \quad \sigma_y = \begin{pmatrix} 0 & -i \\ i & 0 \end{pmatrix}\ , \quad \sigma_z = \begin{pmatrix} 1 & 0 \\ 0 & -1 \end{pmatrix}\ , \quad I = \begin{pmatrix} 1 & 0 \\ 0 & 1 \end{pmatrix}\]

The eigenspectrum of each Pauli operator includes the eigenvalues $\lambda = \pm 1$ with their base-specific corresponding eigenvectors. For the computational basis, $\sigma_z$,

the eigenvector $|0\rangle = \begin{pmatrix} 1 \\ 0 \end{pmatrix}$ corresponds with eigenvalue $\lambda = +1$,
and the eigenvector $|1\rangle = \begin{pmatrix} 0 \\ 1 \end{pmatrix}$ corresponds with eigenvalue $\lambda = -1$.

Similarly, for the $X$-basis, $\sigma_x$

$|+\rangle = \frac{1}{\sqrt{2}}(|0\rangle + |1\rangle) = \frac{1}{\sqrt{2}}\begin{pmatrix} 1 \\ 1 \end{pmatrix}$ with $\lambda = +1$,
$|-\rangle = \frac{1}{\sqrt{2}}(|0\rangle - |1\rangle) = \frac{1}{\sqrt{2}}\begin{pmatrix} 1 \\ -1 \end{pmatrix}$ with $\lambda = -1$.

And for the $Y$-basis, $\sigma_y$

$|+i\rangle = \frac{1}{\sqrt{2}}(|0\rangle + i|1\rangle) = \frac{1}{\sqrt{2}}\begin{pmatrix} 1 \\ i \end{pmatrix}$ with $\lambda = +1$,
$|-i\rangle = \frac{1}{\sqrt{2}}(|0\rangle - i|1\rangle) = \frac{1}{\sqrt{2}}\begin{pmatrix} 1 \\ -i \end{pmatrix}$ with $\lambda = -1$.

The Pauli matrices satisfy important commutation relations:

\[[\sigma_k, \sigma_l] = 2\mathrm{i}\epsilon_{klm}\sigma_m,\]

where $[\sigma_k, \sigma_l] = \sigma_k\sigma_l - \sigma_l\sigma_k$ is the commutator, $\mathrm{i}$ is the imaginary unit, the indices $k,l,m$ run over $\{1,2,3\}$ corresponding to $\{x\equiv 1,y\equiv 2,z\equiv 3\}$, we use the Einstein summation convention with summation over repeated index $m$, and $\epsilon_{klm}$ is the Levi-Civita symbol, \[\epsilon_{klm} = \begin{cases} +1 & \text{for even permutations of } (1,2,3) \\ -1 & \text{for odd permutations of } (1,2,3) \\ 0 & \text{if any indices are repeated} \end{cases} .\]

Explicitly, this gives \[[\sigma_x, \sigma_y] = [\sigma_1, \sigma_2] = 2\mathrm{i}\sigma_z,\quad i.e., \quad [\sigma_1, \sigma_2] = 2\mathrm{i}\sigma_3\] \[[\sigma_y, \sigma_z] = [\sigma_2, \sigma_3] = 2\mathrm{i}\sigma_x,\quad i.e., \quad [\sigma_2, \sigma_3] = 2\mathrm{i}\sigma_1,\] \[[\sigma_z, \sigma_x] = [\sigma_3, \sigma_1] = 2\mathrm{i}\sigma_y\quad i.e., \quad [\sigma_3, \sigma_1] = 2\mathrm{i}\sigma_2.\]

In 2D, these relations can be verified directly using the matrix representations

\[\sigma_1 = \begin{pmatrix} 0 & 1 \\ 1 & 0 \end{pmatrix}, \quad \sigma_2 = \begin{pmatrix} 0 & -\mathrm{i} \\ \mathrm{i} & 0 \end{pmatrix}, \quad \sigma_3 = \begin{pmatrix} 1 & 0 \\ 0 & -1 \end{pmatrix}.\]

In QM, this cyclic structure reflects the rotational symmetry of the Pauli matrices and is fundamental to their role in describing spin-$1/2$ systems and qubit operations. They also satisfy anticommutation relations $\{\sigma_i, \sigma_j\} = 2\delta_{ij}I$, where $\delta_{ij}$ is the Kronecker delta. For each basis we also have the completeness relations, in the $\sigma_z$ basis, $|0\rangle\langle 0| + |1\rangle\langle 1| = I$, in the $\sigma_x$ basis, $|+\rangle\langle +| + |-\rangle\langle -| = I$, and in the $\sigma_y$ basis $|+i\rangle\langle +i| + |-i\rangle\langle -i| = I$.

Any single-qubit unitary operation can be expressed as \[U = e^{i\alpha}e^{i(\theta_x\sigma_x + \theta_y\sigma_y + \theta_z\sigma_z)},\] where $\alpha, \theta_x, \theta_y, \theta_z$ are real parameters.

The non-commutativity leads to uncertainty relations $\Delta A \Delta B \geq \frac{1}{2}|\langle [A,B] \rangle|$, where the lower bound holds in a state-dependent manner, e.g., consider an example state $|= |+|=|+$ where $\langle \sigma_z \rangle \not= 0$. For Pauli operators, this means $\Delta \sigma_x \Delta \sigma_y \geq |\langle \sigma_z \rangle|$, with cyclic permutations.

A measurement in any Pauli basis corresponds to projectors; for the $\sigma_z$ basis, $P_0 = |0\rangle\langle 0|$, $P_1 = |1\rangle\langle 1|$, for the $\sigma_x$ basis, $P_+ = |+\rangle\langle +|$, $P_- = |-\rangle\langle -|$, and for the $\sigma_y$ basis, $P_{+i} = |+i\rangle\langle +i|$, $P_{-i} = |-i\rangle\langle -i|$. The Bloch sphere representation indicates that any single-qubit state can be written as $|\psi\rangle = \cos(\theta/2)|0\rangle + e^{i\phi}\sin(\theta/2)|1\rangle$, where $\theta$ and $\phi$ are spherical coordinates on the Bloch sphere, with radius $r=1$. Finally, the expectation values of Pauli operators reflect the relation between the classical Cartesian coordinates and spherical coordinates

\[x=\langle \sigma_x \rangle = \sin\theta\cos\phi, \quad y=\langle \sigma_y \rangle = \sin\theta\sin\phi, \quad z=\langle \sigma_z \rangle = \cos\theta.\]

3.2 Example: Qubit Phase Estimation

Consider a qubit in the state $|\psi\rangle = \frac{1}{\sqrt{2}}\left(|0\rangle + e^{i\phi}|1\rangle\right),$ where $\phi$ is the relative phase. We will show how to probe the phase $\phi$ by collecting process measurement in 3 different bases.

Measurement in the Computational Basis, $Z$-basis, $|0\rangle, |1\rangle$: The probabilities $P(0) = |\langle 0|\psi\rangle|^2 = \frac{1}{2}$ and $P(1) = |\langle 1|\psi\rangle|^2=\frac{1}{2}$ are independent of $\phi$, and hence, no phase information is obtained purely by measurements in the $Z$-basis.
Measurement in the $X$-Basis, $|+\rangle, |-\rangle$: The states $|+\rangle = \frac{1}{\sqrt{2}}(|0\rangle + |1\rangle)$ and $|-\rangle = \frac{1}{\sqrt{2}}(|0\rangle - |1\rangle)$ transform the phase into measurable probabilities, which reveals $\cos\phi$

\[P(+) = \frac{1 + \cos\phi}{2}, \quad P(-) = \frac{1 - \cos\phi}{2}.\]

Measurement in the $Y$-Basis, $|y_+\rangle, |y_-\rangle$: Measuring the states $|y_+\rangle = \frac{1}{\sqrt{2}}(|0\rangle + i|1\rangle)$ and $|y_-\rangle = \frac{1}{\sqrt{2}}(|0\rangle - i|1\rangle)$ reveals $\sin\phi$

\[P(y_+) = \frac{1 + \sin\phi}{2}, \quad P(y_-) = \frac{1 - \sin\phi}{2}.\]

By combining results from the $X$- and $Y$-bases, both $\cos\phi$ and $\sin\phi$ are determined, allowing reconstruction of $\phi$ modulo $2\pi$. In essence, the phases are encoded in interference patterns that depend on the measurement basis. By choosing multiple non-commuting (incompatible) bases (e.g., $X$, $Y$, and $Z$), the relative phase information is rotated into observable probabilities. This underpins techniques like quantum state tomography and interferometry, where phase estimation relies on coherence across complementary observables.

3.2.1 Adding a Commuting Basis to the $Y$-Basis Adds No New Phase Information

When two observables commute, their eigenbases are identical (or compatible). Measuring in a commuting basis is equivalent to measuring in the original basis. Phase estimation requires measurements in complementary bases. To resolve $\phi$, we need measurements in non-commuting bases (e.g., $X$- and $Y$-bases). Complementary bases “probe” the phase through interference in distinct directions. For a single qubit, all observables commuting with $Y$ are trivial linear combinations of $Y$ and $I$, so no new eigenbases exist. In larger systems, degeneracy allows commuting observables with distinct eigenbases, but even there, relative phases are resolved via non-commuting measurements.

Let’s demonstrate that adding measurements in a new basis that commutes with the $Y$-basis adds no new phase information, still using the same qubit example and utilizing the Pauli-$Y$ operator. For a single qubit, since $Y$ has no degeneracy in its spectrum, any observable commuting with $Y$ must share its eigenbasis. Let’s define a trivial commuting operator, e.g., $\mathcal{O} = Y + \alpha I$, where $\alpha \in \mathbb{R}$ and $I$ is the identity operator. The new operator $\mathcal{O}$ shares the same eigenstates $|y_+\rangle$ and $|y_-\rangle$ as $Y$. Hence, measuring in the $\mathcal{O}$-basis is equivalent to measuring in the $Y$-basis itself.

Again, let the qubit state be $|\psi\rangle = \frac{1}{\sqrt{2}}\left(|0\rangle + e^{i\phi}|1\rangle\right).$ A measurement in the $Y$-Basis $\left (|y_+\rangle, |y_-\rangle\right )$ gives probabilities that reveal $\sin\phi$, \[P(y_+) = \frac{1 + \sin\phi}{2}, \quad P(y_-) = \frac{1 - \sin\phi}{2}.\]

On the other hand, a measurement in the new commuting basis, $\mathcal{O}$ $\left (|y_+\rangle, |y_-\rangle\right )$, reflects observations in the eigenbasis of $\mathcal{O} = Y + \alpha I$. Since $\mathcal{O}$ shares its eigenstates with $Y$, the probabilities are identical

\[P(y_+^\mathcal{O}) \equiv P(y_+)= \frac{1 + \sin\phi}{2}, \quad P(y_-^\mathcal{O}) \equiv P(y_-)= \frac{1 - \sin\phi}{2},\] which indicates that no new information about $\phi$ is obtained by jointly measuring in the commuting basis. That is, measurements in $\mathcal{O}$ merely replicate the $Y$-basis result.

Adding a commuting basis (e.g., $\mathcal{O} = Y + \alpha I$) provides no independent data about $\phi$. Only by measuring in non-commuting bases (e.g., $X$- and $Y$-bases) can we reconstruct the phase. This principle is foundational to quantum state tomography and phase estimation protocols like quantum Fourier transform.

4 From QM Wavefunction Phase Estimation to Kime-phase Estimation in Spacekime Representation

Recall the earlier spacekime formulation of the complex-time representation (kime, $\kappa = t e^{i\theta}$) of repeated measurements corresponding to random draws from a time t-dependent kime-phase distribution ($\theta \sim \Phi(t)$). As the kime-phase is unobservable, we will explore strategies for introducing kime-measurement schemes, which are inspired by the quantum mechanical approach for recovering (or estimating) of the wavefunction phase, by taking repeated measurements in different non-commutative bases. Specifically, we’ll extend “commutation” of variables (operators) in QM to distribution-action in kime-representation. This will provide a way to probe the enigmatic kime-phase by evaluating the action of different (time-dependent) kime-phase distributions $\Phi(t)$ on the class of kime-test functions, where the phase-distributions resemble the different bases in QM.

4.1 Approach 1

Approach 1 is a conceptual roadmap for designing a kime-measurement protocol that mimics quantum mechanical strategies for recovering wavefunction phase via repeated measurements in non-commuting bases. Quantum mechanics uses multiple, incompatible measurement bases to glean partial information about the complex amplitudes (including phases) of a quantum state. This approach attempts an analogous scheme in the kime framework by defining multiple families of kime-test functions - “kime operators” - whose “actions” on a hidden phase distribution $\Phi(t)$ can reveal partial information about $\Phi$.

Effectively, we probe the “kime-phase” distribution $\Phi(t)$ by evaluating several distinct functionals (i.e., the actions of $\Phi$ on different test functions). If these families of test functions are in some sense “incompatible” (akin to non-commuting bases), then multiple measurements reveal more details (information) about the phase distribution. This is analogous to how QM measurements in multiple bases proble the phase of the quantum wavefunction.

In standard QM, we measure a state $\lvert\psi\rangle$ in different bases, e.g., the $\{\lvert x\rangle\}$ basis for position, the $\{\lvert p\rangle\}$ basis for momentum. These bases are represented by non-commuting observables $\hat{X}$ and $\hat{P}$. Each measurement yields a probability distribution $\lvert\langle x\mid \psi\rangle\rvert^2$ or $\lvert\langle p\mid \psi\rangle\rvert^2$. Together, these distributions provide partial constraints on the full complex wavefunction (including the relative phases). The non-commutation ensures we cannot measure both bases simultaneously with arbitrary precision; hence we need repeated trials (fresh copies of the state $\lvert\psi\rangle$) to measure across different bases.
Thus, phase retrieval in QM is intimately linked to measuring multiple incompatible observables. Each “basis” picks up a different interference pattern, revealing complementary aspects of the wavefunction’s phase structure.

In the Kime Picture, we similarly probe the phase distribution $\Phi(t)$ by posing that the kime-magnitude, i.e., the usual time, $t = |\kappa|$, and the kime-phase $\theta$ is drawn from an unknown distribution $\Phi(\theta; t)$. We can treat $\theta$ as a “random quantity” unobservable in a direct sense - similar to how in standard QM, the wavefunction’s global phase is unobservable, but relative phases manifest in interference patterns. Our goal is to devise a scheme akin to “probing $\theta$” by making repeated measurements that “test” the distribution $\Phi$ with different functionals or operators, each of which partially encodes phase information.

Following the classical distribution theory formalism, we’ll consider the phase distirbution $\Phi(\theta; t)$ as a generalized function or measure. We only “see” $\Phi$ indirectly via its action on test functions $f(\theta)$, e.g., $\langle \Phi,\, f\rangle \;=\;\int f(\theta)\,\Phi(\theta;t)\,d\theta.$ A single test function $f$ can be viewed as a single “measurement setting,” from which we glean $\text{(Measured value)} \;=\; \int f(\theta)\,\Phi(\theta;t)\,d\theta.$ That is analogous to measuring an observable $\hat{A}$ in quantum mechanics and reading out $\langle \hat{A}\rangle_\psi$.

To capture kime-phase information, we need multiple families of test functions that do not commute in some sense, i.e. cannot be simultaneously diagonalized or that “probe” $\Phi$ in incompatible ways. For instance, we can define two bases:

Basis 1: A set of wavelet-like test functions $\{f_\alpha(\theta)\}$.
Basis 2: A set of harmonic or Fourier-like test functions $\{g_\beta(\theta)\}$.

The notion of “non-commutation” can be mirrored by the fact that the expansions in $f_\alpha$ vs. $g_\beta$ do not trivially coincide or diagonalize $\Phi$. In practice, we can impose a cross-condition such that

\[\int f_\alpha(\theta)\,g_\beta(\theta)\,d\theta \;\neq\; 0 \quad\text{(overlaps in expansions)}.\] Then measuring the “action” of $\Phi$ on $\{f_\alpha\}$ or on $\{g_\beta\}$ yields complementary (but not redundant) constraints on $\Phi$.

To mimic quantum tomography, assume we have many repeated data sets (or repeated time-series) $\{f_i(t)\}$. In each data set, we effectively “test” $\Phi$ with one set of functions $\{f_\alpha\}$. In another set of repeated measurements, we test $\Phi$ with $\{g_\beta\}$. Those different test families might be incompatible in the sense that measuring one precludes measuring the other on the same sample - like a quantum system being collapsed by a certain measurement. But with multiple independent samples (fresh draws from $\theta$), we can systematically measure both families across runs.

Pragmatic implementations of an operational kime-phase “measurement” scheme for real experiments requires further considerations. With actual data, the “kime phase” $\theta$ is not literally an angle that can be dialed up on an apparatus. Rather, each repeated measurement or repeated trial corresponds to a random draw from $\theta\sim\Phi(\theta;t)$. To “test” $\Phi(\theta)$ with the function $f_\alpha$, we need to design an analysis procedure that maps each trial’s observed data into an aggregate “score,” effectively $\langle \Phi, f_\alpha\rangle$.

One scheme relies on defining $\widehat{A}_\alpha \;=\;\frac{1}{N}\,\sum_{i=1}^N f_\alpha\bigl(\widehat{\theta}_i\bigr),$ where $\widehat{\theta}_i$ is an inferred or proxy estimate of the phase from trial $i$. Or more simply, perform an integral transform on the repeated time-series so that the final numeric result is “the distribution’s action on $f_\alpha$.” To capitalize on the QM non-commutative operators insights, we can define operators $\widehat{F}_\alpha$ and $\widehat{G}_\beta$ whose matrix elements in a suitable “kime Hilbert space” do not commute. Then, $\widehat{F}_\alpha$ and $\widehat{G}_\beta$ represent two measurement families of $\theta$.
In practice, these are realized by distinct data analyses or distinct experimental set-ups that yield functionals of $\Phi$. The specific details are more subtle, because standard quantum commutation $[\hat{X},\hat{P}]\neq 0$ is a strict operator statement in a Hilbert space, whereas here we have distribution-function “commutation.” But the spirit is that we define distinct expansions or test function families that cannot be simultaneously diagonal in the “kime phase.”

Let’s explore some parallels between the quantum tomography and the kime-phase tomography . In quantum tomography, we measure the state $\lvert\psi\rangle$ in many bases to reconstruct the Wigner function or the density matrix. Whereas, in kime tomography, we measure $\Phi(\theta;t)$ in many “test function expansions” or “operators” to reconstruct the phase distribution $\Phi$.
Examples of kime-tomography bases include Family A (“Wavelet Test Functions) $\{f_\alpha(\theta)\}$ and Family B (“Fourier / Harmonic Functions) $\{g_\beta(\theta)\}$. In repeated sets of trials (each trial = one random $\theta_i$), we evaluate partial integrals (like sample means) that approximate $\int f_\alpha(\theta)\,\Phi(\theta)\,d\theta, \quad \int g_\beta(\theta)\,\Phi(\theta)\,d\theta.$ By combining these measurement outcomes across multiple $\alpha,\beta$ (assuming having enough repeated runs), we invert or fit $\Phi$ subject to consistency with all the observed integrals.

If the sets $\{f_\alpha\}$ and $\{g_\beta\}$ have sufficient “resolution” (like a complete basis in $\theta$ space), we may recover $\Phi$. The “non-commuting” aspect reflects the need for separate runs to measure $\{f_\alpha\}$ vs. $\{g_\beta\}$, just as QM requires separate runs to measure position vs. momentum.

In spacekime representaiton, each measurement is the distribution’s action on one family of test functions. Since each trial (or repeated measurement) gives one “realization” of $\theta$, we gather a large data set from many trials to estimate the integral $\int f(\theta)\,\Phi(\theta)\,d\theta$. Non-commutation arises if these families of test functions are not simultaneously diagonalizable or do not form a single “common basis.” In practice, that means we cannot glean the integrals for both sets from a single run. Instead, we record separate sets of repeated experiments, just as in QM we can’t measure $\hat{X}$ and $\hat{P}$ simultaneously on the same wavefunction copy. Kime-phase tomography combines the results from multiple “incompatible” families to gain partial (or complete) information about the distribution $\Phi(\theta)$. This is analogous to how measuring a quantum state in multiple bases yields full wavefunction tomography, including phase information.

This Approach 1 defines a kime-measurement protocol analogous to quantum mechanical phase retrieval by interpreting $\Phi(\theta)$ as a measure to be tested by distinct families of test functions (like measuring different observables), gather repeated data sets for each family separately, and use the results to reconstruct or constrain $\Phi(\theta)$ more fully than any single “basis” alone would allow.

4.1.1 Strategy 1 Example

This example demonstrates the concept of kime-phase tomography using two families of test functions (wavelet-like and Fourier-like) to probe a phase distribution $\Phi(\theta)$. The simulation involves:

Defining a “kime-phase distribution” $\Phi(\theta)$ supported on $\theta \in [-\pi,\pi]$; in this case, a simple mixture of two Normal (or von Mises) distributions.
Simulating repeated measurements, where each measurement corresponds to drawing a random phase $\theta_i \sim \Phi,\ 1\leq i\leq N=200$ and generating a synthetic time-series.
Adopting two measurement settings - the “Wavelet test basis” and the “Fourier test basis.”. Half the measurements use the “Wavelet” family, and the other half use the “Fourier” family, mimicking non-commuting bases. For simplicity, the wavelet family uses $f_\alpha(\theta)=e^{-(\alpha\theta)^2} \times \cos(\alpha\theta)$; this is not a real wavelet, just a “toy wavelet-like function”. Similarly, the Fourier family basis uses $g_\beta(\theta) = \cos(\beta \theta)$ and $\alpha,\beta \in \{1,2,3\}$.
Within each basis and for each measurement, we estimate an integral $\int f_\alpha(\theta)\,\Phi(\theta)\,d\theta$ or $\int g_\beta(\theta)\,\Phi(\theta)\,d\theta$ by collecting a “score” from the data, but from discrete random draws of $\theta$. This involves quick numerical approximations to $\mathbb{E}[f_\alpha(\theta)] = \int f_\alpha(\theta) \Phi(\theta) d\theta$ and $\mathbb{E}[g_\beta(\theta)] = \int g_\beta(\theta) \Phi(\theta) d\theta.$
By combining or ensembling all the measured integrals across these two “non-commuting” families, we can solve for, fit, or approximate the kime-phase distribution $\Phi(\theta)$. For instance, one estimate of the kime-phase distribution can be obtained by

\[\Phi_{est}(\theta) = \sum_{\alpha \in A} c_\alpha \times f_\alpha(\theta) + \sum_{\beta \in B} d_\beta \times g_\beta(\theta).\]

Note: This example is proof-of-concept. In a real fMRI or time-series context, we would need to design more sophisticated measurement operators (test functions) that link the phase $\theta$ to the measured signals. However, this simulation shows in principle the essential logic of using multiple incompatible measurement families to pin down (estimate) the phase distribution.

library(plotly)

# -------------------------------------------------------
# 1.  Define a hidden "kime-phase distribution" Phi(theta)
#     We'll do a simple mixture of two von Mises as a stand-in.
#     Range of theta: [-pi, pi].
# -------------------------------------------------------

dphi <- function(theta) {
  # mixture of two peaks for demonstration
  w <- 0.6
  # we'll use circular normal approximation via dnorm with wrap-around
  # for simplicity, ignoring normalizing constants
  p1 <- dnorm(theta, mean=-1.0, sd=0.7)
  p2 <- dnorm(theta, mean=+1.5, sd=0.4)
  val <- w*p1 + (1-w)*p2
  # we do a naive re-normalization across [-pi, pi]
  # in real code, better to do a proper normalization or use dvonmises
  return(val)
}

# Create a function to sample from this distribution by rejection or simple discretization
samplePhi <- function(n) {
  # discrete approach: make a grid, accumulate, sample
  ngrid <- 2000
  th_grid <- seq(-pi, pi, length.out=ngrid)
  pdf_vals <- dphi(th_grid)
  # normalize
  pdf_vals <- pdf_vals / sum(pdf_vals)
  # cumulative
  cdf_vals <- cumsum(pdf_vals)
  # random draws
  rU <- runif(n)
  # invert
  idx <- findInterval(rU, cdf_vals)
  return(th_grid[pmax(1, pmin(idx, ngrid))])
}


# -------------------------------------------------------
# 2.  Simulate repeated measurements:
#     In reality, each measurement i yields one random draw theta_i.
#     Then we get some time-series f_i(t).  But for demonstration:
#     We'll just store the phase. We'll "measure" integrals in different
#     bases as if we had operators f_alpha or g_beta.
# -------------------------------------------------------

N <- 200      # total repeated measurements
theta_samples <- samplePhi(N)

# We'll say half the measurements use the "Wavelet" family,
# the other half use the "Fourier" family, mimicking non-commuting bases
set_seed <- 123
idx_wav <- sample.int(N, size = N/2)
idx_four <- setdiff(seq_len(N), idx_wav)

# -------------------------------------------------------
# 3.  Define test function families:
#     Family A: "Wavelet-like" => f_alpha(theta)
#     Family B: "Fourier-like" => g_beta(theta)
#
#   We'll keep it small: alpha, beta in {1,2,3} as a toy.
# -------------------------------------------------------

f_wavelet <- function(theta, alpha) {
  # Simple "Mexican-hat"-like or Morlet-like in theta-space
  # We'll do a naive shape, e.g. e^(-(alpha*theta)^2) * cos(alpha*theta)
  # Not a real wavelet, just a "toy wavelet-like function"
  return(exp(-0.5*(alpha*theta)^2)*cos(alpha*theta))
}

g_fourier <- function(theta, beta) {
  # Standard Fourier basis = sin / cos. Let's do cos for simplicity:
  return(cos(beta*theta))
}

alphas <- c(1,2,3)
betas  <- c(1,2,3)

#  We'll measure integrals for alpha in alphas or beta in betas.

# -------------------------------------------------------
# 4.  "Measure" partial integrals:
#     Each measurement i in wavelet basis => pick random alpha from {1,2,3}?
#     Or measure them all? 
#     For simplicity, we assume each measurement i yields f_alpha(theta_i)
#     for alpha in a random subset or one alpha per measurement. 
#
#     Similarly for the Fourier basis g_beta.
#
#     We'll store the resulting "observed integrals" in arrays.
# -------------------------------------------------------

set.seed(999)
obs_wavelet <- data.frame(alpha = integer(), val = numeric())
obs_fourier <- data.frame(beta  = integer(), val = numeric())

for(i in idx_wav) {
  # pick alpha randomly from {1,2,3} to measure
  alpha_i <- sample(alphas, size=1)
  val_i <- f_wavelet(theta_samples[i], alpha=alpha_i)
  obs_wavelet <- rbind(obs_wavelet, data.frame(alpha=alpha_i, val=val_i))
}

for(i in idx_four) {
  # pick beta randomly from {1,2,3} to measure
  beta_i <- sample(betas, size=1)
  val_i <- g_fourier(theta_samples[i], beta=beta_i)
  obs_fourier <- rbind(obs_fourier, data.frame(beta=beta_i, val=val_i))
}

# We now have naive approximations to
#   E[f_alpha(\theta)] = \int f_alpha(\theta) Phi(\theta) d\theta
# but from discrete random draws of theta.


# -------------------------------------------------------
# 5.  Estimate these integrals:
#     We'll do a simple average of obs vals for each alpha or beta
#     => This approximates \int f_alpha(\theta)\Phi(\theta)d\theta
# -------------------------------------------------------

wavelet_est <- aggregate(val ~ alpha, data=obs_wavelet, FUN=mean)
fourier_est <- aggregate(val ~ beta,  data=obs_fourier, FUN=mean)

wavelet_est

##   alpha        val
## 1     1 0.22537456
## 2     2 0.10556863
## 3     3 0.06776522

fourier_est

##   beta         val
## 1    1  0.38056349
## 2    2 -0.37538675
## 3    3 -0.06252202

# wavelet_est$val[wavelet_est$alpha==alpha] is the numerical estimate
# of int f_alpha(\theta) Phi(\theta) dtheta


# -------------------------------------------------------
# 6.  Representing Phi in a small parametric basis and solve:
#     We'll do a linear combination of the same wavelet & Fourier basis:
#       Phi_est(\theta) = sum_{alpha in A} c_alpha * f_alpha(theta)
#                       + sum_{beta in B}  d_beta  * g_beta(theta).
#
#     We'll choose alpha,beta in {1,2,3} => total of 6 unknown coefficients.
#     Then we match the integrals we measure with the predicted integrals
#     from the param. 
# -------------------------------------------------------

# Let alphaSet = {1,2,3}, betaSet={1,2,3}
# We define:  phi_est(\theta) = sum_{a} c_a f_wavelet(...) + sum_{b} d_b g_fourier(...)

# The integral of f_wavelet wrt phi_est is:
#   \int f_wavelet_a(\theta) [ sum_{a'} c_{a'} f_wavelet_{a'}(\theta)
#                              + sum_{b'} d_{b'} g_fourier_{b'}(\theta) ] dtheta

# We'll discretize the integral on a fine grid in theta. Let's define a function that,
# given (c_a, d_b), returns predicted integrals for each alpha or beta.

theta_grid <- seq(-pi, pi, length.out=600)
dtheta <- theta_grid[2]-theta_grid[1]

# Precompute a large matrix of [f_wavelet_a(theta_grid), g_fourier_b(theta_grid)] for each alpha,beta
fw_mat <- sapply(alphas, function(a) f_wavelet(theta_grid, a))
colnames(fw_mat) <- paste0("fw_a", alphas)

gf_mat <- sapply(betas,  function(b) g_fourier(theta_grid, b))
colnames(gf_mat) <- paste0("gf_b", betas)


# We'll define a function to produce integrals int f_wavelet(alpha)*phi_est dtheta
# and int g_fourier(beta)*phi_est dtheta, for a proposed vector of coefficients c & d:

predictIntegrals <- function(coeffs_cd) {
  # Suppose length(coeffs_cd) = 6 => c_1..c_3, d_1..d_3
  c_vec <- coeffs_cd[1:3]
  d_vec <- coeffs_cd[4:6]
  
  # Reconstruct phi_est on the grid:
  phi_est_grid <- fw_mat %*% c_vec + gf_mat %*% d_vec
  
  # Now compute the integral of f_wavelet_a * phi_est
  # That is (on the grid):
  #  int( f_wavelet_a(theta_grid) * phi_est_grid ) dtheta
  # We'll produce a vector of length=3 for alpha=1..3:
  int_fw <- numeric(length(alphas))
  for(i in seq_along(alphas)) {
    int_fw[i] <- sum( fw_mat[,i] * phi_est_grid ) * dtheta
  }
  
  # Similarly for the g_fourier(b):
  int_gf <- numeric(length(betas))
  for(j in seq_along(betas)) {
    int_gf[j] <- sum( gf_mat[,j] * phi_est_grid ) * dtheta
  }
  
  return(list(wave=int_fw, four=int_gf))
}

# We'll define a cost function: the squared difference between predicted integrals
# and the measured integrals from wavelet_est, fourier_est

wave_meas <- wavelet_est$val
names(wave_meas) <- as.character(wavelet_est$alpha)
four_meas <- fourier_est$val
names(four_meas) <- as.character(fourier_est$beta)

costFun <- function(par_cd) {
  pred <- predictIntegrals(par_cd)
  # match alpha=1..3 in order
  res_w <- pred$wave - wave_meas
  res_f <- pred$four - four_meas
  sum(res_w^2 + res_f^2)
}


# -------------------------------------------------------
# 7.  Solve or minimize costFun:
# -------------------------------------------------------
init_guess <- rep(0,6)
fit <- optim(init_guess, costFun, method="BFGS")

fit$par

## [1]  0.221174808  0.373856688  0.006148389 -0.070048769 -0.259370820
## [6] -0.101824115

cat("Optimized cost:", fit$value, "\n")

## Optimized cost: 0.0001640957

# fit$par => c_1..c_3, d_1..d_3
final_pred <- predictIntegrals(fit$par)

# Compare final_pred vs wave_meas, four_meas
data.frame(
  alpha=alphas,
  pred=round(final_pred$wave,3),
  obs=round(wave_meas,3)
)

##   alpha  pred   obs
## 1     1 0.228 0.225
## 2     2 0.095 0.106
## 3     3 0.075 0.068

data.frame(
  beta=betas,
  pred=round(final_pred$four,3),
  obs=round(four_meas,3)
)

##   beta   pred    obs
## 1    1  0.381  0.381
## 2    2 -0.375 -0.375
## 3    3 -0.062 -0.063

# -------------------------------------------------------
# 8.  Plot the reconstructed Phi vs. the true distribution
# -------------------------------------------------------

# Reconstruct Phi_est on a grid
coeffs_cd <- fit$par
c_vec <- coeffs_cd[1:3]
d_vec <- coeffs_cd[4:6]
phi_est_grid <- fw_mat %*% c_vec + gf_mat %*% d_vec

# True distribution on the same grid
phi_true_grid <- sapply(theta_grid, dphi)
# normalize each for plotting
phi_true_grid <- phi_true_grid / (sum(phi_true_grid)*dtheta)
phi_est_grid  <- phi_est_grid / (sum(phi_est_grid)*dtheta) # might be negative parts, but let's see

# par(mfrow=c(1,1))
# plot(theta_grid, phi_true_grid, type="l", col="blue", lwd=2,
#      ylim=range(c(phi_true_grid, phi_est_grid)),
#      xlab=expression(theta), ylab="density", main="Kime-phase tomography")
# lines(theta_grid, phi_est_grid, col="red", lwd=2)
# legend("topright", legend=c("True Phi","Estimated Phi"), col=c("blue","red"), lty=1, lwd=2)

p <- plot_ly() %>%
  add_trace(x = theta_grid, y = phi_true_grid, type = 'scatter', ### True Phi
    mode = 'lines', line = list(color = 'blue', width = 2), name = 'True Phi') %>%
  add_trace(x = theta_grid, y = phi_est_grid,  #### Estimated Phi
    type = 'scatter', mode = 'lines', line = list(color = 'red', width = 2),
    name = 'Estimated Phi') %>%
  layout(title = "Kime-phase tomography", xaxis = list(title = expression(theta)),
    yaxis = list(title = "Density"), legend = list(x = 0.75, y = 0.9))
p

In this simulation, the hidden distribution $\Phi(\theta)$ is a mixture of “circular Gaussians” (or an approximate approach with normal distributions truncated to $[- \pi,\pi]$). Simulating repeated measurements reflects sampling $\theta_i \sim \Phi$. In a real scenario, each $\theta_i$ would come from an observable time series, but for demonstration we directly sample $\theta_i$. We used two measurement families, a wavelet-like test functions $f_\alpha(\theta)$ and a Fourier-like test functions $g_\beta(\theta)$, which “non-commuting” in the sense that measuring $\theta_i$ with wavelet functions is separate from measuring with Fourier functions. For the wavelet or Fourier basis, we get $\{f_\alpha(\theta_i)\}$ or $\{g_\beta(\theta_j)\}$ by averaging over many $\theta_i$ to approximate $\int f_\alpha(\theta)\,\Phi(\theta)\,d\theta$. We define a parametric form $\Phi_{\text{est}}(\theta) = \sum c_\alpha\,f_\alpha(\theta) + \sum d_\beta\,g_\beta(\theta)$ and fit the coefficients by matching the measured integrals to the predicted integrals from $\Phi_{\text{est}}$.
When the the underying phase distribution is complicated, or if we only have a small set of test functions, the reconstruction may be rough. Increasing the number of test functions (i.e., bigger sets $\alpha,\beta$) and the number of repeated measurements $N$ yields a better approximation, akin to how quantum state tomography improves with more measurement bases and more samples.

In practice, to extend this approach to actual fMRI, or other longitudinal time-series data, requires defining how each measurement setting (wavelet or Fourier basis) is implemented as an operation on the actual time series. For example, wavelet basis means convolving the measured fMRI signal (in time) with a certain wavelet, then extracting a phase-dependent amplitude. For the Fourier basis, we can use FFT over a certain window that yields the coefficient at frequency $\omega$.
Then, we map each measurement outcome to a “test function value” that depends on the hidden $\theta$. In real data, $\theta$ is not directly known, so we might do a specialized inference step or calibration. Ensembling (or aggregating) these measurement outcomes over many trials or repeated runs estimates the integrals $\int f_\alpha(\theta)\,\Phi(\theta)\,d\theta$.

In the experiment above, the estimated phase distribution $\widehat{\Phi}$ (6-modes) roughly resembles the true distribution (bi-modal), which has two well-localized modes. In our experiment, the estimated phase distribution uses only a small basis of six total functions, $f_{1,2,3}$ wavelet-like and $g_{1,2,3}$ Fourier-like. This can be too rigid or produce “ringing” artifacts, adding more wavelet scales or higher Fourier frequencies can improve the approximation. Also, the balance between wavelet and Fourier terms can be adjusted, so that the distribution can better capture both peaked modes and smooth tails. In principle, using a bigger basis or a more flexible family supports smoother approximations with fewer spurious “wiggles.” Some wavelet or polynomial bases might be more natural for capturing multi-modal phase priors with rapidly decaying tails. For instance, Legendre polynomials or higher B-splines on $[-\pi, \pi]$ might yield fewer spurious oscillations than a small set of cosines.

When the naive least-squares fit yields overfitting (excessive high-frequency structure), a penalized regression approach can help. For instance, Tikhonov or Ridge penalty
$\min_{c,d} \left [\underbrace{\sum(\text{residuals}^2)}_{fidelity} + \underbrace{\lambda\,\bigl(\|c\|^2 + \|d\|^2\bigr)}_{regularizer}\right ],$ for some tuning $\lambda>0$ shrinks large oscillatory coefficients in the wavelet or Fourier expansions. This encourages fewer basis functions with large coefficients, simplifying the distribution’s shape.

Assuming the phase distribution as a function in a reproducing kernel Hilbert space (RKHS), then the solution is found by penalizing large second derivatives or local curvature. Also, in practice we can adopt a parametric mixture family closer to the true phase distribution. For instance, if the true distribution is a two-component mixture of von Mises ($vM$) (or circular Gaussians), it might be more direct to parameterize the estimate with the same family, e.g. $\Phi(\theta) \;=\; w\,vM(\theta;\mu_1,\kappa_1) + (1-w)\,vM(\theta;\mu_2,\kappa_2).$ Then fit the parameters $(w,\mu_1,\kappa_1,\mu_2,\kappa_2)$ by matching the measured integrals or the direct samples. This strategy is analogous to modeling the distribution with a mixture of 2–3 ‘peaks’, then solve for mixture weights and location/scale. It naturally yields a shape that has only two modes - no artificial high-frequency bumps.

When dealing with only a small number of repeated measurements (draws of $\theta$) in each “basis,” then sampling noise can create spurious detail increase $N$ (the number of repeated draws) and/or measure more integrals in each basis or in additional “incompatible” bases. With more data constraints, the solution is less likely to overfit small random fluctuations.

4.1.1.1 Renormalization of the Estimated Kime-phase Distibution

In the Approach 1 simulation, we see that the estimated (recovered) kime-phase distribution $\hat{\Phi}(t)$ may have negative values, which is unphysical/unrealistic. This can happen due to using a simple linear combination of wavelet-like and Fourier-like basis functions. Of course, this is an oversimplified protocol and renormalization of the reconstructed distribution $\hat{\Phi}(t)$ may address the issue by enforcing positivity and unitarity for interpreting $\Phi(\theta)$ as a probability density.

In our simulation, we defined a parametric estimate of the form \[\Phi_{\text{est}}(\theta) = \sum_{\alpha} c_{\alpha} \, f_{\alpha}(\theta) + \sum_{\beta} d_{\beta} \, g_{\beta}(\theta),\] where the basis functions $f_{\alpha}$ and $g_{\beta}$ typically take positive and negative values (e.g., wavelets, cosines). Thus, the linear combination can easily go negative at some $\theta$ if the coefficients $\{c_{\alpha}, d_{\beta}\}$ produce partial cancellations or overshoot.

there are multiple renormalization strategies that can be used to address this issue and enforce kime-phase density properties on the reconstructed $\Phi_{\text{est}}(\theta)$. For instance, using unconstrained least-squares merely minimizes squared errors in matching integrals $\int f_{\alpha}\,\Phi(\theta)\,d\theta$ or $\int g_{\beta}\,\Phi(\theta)\,d\theta$, without imposing any positivity constraint. So, there is no mechanism to prevent negative portions in $\Phi_{\text{est}}$.

A naive renormalization by rescaling the final estimate, \[\Phi_{\text{est}}(\theta) \leftarrow\; \frac{\Phi_{\text{est}}(\theta)} {\int \Phi_{\text{est}}(\theta)\,d\theta}\] ensures unitarity, the integral is $1$, yet, the function can still have negative regions.

Exponential parametrization provides a straightforward fix to represent $\Phi_{\text{est}}$ in an exponential family form, e.g., $\Phi_{\text{est}}(\theta) = \exp\Bigl(\,\sum_{\alpha} c_{\alpha}\,f_{\alpha}(\theta)\Bigr),$ or in a typical Fourier or wavelet basis, \[\Phi_{\text{est}}(\theta) = \exp\Bigl(\, c_{0} + \sum_{k=1}^K \bigl[c_k\,\cos(k\,\theta) \;+\; s_k\,\sin(k\,\theta)]\Bigr).\]

Then automatically, $\Phi_{\text{est}}(\theta)$ is positive, but still need to renormalize by dividing by its integral. Of course, this over-complexifies the problem, as the integrals $\int f_{\alpha}(\theta)\,\Phi_{\text{est}}(\theta)\,d\theta$ may no longer be linear in the coefficients $c_{\alpha}$.

Another strategy is to choose basis functions that are themselves nonnegative, e.g. B-splines with compact support, or certain radial basis expansions.
Then a linear combination with nonnegative coefficients ensures $\Phi_{\text{est}}(\theta)\ge 0$. In that case, we need to solve a constrained problem: $c_{\alpha}\ge 0$, which can be done with quadratic programming or more advanced optimization tools.

Post-processing clampping is a simpler (though less principled) fix requiring computing the unconstrained estimate $\Phi_{\text{est}}(\theta)$, setting all negative values to $0$, and renormalizing over $\theta$.
The “clamp-and-normalize” approach might not preserve integral constraints as precisely as a fully constrained method, but it ensures a nonnegative final result.

Alternatively, we can normalize the distribution once we get a function $\Phi_{\text{est}}(\theta) \ge 0$, by \[\Phi_{\text{est}}(\theta) \leftarrow\; \frac{\Phi_{\text{est}}(\theta)} {\int_{-\pi}^{\pi} \Phi_{\text{est}}(\theta)\,d\theta}.\]

In practice, we can normalize over the grid theta_grid the functional values of phi_est_grid, by phi_est_int <- sum(phi_est_grid) * dtheta and phi_est_grid <- phi_est_grid / phi_est_int, assuming phi_est_grid >= 0 so the integral is well-defined and positive.
Then phi_est_grid forms a valid probability density function (pdf) over $[- \pi,\pi]$.

4.1.1.2 Opportunities for Enhancement

Strengthen the Analogy to Quantum Non-Commutativity: In QM, non-commuting observables (e.g., position/momentum) enforce a fundamental limit on simultaneous measurements. In spacekime, “incompatibility” is loosely defined as non-orthogonal test functions (e.g., wavelet vs. Fourier). However, this does not directly replicate the operator-based non-commutativity of QM. The no-overlap condition $\int f_\alpha(\theta)\,g_\beta(\theta)\,d\theta \;\neq\; 0$ is insufficient to guarantee complementary information or a no-go theorem similar to the uncertainty principle. We can consider formalizing incompatibility using operator theory or signal-processing uncertainty principles (e.g., time-frequency trade-offs in wavelets vs. Fourier), and defining a commutator-like metric for test function families to quantify their mutual informativeness.
Lack of Uniqueness and Stability: The linear combination $\Phi_{\text{est}}(\theta) = \sum c_\alpha\,f_\alpha(\theta) + \sum d_\beta\,g_\beta(\theta)$ assumes $\Phi$ lies in the span of the chosen basis. If the test functions do not form a complete basis or are ill-conditioned, the inversion may be non-unique or unstable. We can explore using overcomplete dictionaries (e.g., frames) or adaptive basis selection and regularizing the inversion (e.g., Tikhonov, sparsity penalties) to handle noise and undersampling.
Ambiguity in Phase Interpretation: The kime-phase $\theta$ is treated as a random draw, but its physical meaning and connection to time-series data (e.g., fMRI) needs to be explicated. Unlike QM phases, which arise from wavefunction structure, $\theta$ does not have a direct operational definition. Is it feasible to ground $\theta$ as a measurable quantity (e.g., phase coherence in oscillatory signals) and define test functions as transformations of observable data (e.g., wavelet coefficients)?
Simplistic Data Generation: The simulation directly samples $\theta\sim\Phi_{true}(t)$, bypassing the critical step of inferring $\theta$ from the simulated fMRI time-series data. Perhaps explicate the mapping between signals and $\theta$, introducing noise and bias. Is it feasible to simulate time-series signals (e.g., synthetic fMRI) with known $\theta$ dependence? Can we use signal-processing methods (e.g., Hilbert transform, wavelet ridges) to estimate $\theta$ from data?
Inefficient Data Usage: Splitting trials into wavelet/Fourier groups mimics QM measurement collapse but wastes data. In reality, each $\theta_i$ could be analyzed with multiple test functions. Perhaps allow all test functions to act on each trial’s data to improve the statistical power. How to model the correlations between test function outputs.
Operator-Theoretic Framework: How to represent test functions as operators in a Hilbert space, with commutators defining incompatibility? Perhpas use spectral theory to formalize “measurements.” Can we derive bounds on joint resolution of $\Phi$ using wavelet/Fourier families, similar to time-frequency uncertainty.
Algorithmic Improvements: Shoud we add $L_1/L_2$ penalties to the cost function to suppress spurious oscillations. Alternatively, see if Bayesian inference incorporating priors over $\Phi$ (e.g., smoothness, sparsity) can help quantify uncertainty in estimates.

4.1.2 Analogies between QM Non-Commutativity and SK Representation with Incompatible Functional Bases

In quantum mechanics (QM), we have an algebra of operators on a Hilbert space where two observables $\hat{A}$, $\hat{B}$ do not commute if $[\hat{A}, \hat{B}] \neq 0$. Non-commutation implies fundamental limits on simultaneous measurability (Heisenberg uncertainty). Mathematically, the commutator $[\hat{A}, \hat{B}] = \hat{A}\hat{B} - \hat{B}\hat{A}$ captures the idea that measuring $\hat{A}$ can disturb the outcome distribution of $\hat{B}$, or vice versa.

By contrast, in the “kime-phase distribution” we have a distribution $\Phi(\theta)$ and a set of test functions $\{f_\alpha\}$, each giving a real number $\langle \Phi, f_\alpha\rangle$. “Incompatibility” reflects “families of test functions that cannot be measured on the same sample realization of $\theta$.” But that notion of “cannot measure both simultaneously” is not guaranteed by an operator algebra or a fundamental commutator—rather, it’s due to how we label draws from $\theta \sim \Phi$ and choose to do different integral transforms on separate runs. Hence, bridging from “nonorthogonal test functions” to a rigorous “operator non-commutation” requires new structural definitions.

Turning Test Functions into Operators: One way to introduce an operator-theoretic perspective is to treat each test function $f(\theta)$ as either:
1. A multiplication operator: $\hat{F} : \Psi(\theta) \;\mapsto\; f(\theta) \,\Psi(\theta)$ for $\Psi(\theta)$ in some function space (like $L^2$ over $\theta\in [-\pi,\pi]$), or
2. An integral transform operator: $\hat{F}(\Psi)(\theta) = \int K_f(\theta, \theta')\,\Psi(\theta')\,d\theta'.$

In both cases, each “test function” becomes an operator $\hat{F}$ and we can attempt to compute commutators $[\hat{F}, \hat{G}]$ for distinct test functions $f$ and $g$. If $\hat{F}$ is multiplication by $f(\theta)$ and $\hat{G}$ is multiplication by $g(\theta)$, then $[\hat{F}, \hat{G}] = 0$ trivially, because multiplication by $fg$ is commutative. So that alone does not replicate quantum non-commutation. When $\hat{F}$ or $\hat{G}$ includes derivatives, convolution kernels, or partial Fourier transforms, one can get non-zero commutators.

Reframe an “Uncertainty Relation” in $(\theta)$-Space: Even if we define a nontrivial operator algebra, we want an operational meaning, e.g., “it’s impossible to measure both $\hat{F}$ and $\hat{G}$ simultaneously to arbitrary precision.” In QM, that arises from the Hilbert-space structure and the Born rule. In the kime-phase approach, we can enforce a “Hilbert norm” $\|\Psi\|$ on distributions or wavefunctions in $\theta$ and let “measurement” correspond to computing $\langle \Psi, \hat{F}\Psi\rangle$. When$[\hat{F}, \hat{G}] \neq 0$, we can explore a Cauchy–Schwarz–like inequality that implies $\Delta F\,\Delta G \ge \text{constant}.$
Using Information-Theoretic Measures of Complementarity: Another route to formalizing “incompatibility” is to define how informative each measurement family is about $\theta$. Then one might show that if two families of test functions are “maximally” complementary, measuring one family leaves little or no information about the other. This can look like an uncertainty principle in the sense $H(\theta \mid \text{Family A data}) + H(\theta \mid \text{Family B data}) \;\ge\; \text{some bound,}$ where $H$ is an entropy measure, and “Family A data” is the set of integrals with the wavelet basis. If the two families produce highly overlapping expansions, we can glean both from the same data. But if the expansions are “complementary” in a strong sense, it might be impossible to gain both sets of integrals from a single sample. That suggests a trade-off reminiscent of quantum complementarity.
Define a Kime Hilbert Space: Let the “states” be (equivalence classes of) wavefunctions $\Psi(\theta)$ or distributions $\Phi(\theta)$. Impose an inner product $\langle \Psi_1, \Psi_2\rangle$. Map Each “Test Function Family” to Self-Adjoint Operators and instead of just computing $\int f(\theta)\,\Phi(\theta)\,d\theta$, define an operator $\hat{F}$ on the Hilbert space. Possibly $\hat{F}$ includes differentiation or convolution so that $\hat{F}\hat{G} \neq \hat{G}\hat{F}$. Then, evaluate $[\hat{F}, \hat{G}]$ for two such operators. If it is nonzero, investigate the consequences for “observables.” Specify how “observing $\hat{F}$” changes (or not) the state $\Psi$. It may not be nontrivial to get a truly quantum-like “collapse.” Skipping the collapse or disturbance postulate, we might only get partial analogies to quantum complementarity, not a full “non-commuting measurement” principle. Given that $[\hat{F},\hat{G}]\neq 0$, check if there is a limit or bound on the simultaneous determination of the integral values of $f(\theta)$ and $g(\theta)$. Possibly define an “uncertainty relation” in terms of standard deviations or entropies of these integral measurements.

4.1.3 Refined Simulation Experiment (Approach 1)

In this revised simulation, we use a Bayesian framework starting with some prior phase model, e.g., Laplace phase distribution, and using evidence-based iterative refinement to estimate the Bayesian posterior phase distribution, still using a “forward model”

\[x(t) = \mathcal{M}\bigl(t,\theta; \,\boldsymbol{\phi}\bigr) +\epsilon(t),\] where $\theta$ is the randomly drawn “kime-phase” from the currently estimated Bayesian posterior distribution, still $\theta(t)$ if time-varying, $\mathcal{M}$ is a known or hypothesized function that generates the fMRI time-series from $\theta$, $\boldsymbol{\phi}$ stands for additional model parameters (e.g., amplitude, baseline, shape, HRF in fMRI, etc.), and $\epsilon(t)$ is noise, e.g., Gaussian or realistic Rician fMRI noise with correlation in time. We can simulate many repeated fMRI runs or “trials,” each with a newly sampled $\theta_i$. For each run $i$, we produce $x_i(t) = \mathcal{M}\bigl(t,\theta_i; \,\boldsymbol{\phi}\bigr) + \epsilon_i(t).$ We will explore specific functions $\mathcal{M}$ that generate the fMRI time-series from the randomly drawn $\theta$, and update the entire simulation experiment.

The revised simulation protocol involves the following steps, which are repeated until convergence to a stable estimate for the distribution $\Phi(\theta)$.

Prior: Start with a prior distribution over $\theta$, for instance $\Phi_0(\theta)$.
Forward Simulation: For each trial $i$, sample $\theta_i\sim \Phi_{n}(\theta)$, the current posterior or prior, depending on the iteration strategy, generate a noisy signal $x_i(t)$ via $\mathcal{M}(t,\theta_i;\boldsymbol{\phi}) + \epsilon_i(t)$.
Inference: Given $x_i(t)$, update the belief about $\theta_i$ and possibly about $\boldsymbol{\phi}$, producing a posterior $\Phi_{n+1}(\theta)$.

Let’s start with an initial prior, e.g. a Laplace or Gaussian distribution over $\theta$, $\Phi_0(\theta) \;\propto\; \exp\bigl(-|\theta|/b\bigr)\quad\text{(Laplace)},$ or $\Phi_0(\theta) \;\propto\; \exp\bigl(-\tfrac{\theta^2}{2\sigma^2}\bigr),$ restricted to $[- \pi,\pi]$. For time-varying $\theta(t)$, we can specify a small random walk prior or a correlated prior in time.

To explicate the forward model, in each “trial” $i$, we draw $\theta_i \sim \Phi_n(\theta)$, generate the synthetic fMRI time series $x_i(t) = \mathcal{M}\bigl(t,\theta_i;\,\boldsymbol{\phi}\bigr) + \epsilon_i(t)$, and assume the noise $\epsilon_i(t)$ is Gaussian or Rician with temporal correlation. Again, $\boldsymbol{\phi}$ represents the hyerparameter vector containing amplitude, baseline, HRF shape, etc.

Given the observed $x_i(t)$, the Bayesian posterior distribution, $\Phi_{n+1}(\theta)$, is updated from the prior $\Phi_n(\theta)$ by \[p(\theta \mid x_i) \propto \bigl[\,p(x_i\mid\theta)\bigr] \Phi_n(\theta).\] We can combine data from multiple independent trials $\{x_i(t)\}_{i=1}^N$, \[p(\theta_1,\ldots,\theta_N \mid \{x_i\}) \propto\; \prod_{i=1}^N p(x_i \mid \theta_i)\,\Phi_n(\theta_i).\] In the special case when all trials share a single $\theta$, which is less likely in typical repeated-measure scenarios, there would be a single posterior. We can use MCMC or a variational method to approximate the posterior distribution.
Alternatively, a particle filter approach may keep a sample of “particles” for $\theta$, propagate them forward, weigh them by the likelihood of $x_i$, and resample. Yet, another option is to use EM-like iterative scheme when $\theta$ is high-dimensional or time-varying to perform partial expectation (E-step) updates. At the end, we get the posterior $\Phi_{n+1}(\theta)$. In the next iteration, we sample $\theta_i$ from that new distribution, generate new data, etc. We can consider the final $\Phi_{\mathrm{post}}(\theta)$ as the best estimate of the underlying “phase distribution.”

Let’s explore two alternative “forward model” functions $\mathcal{M}$ for simulating fMRI time-series from a random phase $\theta$.

Model A: Sinusoidal + HRF Convolution: $x(t) = \Bigl(A\,\sin\!\bigl(\omega \, t + \theta\bigr)\Bigr) \ast\; \mathrm{HRF}(t) + \text{drift}(t) + \epsilon(t),$ where the sinusoidal $A\,\sin(\omega t + \theta)$ is a canonical oscillation with unknown phase $\theta$, the convolution $(\cdot)\ast\mathrm{HRF}$ is a typical fMRI hemodynamic response function (e.g. a gamma function or canonical double-gamma), the drift(t) is a low-frequency polynomial or spline to mimic slow drift in real BOLD signals, $\epsilon(t)$ is noise, e.g., Gaussian $\epsilon\sim N(0,\sigma^2)$, Rician, or AR(1) correlated noise, and the parameter vector $\boldsymbol{\phi} = (A,\omega,\mathrm{HRF\_params}, \dots)$. Because $\theta$ modulates the phase of the sinusoid, each trial can shift the timing of the BOLD response in a consistent manner, where we can interpret $\theta$ as a “neuronal phase offset”.
Model B: Event-Related or Block-Design Onset Times: $x(t) = \Bigl(\sum_{k=1}^K \mathbf{1}\bigl[t\in (t_k+\theta,\,t_k+\theta+\Delta)\bigr]\Bigr) \ast\;\mathrm{HRF}(t) + \text{drift}(t) + \epsilon(t),$ where we assume an fMRI/BOLD signal with block design or event design with onsets $\{t_k\}$, the unknown phase $\theta$ shifts all onsets by $\theta$ units in time, so that the entire block or event structure is advanced or delayed, convolution with the HRF produce the BOLD-like signal, and the additional amplitude or baseline parameters and noise are similar to Model A above.

Assuming that the “phase” is an offset in event timing across repeated runs, $\theta$ shifting the entire design is realistic. Each trial might place the block/event boundary earlier or later in time; effectively we measure how well the data fits that shift. the next experiment demonstrates the Bayesian approach in R and Stan. Specifically, we show an end-to-end simulation in a Bayesian framework for unknown kime-phases $\{\theta_i\}$. In this experiment, we define a forward model, a sinusoidal input at unknown phase $\theta$ convolved with a simple $HRF + noise$, simulate repeated runs, each with a fresh $\theta_i\sim \text{Laplace}(0,b)$, and infer those phases in Stan via MCMC.

Running this simulation in a fresh R session requires the package rstan to be installed and a C++ toolchain configured, see the rstan docs). The entire protocol involves Stan model compilation and running MCMC, and produces a data frame comparing the true vs. posterior mean kime-phases. the simulation can be enhanced by changing the shape of the HRF, or by letting the HRF parameters be unknown and included in the Stan model, by modifying the noise distribution (e.g. Rician or correlated), and by updating the number of runs, sampling intervals, amplitude priors, etc. In a real fMRI context, for dealing with multi-voxel data, multi-parameter block designs, or a richer prior on $\theta$, this end-to-end protocol may need to be refined.

############################################################
# 1. ENV SETUP
############################################################
# Make sure rstan and plot packages arer installed:
# install.packages(c("rstan", "ggplot2"))
library(rstan)      # for Stan interface
library(ggplot2)    # for basic plotting

# rstan config for quicker examples
rstan_options(auto_write = TRUE)
options(mc.cores = parallel::detectCores())

############################################################
# 2. DEFINE A SIMPLE HRF AND HELPER FUNCTIONS
############################################################

# A tiny "canonical HRF": single gamma-like shape
# for demonstration. Typically using a more realistic double-gamma, etc.
make_hrf <- function(length_out=32, peak=6, scale=1) {
  # We'll define a gamma PDF shape ~ dgamma(t, shape=?, rate=?)
  tseq <- seq(0, length_out-1, by=1)
  # shape=peak, rate=peak? => quick guess
  # this can be refined
  hrf_values <- dgamma(tseq, shape=peak, rate=peak/scale)
  hrf_values / max(hrf_values)  # normalize peak to 1
}

#  Laplace sampler for phases
rLaplace <- function(n, mu=0, b=1) {
  # For each uniform draw u in (-1/2,1/2), transform
  u <- runif(n, min=-0.5, max=0.5)
  sapply(u, function(ui) mu - b*sign(ui)*log1p(-2*abs(ui)))
}


############################################################
# 3. SIMULATE DATA (FORWARD MODEL)
############################################################
simulate_data <- function(R, N, A=1, freq=0.33, noise_sd=0.2,
                          b=1.0, t_max=30) {
  # R = # of runs (repeated measurements)
  # N = # of time points per run
  # freq => frequency in cycles/sec (just for demonstration)
  # b => Laplace scale for phase draws
  # t_max => total length in time
  # Return a list with:
  #   t_vals: the time vector
  #   x_mat:  a matrix (R x N) of noisy signals
  #   theta_true: the actual phases used

  # time axis
  t_vals <- seq(0, t_max, length.out=N)

  # define HRF
  hrf_vec <- make_hrf(length_out=32, peak=6, scale=1)

  # sample phases from Laplace
  theta_true <- rLaplace(R, 0, b)
  
  x_mat <- matrix(NA, nrow=R, ncol=N)

  # convolve each run's sinusoid with HRF
  for(r in 1:R) {
    # create raw sinusoid with phase shift
    raw_signal <- A * sin(2*pi*freq * t_vals + theta_true[r])
    # do discrete convolve
    conv_full <- convolve(raw_signal, rev(hrf_vec), type="open")
    # match length N
    conv_full <- conv_full[1:N]
    # add noise
    noisy <- conv_full + rnorm(N, 0, noise_sd)
    x_mat[r, ] <- noisy
  }
  
  list(t_vals=t_vals, x_mat=x_mat, theta_true=theta_true)
}


############################################################
# 4. STAN MODEL CODE
############################################################
# We'll assume each run has an unknown phase theta[r].
# We'll do a single amplitude A shared across runs, or let each run have its own amplitude.
# We'll keep the HRF fixed (like a known shape).
#
# The Stan model tries to recover theta[r] by matching the data x[r,] with
#   x_hat[r, n] = A*sin(2*pi*freq * t_vals[n] + theta[r]) convolved with known HRF
# Then a normal likelihood with std dev sigma_noise.

stan_model_code <- "
data {
  int<lower=1> R;          // number of runs
  int<lower=1> N;          // number of time points per run
  real t_vals[N];          // time vector
  matrix[R, N] x_mat;      // observed data
  int<lower=1> len_hrf;
  vector[len_hrf] hrf_vec; // known HRF shape
  real freq;               // known frequency
}
parameters {
  real<lower=0> A;                 // amplitude
  real<lower=0> sigma_noise;       // noise std
  vector[R] theta_raw;             // unconstrained phases
}
transformed parameters {
  // We'll map theta_raw into [-pi, pi] range just for demonstration
  // We can do a tanh approach or we can do mod
  vector[R] theta;
  for(r in 1:R) {
    // let's do a tanh approach:  [-1,1] => [-pi, pi]
    theta[r] = pi() * tanh(theta_raw[r]);
  }
}
model {
  // Priors
  A ~ normal(1, 1);      // guess amplitude near 1
  sigma_noise ~ normal(0.2, 0.1) T[0,];
  theta_raw ~ normal(0, 1);  // broad for phase

  // likelihood
  for(r in 1:R) {
    // Build raw sinusoid
    vector[N] raw_signal_r;
    for(n in 1:N) {
      raw_signal_r[n] = A * sin(2*pi()*freq * t_vals[n] + theta[r]);
    }
    // convolve with hrf => we do a discrete approach
    // need a new vector conv_full, length N
    // We'll do naive loop convolution
    vector[N] conv_full = rep_vector(0, N);
    for(i in 1:N) {
      // i => index in conv result
      // sum over j => raw_signal_r[j]*hrf_vec[i-j+1]
      real tmp_sum = 0;
      for(j in 1:i) {
        int k = i-j+1; // index in hrf
        if(k <= len_hrf) {
          tmp_sum += raw_signal_r[j]*hrf_vec[k];
        }
      }
      conv_full[i] = tmp_sum;
    }
    // now conv_full is the convolved signal
    // likelihood
    x_mat[r] ~ normal(conv_full, sigma_noise);
  }
}
"


############################################################
# 5.  RUN SIMULATION
############################################################
set.seed(1234)
R <- 8   # number of runs
N <- 60  # number of timepoints per run
freq_used <- 0.33
sim_out <- simulate_data(R=R, N=N, A=1.0, freq=freq_used,
                         noise_sd=0.15, b=1.0, t_max=20)
# We store t_vals, x_mat, theta_true
t_vals    <- sim_out$t_vals
x_mat     <- sim_out$x_mat
theta_true <- sim_out$theta_true

hrf_vec <- make_hrf(length_out=32, peak=6, scale=1)

############################################################
# 6.  PREPARE DATA FOR STAN + COMPILE MODEL
############################################################
stan_data <- list(
  R = R,
  N = N,
  t_vals = t_vals,
  x_mat  = x_mat,
  len_hrf = length(hrf_vec),
  hrf_vec = hrf_vec,
  freq    = freq_used
)

# compile
stan_model <- stan_model(model_code=stan_model_code)

############################################################
# 7.  SAMPLE / FIT MCMC
############################################################
fit <- sampling(stan_model, data=stan_data,
                iter=2000, chains=2, seed=999,
                control=list(adapt_delta=0.9))

# print(fit, pars=c("A","sigma_noise"))
fit

## Inference for Stan model: anon_model.
## 2 chains, each with iter=2000; warmup=1000; thin=1; 
## post-warmup draws per chain=1000, total post-warmup draws=2000.
## 
##                mean se_mean    sd   2.5%    25%    50%    75%  97.5% n_eff
## A              0.84    0.02  0.03   0.78   0.82   0.84   0.87   0.91     2
## sigma_noise    0.42    0.02  0.03   0.37   0.39   0.42   0.44   0.46     1
## theta_raw[1]   3.32    0.02  0.38   2.68   3.06   3.28   3.53   4.16   413
## theta_raw[2]   0.10    0.00  0.03   0.05   0.08   0.10   0.11   0.15  3489
## theta_raw[3]   0.08    0.00  0.03   0.02   0.06   0.08   0.09   0.13  2591
## theta_raw[4]   0.10    0.00  0.02   0.05   0.09   0.10   0.12   0.15  3288
## theta_raw[5]   0.44    0.00  0.03   0.37   0.42   0.44   0.46   0.50  3048
## theta_raw[6]   0.10    0.00  0.03   0.05   0.08   0.10   0.11   0.15  3022
## theta_raw[7]  -1.09    2.04  2.05  -3.75  -3.07  -0.76   0.94   1.03     1
## theta_raw[8]  -0.23    0.00  0.03  -0.28  -0.25  -0.23  -0.21  -0.18  2916
## theta[1]       3.13    0.00  0.01   3.11   3.13   3.13   3.14   3.14   355
## theta[2]       0.30    0.00  0.08   0.14   0.24   0.30   0.35   0.46  3491
## theta[3]       0.24    0.00  0.08   0.08   0.19   0.24   0.30   0.40  2591
## theta[4]       0.33    0.00  0.08   0.17   0.28   0.32   0.38   0.48  3288
## theta[5]       1.29    0.00  0.08   1.12   1.24   1.29   1.34   1.45  3077
## theta[6]       0.30    0.00  0.08   0.15   0.25   0.30   0.36   0.46  3020
## theta[7]      -0.41    2.72  2.72  -3.14  -3.13  -0.51   2.31   2.44     1
## theta[8]      -0.71    0.00  0.08  -0.87  -0.76  -0.71  -0.65  -0.55  2924
## lp__         164.33   28.95 29.00 131.18 135.73 161.51 193.57 196.45     1
##               Rhat
## A             1.33
## sigma_noise   2.18
## theta_raw[1]  1.01
## theta_raw[2]  1.00
## theta_raw[3]  1.00
## theta_raw[4]  1.00
## theta_raw[5]  1.00
## theta_raw[6]  1.00
## theta_raw[7]  8.74
## theta_raw[8]  1.00
## theta[1]      1.01
## theta[2]      1.00
## theta[3]      1.00
## theta[4]      1.00
## theta[5]      1.00
## theta[6]      1.00
## theta[7]     56.32
## theta[8]      1.00
## lp__         14.42
## 
## Samples were drawn using NUTS(diag_e) at Tue Feb 25 17:52:14 2025.
## For each parameter, n_eff is a crude measure of effective sample size,
## and Rhat is the potential scale reduction factor on split chains (at 
## convergence, Rhat=1).

theta_draws <- extract(fit, pars="theta")$theta
dim(theta_draws)  # should be iterations x R

## [1] 2000    8

############################################################
# 8.  CHECK PHASE ESTIMATES vs. TRUE
############################################################
# We'll compute the posterior mean for each run's phase
theta_est_mean <- apply(theta_draws, 2, mean)
theta_est_sd   <- apply(theta_draws, 2, sd)

df_phases <- data.frame(
  run_id      = 1:R,
  theta_true  = theta_true,
  theta_est   = theta_est_mean,
  est_sd      = theta_est_sd
)

cat("\nPosterior mean vs. true phase:\n")

## 
## Posterior mean vs. true phase:

df_phases

##   run_id theta_true  theta_est      est_sd
## 1      1 -1.4810147  3.1309590 0.007587409
## 2      2  0.2805063  0.2984264 0.081931481
## 3      3  0.2466034  0.2401228 0.083018714
## 4      4  0.2833699  0.3254400 0.077139497
## 5      5  1.2795256  1.2893302 0.081399322
## 6      6  0.3293672  0.3048267 0.078649502
## 7      7 -3.9637631 -0.4097458 2.717412130
## 8      8 -0.7655007 -0.7084654 0.080658402

# Quick plot
# ggplot(df_phases, aes(x=theta_true, y=theta_est)) +
#   geom_point(color="blue") +
#   geom_abline(intercept=0, slope=1, linetype="dashed") +
#   labs(title="True vs. estimated phase", x="True θ", y="Estimated θ") +
#   coord_fixed()
# Convert ggplot to plotly
library(plotly)

# Assuming df_phases contains theta_true and theta_est columns
# First create the reference line
# Get the range of data for the reference line
range_min <- min(min(df_phases$theta_true), min(df_phases$theta_est))
range_max <- max(max(df_phases$theta_true), max(df_phases$theta_est))
ref_line <- data.frame(x = c(range_min, range_max), y = c(range_min, range_max))

# Create the plot
fig <- plot_ly() %>%
  # Add scatter points
  add_trace(data = df_phases, x = ~theta_true, y = ~theta_est,
    type = 'scatter', mode = 'markers', marker = list(color = 'blue',size = 6),
    name = 'Phase Values') %>%
  # Add reference line
  add_trace(data = ref_line, x = ~x, y = ~y,
    type = 'scatter', mode = 'lines', line = list(dash = 'dash', color = 'black'),
    name = 'y = x') %>%
  # Layout settings
  layout(title = list(text = "True vs. estimated phase", y = 0.95),
    xaxis = list(title = "True θ", scaleanchor = "y",  # This ensures equal scaling
      scaleratio = 1      # This maintains aspect ratio
    ),
    yaxis = list(title = "Estimated θ"), showlegend = TRUE)
fig

This Bayesian approach ensures each data set informs our knowledge of $\theta$ (and any other parameters). Over repeated runs, we effectively refine $\Phi(\theta)$. It also naturally handles noise, bias, and partial identifiability in $\theta$. This version of the simulation shows incorporating the kime representation in a Bayesian framework starting with a prior phase distribution, a forward model for generating signals from that phase, repeated trials, and an inference step that yields a posterior distribution of phases. This may be a more realistic approach than the simpler simulation shown earlier that “directly samples $\theta\sim\Phi$ and treats it as known.”

4.2 Approach 1A: A Hilbert Space and Operator Reformulation

In the above kime-phase estimation framework, the heuristic notion of “incompatibility” between test function families (e.g., $f_\alpha$ vs. $g_\beta$) based solely on non-orthogonality, $\int f_\alpha(\theta) g_\beta(\theta) d\theta \neq 0$, does not guarantee complementary information. This is unlike quantum mechanics (QM), where non-commutativity arises from operator algebra in a Hilbert space. Hence, this reformulation addresses that downside by defining a formal operator framework for the kime-test functions in $L^2[-\pi, \pi]$, computing their commutators explicitly, and exploring the conditions under which non-commutativity can be achieved. This may provide a more rigorous basis for kime-phase tomography analogous to QM tomography.

Note: In the section below, we reflect on the meaning of $\frac{d}{d\theta}$ as a derivative operator in $L^2[-\pi, \pi]$ over the $\theta$-domain of $\Phi(\theta; t)$, not a stochastic derivative. $\theta$ is a coordinate, not a process, so standard calculus applies. There is no need for Itô calculus, which applies to stochastic processes where a variable (e.g., $\theta(t)$) evolves randomly over time $t$, governed by a stochastic differential equation (SDE). In kime, $\theta$ is sampled independently at each $t$ from $\Phi(\theta; t)$, with no explicit temporal dynamics (e.g., $d\theta = \mu dt + \sigma dW_t$) – more precisely, there’s no continuous stochastic process or differential equation defining how $\theta$ evolves from $t$ to $t + dt$. Each $\theta_n(t)$ is a fresh draw, not a step in a trajectory. The independence of samples across $t$ means no explicit temporal correlation (e.g., autocorrelation) is modeled between $\theta_n(t)$ and $\theta_n(t')$. The derivative $\frac{d}{d\theta}$ operates over the $\theta$-domain of the density $\Phi(\theta; t)$ at fixed $t$, not over $t$. Thus, Itô calculus is unnecessary here. The randomness is in the sampling process, not in a continuous evolution of $\theta$. For a fixed measurement $n$, $\theta_n(t)$ and $\theta_n(t')$ are independent draws from $\Phi(\theta; t)$ and $\Phi(\theta; t')$, respectively. There’s no correlation imposed between $\theta_n(t)$ and $\theta_n(t')$ by a temporal process—just new, independent samples at each $t$. This supports the “no explicit temporal dynamics” claim. At the same time, $\Phi(\theta; t)$ varies with $t$ and the ensemble of samples $\{\theta_n(t)\}_{n=1}^N$ at time $t$ has different statistical characteristics, e.g., mean $\mu(t)$, concentration $\kappa(t)$, than at $t'$. This introduces a form of temporal dependence in the distribution, not in the individual $\theta_n(t)$ trajectories.

Non-Commutativity: $[\hat{\Theta}, \hat{G}_\beta] = i \beta I$ holds, providing a QM-like foundation for complementary information.
Kime Context: Operators act on $\psi(\theta) = \sqrt{\Phi}$, with randomness handled via sampling for data generation, not operator definition.

In the initial Approach 1 formulation, two families of test functions wavelet-like ($f_\alpha(\theta)$) and Fourier-like ($g_\beta(\theta)$) were used to probe the phase distribution $\Phi(\theta; t)$. It argues these families are “incompatible” if they are non-orthogonal, implying they should provide complementary information about $\Phi$. However, non-orthogonality only ensures overlap in $L^2[-\pi, \pi]$, not a fundamental limit on simultaneous measurement or complementary resolution, as in QM’s uncertainty principle. In QM, operators $A$ and $B$ are non-commuting ($[A, B] \neq 0$) when they cannot be simultaneously diagonalized, leading to $\Delta A \Delta B \geq \frac{1}{2}|\langle [A, B] \rangle|$. The kime framework needs a similar operator-theoretic foundation. In thsi reformulation of Aproach 1, we define the operators $\hat{F}_\alpha$ and $\hat{G}_\beta$ in $L^2[-\pi, \pi]$ corresponding to $f_\alpha$ and $g_\beta$, and compute their commutators explicitely.

Definition [Kime Hilbert Space and Operators]. Consider the Hilbert space, $L^2[-\pi, \pi]$, of square-integrable functions over $\theta \in [-\pi, \pi]$, equipped with the inner product \[\langle \psi_1, \psi_2 \rangle = \int_{-\pi}^\pi \psi_1(\theta) \overline{\psi_2(\theta)} d\theta,\] and the norm $\|\psi\|^2 = \langle \psi, \psi \rangle$. The phase distribution $\Phi(\theta; t)$ is a probability density (non-negative, $\int \Phi d\theta = 1$), and kime test functions acting on $\Phi$ via $\langle \Phi, f \rangle = \int f(\theta) \Phi(\theta) d\theta$. Let’s explicate the operators whose expectation values yield these integrals.

Consider the simplest case of multiplication operators where we define $\hat{F}_\alpha$ and $\hat{G}_\beta$ as multiplication operators

$\hat{F}_\alpha \psi(\theta) = f_\alpha(\theta) \psi(\theta)$,
$\hat{G}_\beta \psi(\theta) = g_\beta(\theta) \psi(\theta)$, where $\psi(\theta) \in L^2[-\pi, \pi]$, and $f_\alpha, g_\beta$ are bounded functions, e.g., $f_\alpha(\theta) = e^{-(\alpha \theta)^2} \cos(\alpha \theta)$, $g_\beta(\theta) = \cos(\beta \theta)$, to ensure $\hat{F}_\alpha, \hat{G}_\beta$ are well-defined operators.

Then, we can compute their commutator by explicating each of its two components

$\hat{F}_\alpha \hat{G}_\beta \psi(\theta) = f_\alpha(\theta) (\hat{G}_\beta \psi(\theta)) = f_\alpha(\theta) g_\beta(\theta) \psi(\theta)$,
$\hat{G}_\beta \hat{F}_\alpha \psi(\theta) = g_\beta(\theta) (\hat{F}_\alpha \psi(\theta)) = g_\beta(\theta) f_\alpha(\theta) \psi(\theta)$.

Since multiplication is commutative, $f_\alpha(\theta) g_\beta(\theta) = g_\beta(\theta) f_\alpha(\theta)$,

\[[\hat{F}_\alpha, \hat{G}_\beta] = \hat{F}_\alpha \hat{G}_\beta - \hat{G}_\beta \hat{F}_\alpha = 0.\]

Therefore, the multiplication operators, $\hat{F}_\alpha$ and $\hat{G}_\beta$ commute, implying that they can be simultaneously diagonalized; their eigenfunctions are Dirac deltas $\delta(\theta - \theta_0)$. This does not replicate QM non-commutativity and provides no basis for an uncertainty relation or complementary information.

Example 1 [Commutation of Multiplication and Differentiation]: The first example of non-commuting operators borrows intuition from QM, where the position $\hat{x}=x$ and momentum $\hat{p} = -i \frac{d}{d\theta}$ operators are non-commutative, $[\hat{x}, \hat{p}] = i$, which indicates their differential nature. Let’s show that the kime differential and multiplication operators are non-commutative. Define

$\hat{F}_\alpha = \hat{\Theta}$, the multiplication operator by $\theta$ (QM position-like) $\hat{\Theta} \psi(\theta) = \theta \psi(\theta)$, and
$\hat{G}_\beta = \hat{P} = -i \frac{d}{d\theta}$, the derivative operator (QM momentum-like).

Therefore,

$\hat{F}_\alpha \hat{G}_\beta \psi(\theta) = \hat{\Theta} (-i \frac{d}{d\theta} \psi(\theta)) = -i \theta \frac{d}{d\theta} \psi(\theta)$, and
$\hat{G}_\beta \hat{F}_\alpha \psi(\theta) = -i \frac{d}{d\theta} (\hat{\Theta} \psi(\theta)) = -i \frac{d}{d\theta} (\theta \psi(\theta)) = -i \left( \psi(\theta) + \theta \frac{d}{d\theta} \psi(\theta) \right)$,

Hence, their commutator is $[\hat{F}_\alpha, \hat{G}_\beta] \psi(\theta) = -i \theta \frac{d}{d\theta} \psi(\theta) - \left(-i \psi(\theta) - i \theta \frac{d}{d\theta} \psi(\theta)\right) = i \psi(\theta)$. In operator form, $[\hat{\Theta},\hat{P}]\equiv [\theta, -i \frac{d}{d\theta}] = i I,$ where $I$ is the identity operator. This mirrors the QM canonical commutation relation $[\hat{x}, \hat{p}] = i \hbar$; here, $\hbar = 1$.

To explicate the induced uncertainty relations, let’s first examine the expectation. Assuming $\Phi$ is the true kime-phase density, given a state $\psi(\theta) = \sqrt{\Phi(\theta)}$, The expected values of the multiplication and derivative kime operators are

(multiplication) $\langle \hat{F}_\alpha \rangle\equiv \langle \hat{\Theta} \rangle = \int_{-\pi}^\pi \theta \Phi(\theta) d\theta$,
(derivative) $\langle \hat{G}_\beta \rangle\equiv \langle -i \frac{d}{d\theta} \rangle = \int_{-\pi}^\pi \sqrt{\Phi(\theta)} \left(-i \frac{d}{d\theta} \sqrt{\Phi(\theta)}\right) d\theta$, which requires boundary conditions, e.g., periodicity or rapid decay at $\pm \pi$.

Then, the uncertainty relation is $\Delta \Theta \Delta P \geq \frac{1}{2} |\langle [\hat{\Theta}, \hat{P}] \rangle| = \frac{1}{2},$ where $\hat{P} = -i \frac{d}{d\theta}$, providing a rigorous basis for complementary information. To linking this relation to kime-test functions, instead of using $f_\alpha(\theta) = e^{-(\alpha \theta)^2} \cos(\alpha \theta)$ as we did earlier, now we define the multiplicaiton and derivative operators as

$\hat{F}_\alpha = \hat{\Theta}$, probing the “position” of $\theta$, and
$\hat{G}_\beta = -i \beta \frac{d}{d\theta}$, sensing the scaled momentum, tied to frequency-like behavior (similar to Fourier modes).

The actions $\langle \Phi, \hat{F}_\alpha \Phi \rangle = \int \theta \Phi(\theta)^2 d\theta$ and $\langle \Phi, \hat{G}_\beta \Phi \rangle = -i \beta \int \Phi(\theta) \frac{d}{d\theta} \Phi(\theta) d\theta$ yield moments and derivatives of $\Phi$, respectively, offering complementary views and independet information about hte kime-phase distribution.

Example 1 [Commutation of Convolution and Multiplication]: The second example of non-commutation involves the convolution operator for wavelet-like behavior. Multiplication by a kime-test function $f_\alpha(\theta)$ doesn’t capture the spatial structure of wavelets. Defining $\hat{F}_\alpha$ as a convolution operator

$\hat{F}_\alpha \psi(\theta) = \int_{-\pi}^\pi f_\alpha(\theta - \theta') \psi(\theta') d\theta'$ (convolution),
$\hat{G}_\beta \psi(\theta) = \cos(\beta \theta) \psi(\theta)$ (multiplication, Fourier-like).

The pair of components of the commutator are

$\hat{F}_\alpha \hat{G}_\beta \psi(\theta) = \int_{-\pi}^\pi f_\alpha(\theta - \theta') \cos(\beta \theta') \psi(\theta') d\theta'$, and
$\hat{G}_\beta \hat{F}_\alpha \psi(\theta) = \cos(\beta \theta) \int_{-\pi}^\pi f_\alpha(\theta - \theta') \psi(\theta') d\theta'$.

For this kime-test function, $f_\alpha(\theta) = e^{-(\alpha \theta)^2} \cos(\alpha \theta)$,

$\hat{F}_\alpha \hat{G}_\beta \psi(\theta) = \int_{-\pi}^\pi e^{-(\alpha (\theta - \theta'))^2} \cos(\alpha (\theta - \theta')) \cos(\beta \theta') \psi(\theta') d\theta'$, and
$\hat{G}_\beta \hat{F}_\alpha \psi(\theta) = \cos(\beta \theta) \int_{-\pi}^\pi e^{-(\alpha (\theta - \theta'))^2} \cos(\alpha (\theta - \theta')) \psi(\theta') d\theta'$.

Hence, the (Convolution-Multiplication) Commutator $[\hat{F}_\alpha, \hat{G}_\beta] \neq 0$ because $\cos(\beta \theta)$ varies with $\theta$, while the convolution kernel shifts and scales differently. The exact computation is complex, but numerically for $\psi(\theta) = 1$, $\hat{F}_\alpha \hat{G}_\beta 1 \neq \hat{G}_\beta \hat{F}_\alpha 1$, indicating non-commutativity. This aligns with the wavelet vs. Fourier intuition where convolution (local structure) and multiplication (global oscillation) probe the kime-phase $\Phi$ differently.

Let’s implement and validate this in a simulation confirming the non-commutativity and complementarity of the multiplication and differentiation operators.

library(dplyr)

# Define the Hilbert space: theta in [-pi, pi]
theta <- seq(-pi, pi, length.out = 1000)
dtheta <- theta[2] - theta[1]

# Test functions
f_alpha <- function(theta, alpha = 1) exp(-(alpha * theta)^2) * cos(alpha * theta)
g_beta <- function(theta, beta = 1) cos(beta * theta)

# Operators
F_alpha <- function(psi, theta, alpha = 1) {
  # Convolution with f_alpha
  sapply(theta, function(th) {
    kern <- f_alpha(th - theta, alpha)
    sum(kern * psi) * dtheta
  })
}

G_beta <- function(psi, theta, beta = 1) {
  # Multiplication by g_beta
  g_beta(theta, beta) * psi
}

# Derivative operator for comparison
D_beta <- function(psi, theta, beta = 1) {
  -1i * beta * diff(c(psi[length(psi)], psi))[1:length(theta)] / dtheta
}

# Commutator
commutator <- function(op1, op2, psi, theta, p1 = 1, p2 = 1) {
  op1_op2 <- op1(op2(psi, theta, p2), theta, p1)
  op2_op1 <- op2(op1(psi, theta, p1), theta, p2)
  op1_op2 - op2_op1
}

# Test with uniform psi
psi <- rep(1, length(theta)) / sqrt(2 * pi)  # Normalized
comm_FG <- commutator(F_alpha, G_beta, psi, theta, 1, 1)
comm_ThetaD <- commutator(function(psi, theta, a) theta * psi,
                         D_beta, psi, theta, 1, 1)

# Norms
norm_FG <- sqrt(sum(abs(comm_FG)^2) * dtheta)
norm_ThetaD <- sqrt(sum(abs(comm_ThetaD)^2) * dtheta)

cat("Norm of [F_alpha, G_beta] =", norm_FG, "\n")  # Non-zero

## Norm of [F_alpha, G_beta] = 0.1201431

cat("Norm of [Theta, D_beta] =", norm_ThetaD, "\n")  # Non-zero

## Norm of [Theta, D_beta] = 31.62278

# Probe a distribution
Phi <- dnorm(theta, 0, 0.5); Phi <- Phi / sum(Phi * dtheta)
exp_F <- sum(F_alpha(Phi, theta, 1) * Phi) * dtheta
exp_G <- sum(G_beta(Phi, theta, 1) * Phi) * dtheta
cat("Expectation F_alpha =", exp_F, "\n")

## Expectation F_alpha = 0.6240195

cat("Expectation G_beta =", exp_G, "\n")

## Expectation G_beta = 0.5300071

Note that $[F_\alpha, G_\beta] \neq 0$ confirms non-commutativity for convolution vs. multiplication and $[\Theta, D_\beta] \neq 0$ matches QM expectations. The expectations $\langle \Phi, \hat{F}_\alpha \Phi \rangle$ and $\langle \Phi, \hat{G}_\beta \Phi \rangle$ differ, suggesting complementary information about $\Phi$.

The next simulation reflects the Approach 1A: Hilbert Space and Operator Reformulation. This code replaces the test functions in Apprach 1 with operator-based measurements (position and momentum), validates their non-commutativity via an uncertainty principle, and reconstructs the phase distribution using both operators.

library(ggplot2)
library(dplyr)

# 1. Define True Kime-Phase Distribution (Mixture of Von Mises)
# -------------------------------------------------------------
dphi <- function(theta, kappa1=5, kappa2=5, mu1=-1, mu2=1.5, w=0.6) {
  # Mixture of two von Mises distributions
  vm1 <- exp(kappa1 * cos(theta - mu1)) / (2 * pi * besselI(kappa1, 0))
  vm2 <- exp(kappa2 * cos(theta - mu2)) / (2 * pi * besselI(kappa2, 0))
  w * vm1 + (1 - w) * vm2
}

# 2. Sample Theta from Distribution
# ---------------------------------
set.seed(123)
theta_grid <- seq(-pi, pi, length.out=1000)
phi_true <- dphi(theta_grid)
theta_samples <- sample(theta_grid, 1000, replace=TRUE, prob=phi_true)

# 3. Estimate Phi using Kernel Density Estimation (KDE)
# -----------------------------------------------------
bw <- 0.3  # Bandwidth
kde <- density(theta_samples, from=-pi, to=pi, bw=bw, n=1000)
phi_est <- approx(kde$x, kde$y, theta_grid)$y
phi_est <- phi_est / sum(phi_est * diff(theta_grid)[1])  # Normalize

# 4. Compute Position (Theta) Variance
# ------------------------------------
mean_theta <- sum(theta_grid * phi_est * diff(theta_grid)[1])
var_theta <- sum((theta_grid - mean_theta)^2 * phi_est * diff(theta_grid)[1])

# 5. Compute Momentum (Fourier) Variance
# --------------------------------------
# Wavefunction: psi(theta) = sqrt(phi_est)
psi <- sqrt(phi_est)
# Fourier transform to momentum space
psi_fft <- fft(psi)
k <- 2 * pi * seq(-0.5, 0.5, length.out=1000)  # Momentum grid
# Compute |psi_fft|^2 (momentum probability density)
momentum_prob <- abs(psi_fft)^2
momentum_prob <- momentum_prob / sum(momentum_prob)  # Normalize
# Momentum variance
mean_k <- sum(k * momentum_prob)
var_k <- sum((k - mean_k)^2 * momentum_prob)

# 6. Validate Uncertainty Principle
# ---------------------------------
# Theoretical minimum: 0.5 (for [Θ, P] = i)
uncertainty_product <- var_theta * var_k
cat(sprintf("Uncertainty Product: %.3f (≥ 0.5? %s)\n", 
            uncertainty_product, 
            ifelse(uncertainty_product >= 0.5, "Yes", "No")))

## Uncertainty Product: 6.917 (≥ 0.5? Yes)

# 7. Reconstruct Phi Using Gaussian Assumption (Example)
# ------------------------------------------------------
# Assume Gaussian from mean_theta and var_theta (for illustration)
phi_gaussian <- dnorm(theta_grid, mean_theta, sqrt(var_theta))
phi_gaussian <- phi_gaussian / sum(phi_gaussian * diff(theta_grid)[1])

# 8. Plot Results
# ---------------
df <- data.frame(
  theta = theta_grid,
  True = phi_true,
  KDE = phi_est,
  Gaussian_Fit = phi_gaussian
)

# #### PLOT
# ggplot(df, aes(x = theta)) +
#   geom_line(aes(y = True, color = "True Distribution"), linewidth=1) +
#   geom_line(aes(y = KDE, color = "KDE Estimate"), linetype="dashed") +
#   geom_line(aes(y = Gaussian_Fit, color = "Gaussian Fit"), linetype="dotted") +
#   labs(title = "Kime-Phase Distribution Estimation",
#        subtitle = sprintf("Uncertainty Product: %.2f", uncertainty_product),
#        x = expression(theta), y = "Density") +
#   scale_color_manual(values = c("True Distribution" = "blue",
#                                 "KDE Estimate" = "red",
#                                 "Gaussian Fit" = "green")) +
#   theme_minimal()

library(plotly)

# Create plot
plot_ly(df, x = ~theta) %>%
  # True Distribution line
  add_trace(
    y = ~True,
    name = "True Distribution",
    type = "scatter",
    mode = "lines",
    line = list(
      color = "blue",
      width = 2
    )
  ) %>%
  # KDE Estimate line
  add_trace(
    y = ~KDE,
    name = "KDE Estimate",
    type = "scatter",
    mode = "lines",
    line = list(
      color = "red",
      width = 2,
      dash = "dash"
    )
  ) %>%
  # Gaussian Fit line
  add_trace(
    y = ~Gaussian_Fit,
    name = "Gaussian Fit",
    type = "scatter",
    mode = "lines",
    line = list(
      color = "green",
      width = 2,
      dash = "dot"
    )
  ) %>%
  # Layout configuration
  layout(
    title = list(
      text = paste0(
        "Time-Phase Distribution Estimation<br>",
        "<sup>Uncertainty Product: ", 
        sprintf("%.2f", uncertainty_product), 
        "</sup>"
      ),
      font = list(size = 20)
    ),
    xaxis = list(
      title = "θ",
      titlefont = list(size = 14),
      gridcolor = "lightgray",
      zerolinecolor = "gray"
    ),
    yaxis = list(
      title = "Density",
      titlefont = list(size = 14),
      gridcolor = "lightgray",
      zerolinecolor = "gray"
    ),
    legend = list(
      x = 1.1,
      y = 0.9,
      bordercolor = "lightgray",
      borderwidth = 1
    ),
    paper_bgcolor = "white",
    plot_bgcolor = "white",
    margin = list(t = 100),
    showlegend = TRUE,
    hovermode = "x unified"
  ) %>%
  # Add modebar buttons
  config(
    modeBarButtonsToAdd = list(
      "hoverclosest",
      "hovercompare"
    ),
    displaylogo = FALSE
  )

The position operator ($\Theta$) directly computes the mean and variance of $\theta$ and the momentum operator ($P$) uses the Fourier transform to compute momentum variance, avoiding numerical differentiation. The uncertainty principle validation is realized by computing the product of variances $\Delta \Theta \Delta P$ and checking against the theoretical lower bound of $0.5$. The kime-phase distribution reconstruction uses kernel density estimation (KDE) to approximate $\Phi$ from samples. the simulation includes a Gaussian fit based on position variance for comparison (simplified example). The resulting plot shows the true distribution, KDE estimate, and a Gaussian fit constrained by the position variance. The uncertainty product is printed, validating the non-commutativity of $\Theta$ and $P$. This (revised) Approach $1A$ more rigorously embeds the phase estimation within a Hilbert space framework, leveraging Fourier duality to implement momentum measurements and explicitly testing quantum-inspired uncertainty relations.

In this reformulation, $\hat{F}_\alpha$ is convolution with $f_\alpha(\theta)$ and captures local phase structure, whereas $\hat{G}_\beta$ is multiplication by $g_\beta(\theta)$ and captures global oscillatory behavior. Alternatively, we can use $\hat{\Theta}$ and $\hat{D}_\beta = -i \beta \frac{d}{d\theta}$ for a position-momentum analogy. Non-commutativity ensures that measuring $\hat{F}_\alpha$ disturbs $\hat{G}_\beta$ outcomes, as standard QM. For example, $\hat{F}_\alpha$ emphasizes local peaks in $\Phi$, while $\hat{G}_\beta$ resolves periodic modes. The uncertainty relation $\Delta F_\alpha \Delta G_\beta \geq \frac{1}{2} |\langle [F_\alpha, G_\beta] \rangle|$ can be numerically validated, replacing the heuristic non-orthogonality condition.

4.2.1 The Meaning of $\frac{d}{d\theta}$ in Kime

How do we define a derivative operator when $\theta$ is a random variable rather than a deterministic coordinate? Do we need Itô calculus, distributional derivatives, or another framework to clarify the role of $\theta$ and $\frac{d}{d\theta}$ and explicate the derivative operator?

In QM, $\hat{x}$ and $\hat{p}$ operate on wavefunctions $\psi(x)$ in $L^2(\mathbb{R})$, where $x$ is a continuous spatial variable. The derivative $\frac{d}{dx}$ is well-defined as an operator on differentiable functions. In the kime context, $\kappa = t e^{i\theta}$ introduces $\theta$ as a phase, randomly sampled from $\Phi(\theta; t)$ for each measurement at time $t$. Approach 1 probes $\Phi(\theta; t)$ via test functions, e.g., $f_\alpha(\theta)$, computing expectations like $\langle \Phi, f_\alpha \rangle = \int f_\alpha(\theta) \Phi(\theta; t) d\theta$. In Approach 1A reformulation, we defined operators on a Hilbert space, e.g., $L^2[-\pi, \pi]$, acting on functions $\psi(\theta)$, where $\psi(\theta)$ represent $\sqrt{\Phi(\theta; t)}$ or another state-like object. When $\theta$ is a random draw, $\frac{d}{d\theta}$ seems ill-defined without a continuous trajectory. Yet, $\Phi(\theta; t)$ is a density over $\theta$, suggesting a functional space where $\theta$ is a variable of integration, not a stochastic process evolving in time (as in Itô calculus).

Since $\Phi(\theta; t)$ is a probability density over $\theta \in [-\pi, \pi]$ at fixed $t$, we treat $\theta$ as a coordinate in a function space, not a random variable evolving dynamically. Thus,

Hilbert Space: $L^2[-\pi, \pi]$, where functions $\psi(\theta)$ are square-integrable over $\theta$, and $\Phi(\theta; t) = |\psi(\theta)|^2$ (analogous to a probability density in QM).
State: $\psi(\theta)$ could be $\sqrt{\Phi(\theta; t)}$ (assuming $\Phi$ is real and non-negative), representing the “state” of the kime-phase distribution at time $t$.
Operators: Define $\hat{F}_\alpha$ and $\hat{G}_\beta$ as operators on $\psi(\theta)$, with expectations computed against $\Phi(\theta; t)$.

The differentiation operator $\hat{G}_\beta = -i \frac{d}{d\theta}$ in $L^2[-\pi, \pi]$, where $\theta$ is the independent variable of the function space, not a random draw per se. The random sampling occurs when we generate data (e.g., $\theta_n(t) \sim \Phi$), but the operators act on the density or its square root. Thus, the multiplication operator $\hat{\Theta} \psi(\theta) = \theta \psi(\theta)$ and the differentiation operator $\hat{G}_\beta \psi(\theta) = -i \beta \frac{d}{d\theta} \psi(\theta)$, where $\beta$ scales the “momentum” (frequency-like) contribution.

Boundary Conditions: Since $\theta \in [-\pi, \pi]$ is a circular domain (phase wraps around), we impose periodic boundary conditions: $\psi(-\pi) = \psi(\pi)$, ensuring $\hat{G}_\beta$ is well-defined on differentiable functions in $L^2[-\pi, \pi]$.

Commutator:$[\hat{\Theta}, \hat{G}_\beta] \psi(\theta) = -i \beta \theta \frac{d}{d\theta} \psi(\theta) - (-i \beta \psi(\theta) - i \beta \theta \frac{d}{d\theta} \psi(\theta)) = i \beta \psi(\theta)$, where

$\hat{\Theta} \hat{G}_\beta \psi(\theta) = \theta (-i \beta \frac{d}{d\theta} \psi(\theta)) = -i \beta \theta \frac{d}{d\theta} \psi(\theta)$, and
$\hat{G}_\beta \hat{\Theta} \psi(\theta) = -i \beta \frac{d}{d\theta} (\theta \psi(\theta)) = -i \beta \left( \psi(\theta) + \theta \frac{d}{d\theta} \psi(\theta) \right)$.

Thus, $[\hat{\Theta}, \hat{G}_\beta] = i \beta I$ confirms non-commutativity, with a commutator proportional to $\beta$. Itô calculus does not apply to stochastic processes where a variable, $\theta(t)$, evolves randomly over time $t$, governed by a stochastic differential equation (SDE). In kime, $\theta$ is sampled independently at each $t$ from $\Phi(\theta; t)$, with no explicit temporal dynamics (e.g., $d\theta = \mu dt + \sigma dW_t$). And the derivative $\frac{d}{d\theta}$ operates over the $\theta$-domain of the density $\Phi(\theta; t)$ at fixed $t$, not over $t$. Thus, Itô calculus is unnecessary here. The randomness is in the sampling process, not in a continuous evolution of $\theta$. A distributional derivative (e.g., weak derivative) would be needed if $\psi(\theta)$ or $\Phi(\theta; t)$ were not differentiable (e.g., included Dirac deltas). For simplicity, assume $\Phi(\theta; t)$ is smooth (e.g., von Mises), so the standard derivative suffices. If $\Phi$ were less regular, we’d define $\hat{G}_\beta$ in the sense of distributions, $\langle \hat{G}_\beta \psi, \phi \rangle = -i \beta \int_{-\pi}^\pi \psi(\theta) \frac{d}{d\theta} \phi(\theta) d\theta$, for test functions $\phi \in C^\infty[-\pi, \pi]$.

Hence, the reformulated Approach 1 with non-commuting operators is based on

Hilbert Space: $L^2[-\pi, \pi]$, with $\psi(\theta) = \sqrt{\Phi(\theta; t)}$.
Operators: - Multiplication operator: $\hat{F}_\alpha = \hat{\Theta}$, probing the “position” (mean) of $\theta$, and - Differentiation operator: $\hat{G}_\beta = -i \beta \frac{d}{d\theta}$, probing frequency-like variations.
Measurement: In the state, $\psi(\theta) = \sqrt{\Phi(\theta; t)}$, we compute the expectations $\langle \psi | \hat{F}_\alpha | \psi \rangle = \int \theta \Phi(\theta; t) d\theta$, $\langle \psi | \hat{G}_\beta | \psi \rangle = -i \beta \int \psi(\theta) \frac{d}{d\theta} \psi(\theta) d\theta$.
Kime-Phase Recovery/Reconstruction: Use multiple $\beta$ values to estimate $\Phi(\theta; t)$ via moments or Fourier components.
Expectations: $\langle \hat{\Theta} \rangle = \int_{-\pi}^\pi \theta \Phi(\theta; t) d\theta$ and

\[\langle \hat{G}_\beta \rangle = -i \beta \int_{-\pi}^\pi \sqrt{\Phi(\theta; t)} \frac{d}{d\theta} \sqrt{\Phi(\theta; t)} d\theta = -i \beta \int_{-\pi}^\pi \frac{1}{2} \frac{\frac{d}{d\theta} \Phi(\theta; t)}{\sqrt{\Phi(\theta; t)}} d\theta.\]

Mind that the statement, “no explicit temporal dynamics” refers to the absence of a stochastic differential equation (SDE) or a continuous-time process governing $\theta$’s evolution over $t$. For example, in a stochastic process like a Wiener process or an Itô diffusion, $\theta(t)$ would evolve according to something like $d\theta = \mu dt + \sigma dW_t$, where $W_t$ is Brownian motion, implying a smooth, temporally correlated trajectory with increments dependent on previous values. Such a model introduces temporal dependence through a differential structure, where $\theta(t + dt)$ depends on $\theta(t)$ via drift ($\mu$) and diffusion ($\sigma$).

In contrast, the Approach 1A kime framework treats $\theta$ as follows

At each fixed time $t$, a value $\theta_n(t)$ is sampled independently from the distribution $\Phi(\theta; t)$ for each measurement $n = 1, 2, \ldots, N$.
The next time point $t' = t + \Delta t$ yields a new sample $\theta_n(t')$ from $\Phi(\theta; t')$, with no explicit rule (like an SDE) linking $\theta_n(t)$ to $\theta_n(t')$.

The “no explicit temporal dynamics” claim hinges on the idea that $\theta_n(t)$ and $\theta_n(t')$ are independent (IID) draws, lacking a mechanistic model of temporal evolution, e.g., no Markovian transition or differential equation.

However, $\Phi(\theta; t)$ is time-dependent, meaning the distribution from which $\theta$ is sampled changes with $t$. For instance, in the simulation, $\mu(t) = 2\pi \sin(0.1 t)$ and $\kappa(t) = 5 (1 + 0.5 \sin(2\pi t / T))$ define a von Mises distribution $\Phi(\theta; t) = \text{vM}(\mu(t), \kappa(t))$, where both mean and concentration parameters vary over time. This implies that the statistical properties of $\theta$, e.g., mean, variance, evolve with $t$, even if the samples at different $t$ are drawn independently. This time-dependence of $\Phi(\theta; t)$ introduces a subtlety; while there’s no dynamic process linking $\theta(t)$ to $\theta(t')$, like an SDE, the distribution’s parameters are functions of $t$, suggesting an implicit temporal structure through the changing $\Phi$.

Statistical independence across time: For a fixed measurement $n$, $\theta_n(t)$ and $\theta_n(t')$ are independent draws from $\Phi(\theta; t)$ and $\Phi(\theta; t')$, respectively. There’s no correlation imposed between $\theta_n(t)$ and $\theta_n(t')$ by a temporal process—just new, independent samples at each $t$. This supports the “no explicit temporal dynamics” claim. At the same time, $\Phi(\theta; t)$ varies with $t$ and the ensemble of samples $\{\theta_n(t)\}_{n=1}^N$ at time $t$ has different statistical characteristics, e.g., mean $\mu(t)$, concentration $\kappa(t)$, than at $t'$. This introduces a form of temporal dependence in the distribution, not in the individual $\theta_n(t)$ trajectories. There’s no continuous stochastic process or differential equation defining how $\theta$ evolves from $t$ to $t + dt$. Each $\theta_n(t)$ is a fresh draw, not a step in a trajectory. The independence of samples across $t$ means no explicit temporal correlation, e.g., autocorrelation, is modeled between $\theta_n(t)$ and $\theta_n(t')$.

Hence, in kime, $\theta$ is sampled independently at each $t$ from a time-dependent distribution $\Phi(\theta; t)$, with no explicit stochastic temporal dynamics, e.g., $d\theta = \mu dt + \sigma dW_t$, linking successive samples. However, the distribution $\Phi(\theta; t)$ itself varies with $t$, introducing an implicit temporal dependence in the statistical properties of $\theta$.

Let’s also clarify the kime-operators and $\frac{d}{d\theta}$ in the reformulation of Approach 1A, The derivative $\hat{G}_\beta = -i \beta \frac{d}{d\theta}$ operates on functions $\psi(\theta) = \sqrt{\Phi(\theta; t)}$ in $L^2[-\pi, \pi]$ at a fixed $t$. Here, $\theta$ is a coordinate in the phase domain, not a time-evolving variable. The operator probes the spatial (phase) structure of $\Phi(\theta; t)$, not its temporal evolution. Below is an updated simulation with time-dependent $\Phi$ refining the prior simulation to explicitly express the $\Phi(\theta; t)$’s time-dependence.

library(circular)
library(plotly)

set.seed(123)

# Parameters
T <- 100
N <- 1000
t <- seq(0, 10, length.out = T)
theta_grid <- seq(-pi, pi, length.out = 1000)
dtheta <- theta_grid[2] - theta_grid[1]

# True time-dependent von Mises distribution
mu_true <- 2 * pi * sin(0.1 * t)
kappa_true <- 5 * (1 + 0.5 * sin(2 * pi * t / T))

# Operators
Theta_op <- function(psi, theta) theta * psi
G_beta_op <- function(psi, theta, beta = 1) {
  -1i * beta * diff(c(psi[length(psi)], psi))[1:length(theta)] / dtheta
}

# Forward model
generate_signal <- function(t, theta) sin(2 * pi * 0.5 * t + theta) + rnorm(length(t), 0, 0.1)

# Simulate data
theta_true <- matrix(NA, N, T)
x <- matrix(NA, N, T)
for (n in 1:N) {
  for (tt in 1:T) {
    theta_true[n, tt] <- rvonmises(1, mu = mu_true[tt], kappa = kappa_true[tt])
  }
  x[n, ] <- generate_signal(t, theta_true[n, ])
}

# Manual Hilbert transform
hilbert_manual <- function(x) {
  n <- length(x)
  fft_x <- fft(x)
  h <- numeric(n); h[1] <- 1; h[2:(n/2)] <- 2; h[(n/2 + 1):n] <- 0
  fft(h * fft_x, inverse = TRUE) / n
}

# Phase inference
theta_est <- t(apply(x, 1, function(row) Arg(hilbert_manual(row))))

# Moment estimation
m1_est <- colMeans(exp(1i * theta_est))
mu_hat <- Arg(m1_est)
R <- abs(m1_est)
kappa_hat <- sapply(R, function(r) if (r >= 0.999) 100 else if (r <= 0.001) 0 else uniroot(function(k) besselI(k, 1) / besselI(k, 0) - r, c(0, 100))$root)

# Operator expectations at sample t
Phi_t <- dvonmises(theta_grid, mu = mu_true[50], kappa = kappa_true[50])
Phi_t <- Phi_t / sum(Phi_t * dtheta)
psi_t <- sqrt(Phi_t)
exp_Theta <- sum(Theta_op(psi_t, theta_grid) * psi_t) * dtheta
exp_G <- sum(G_beta_op(psi_t, theta_grid, 1) * psi_t) * dtheta
cat("At t[50]: <Theta> =", exp_Theta, ", <G_beta> =", exp_G, "\n")

## At t[50]: <Theta> = 0.7407191 , <G_beta> = 0-0.004095352i

# Plot
df <- data.frame(t = t, mu_true = mu_true %% (2 * pi) - pi, kappa_true = kappa_true,
                 mu_hat = mu_hat %% (2 * pi) - pi, kappa_hat = kappa_hat)
fig_mu <- plot_ly(df) %>% add_trace(x = ~t, y = ~mu_true, type = "scatter", mode = "lines", name = "True μ") %>%
  add_trace(x = ~t, y = ~mu_hat, type = "scatter", mode = "lines", name = "Est μ") %>%
  layout(title = "Mean Phase", yaxis = list(title = "μ(t)"))
fig_kappa <- plot_ly(df) %>% add_trace(x = ~t, y = ~kappa_true, type = "scatter", mode = "lines", name = "True κ") %>%
  add_trace(x = ~t, y = ~kappa_hat, type = "scatter", mode = "lines", name = "Est κ") %>%
  layout(title = "Concentration", yaxis = list(title = "κ(t)"))
fig_mu

fig_kappa

This reflects $\Phi(\theta; t)$’s time-dependence while maintaining independent sampling, aligning with the Approach 1A refined formulation.

4.3 Approach 2

An alternative kime-measurement scheme for estimating the unobservable kime-phase $\theta$, may define an analogous framework where “non-commuting” kime-phase distributions $\Phi(t)$ act on test functions, analogous to non-commuting observables in QM. In QM, observables $\hat{A}, \hat{B}$ are non-commuting if $[\hat{A}, \hat{B}] \neq 0$. For kime-phase distributions $\Phi_1(t), \Phi_2(t)$, we define non-commutation via their action on kime-test functions $f(\kappa)$. Specifically, a pair of phase distributions $\Phi_1(t),\ \Phi_2(t)$ commute if their combined action on any test function is order-independent \[\mathbb{E}_{\Phi_1}\left[\mathbb{E}_{\Phi_2}[f(\kappa)]\right] = \mathbb{E}_{\Phi_2}\left[\mathbb{E}_{\Phi_1}[f(\kappa)]\right].\] Thus, the phase distributions do not commute if the order of expectation matters, i.e., the commutator $[\Phi_1, \Phi_2] \neq 0$.

To utilize the kime-test functions as probes, we define a set of kime-test functions $\{f_j(\kappa)\}$, analogous to quantum measurement operators, sensitive to the kime-phase $\theta$. For example, Fourier-like test functions are defined by $f_j(\kappa) = e^{i n \theta}$, where $n$ is a harmonic index, while polynomial test functions are defined by $f_j(\kappa) = \kappa^n = t^n e^{i n \theta}$, probing moments of $t$ and $\theta$. The expectation of $f_j(\kappa)$ under $\Phi(t)$ is \[\mathbb{E}_\Phi[f_j(\kappa)] = \int t^n e^{i n \theta} \Phi(t) d\theta dt.\] If $\Phi(t)$ encodes a phase distribution (e.g., $\theta \sim \mathcal{N}(0, \sigma(t))$), this expectation becomes a moment-generating function for $\theta$.

The non-commutativity of a pair of kime-phase distributions $\Phi_1(t), \Phi_2(t)$, exploits non-commuting actions on test functions. For example,

Uniform Phase (U): $\Phi_U(t) \propto \delta(t - t_0) \cdot \text{Uniform}(\theta)$.
Concentrated Phase (C): $\Phi_C(t) \propto \delta(t - t_0) \cdot \delta(\theta - \theta_0)$.
Time-Correlated Phase (T): $\Phi_T(t) \propto \mathcal{N}(t; \mu, \sigma) \cdot \mathcal{N}(\theta; \phi(t), \gamma)$, where $\phi(t)$ depends on $t$.

Non-Commutation Example: The commutator $[\Phi_U, \Phi_T] \neq 0$ averaged over $\Phi_U$ followed by $\Phi_T$ produces different results than when the averaging order is reversed. This occurs when time-dependent draws from $\Phi_T$, $\phi(t)$, depend nonlinearly on $t$, making the order of integration matter. To formulate a consistent measurement protocol for kime-phase estimation, i.e., to estimate $\hat\theta$, we can perform repeated measurements under different $\Phi(t)$, analogous to QM’s non-commuting bases. First, sample $\kappa = t e^{i\theta}$ under $\Phi_1(t)$ and compute $\mathbb{E}_{\Phi_1}[f_j(\kappa)]$. Then, repeat step 1 under $\Phi_2(t)$ and compute $\mathbb{E}_{\Phi_2}[f_j(\kappa)]$. Finally, solve for $\theta$ by (ensembling) combining the results from non-commuting $\Phi_1, \Phi_2$.

Consider an example using Fourier test functions, $f_j(\kappa) = e^{i n \theta}$. For two non-commuting phase distributions $\Phi_1, \Phi_2$, under $\Phi_1$, $\mathbb{E}_{\Phi_1}[e^{i n \theta}] = \int e^{i n \theta} \Phi_1(t) d\theta dt = \tilde{\Phi}_1(n)$ is the Fourier transform of $\Phi_1$, while under $\Phi_2$, $\mathbb{E}_{\Phi_2}[e^{i n \theta}] = \tilde{\Phi}_2(n)$ is the Fourier transform of $\Phi_2$. By measuring $\tilde{\Phi}_1(n)$ and $\tilde{\Phi}_2(n)$ for multiple $n$, we invert the Fourier problem to estimate $\theta$, assuming $\Phi_1, \Phi_2$ provide complementary “views” of the phase $\theta$.

This scheme mirrors QM’s use of non-commuting bases to reconstruct $\phi$. For instance, QM measures $\langle X \rangle \propto \cos\phi$ and $\langle Y \rangle \propto \sin\phi$, whereas kime measures $\tilde{\Phi}_1(n) \propto \mathbb{E}[e^{i n \theta}]$ and $\tilde{\Phi}_2(n) \propto \mathbb{E}[e^{i m \theta}]$, with $\Phi_1, \Phi_2$ chosen such that their Fourier components resolve $\theta$.

In practice, the kime scheme requires non-commuting $\Phi(t)$ with distinct $\theta$-dependencies (e.g., uniform vs. time-correlated phases), defining test functions sensitive to $\theta$ (e.g., oscillatory functions $e^{i n \theta}$), and statistical inversion (e.g., maximum likelihood, Bayesian methods) to estimate $\theta$ from aggregated expectations. The kime-phase $\theta$, like the quantum wavefunction phase, is inferred indirectly through its correlations with observable quantities (e.g., $t$) under non-commuting phase distributions. By generalizing the concept of operator commutation to the action of $\Phi(t)$ on test functions, draws parallels between QM’s phase-recovery strategy in the kime framework. This approach may be useful for kime-tomography and applications in complex-time signal processing.

4.3.1 Strategy 2 fMRI Example - Estimation of Time-Dynamic von Mises Phase Distribution

Let’s demonstrate this second approach for estimating the kime-phase distribution $\Phi(t)$ from repeated measurements. This strategy is also inspired by quantum phase estimation and we’ll use a moment-based approach with test functions sensitive to the phase $\theta(t)$. At each time $t$, the complex kime is $\kappa_n(t) = t e^{i\theta_n(t)}$, where $\theta_n(t) \sim \Phi(t)$ for measurement $n$. The test functions will use Fourier modes $f_j(\theta) = e^{i j \theta}$ to probe the moments of $\Phi(t)$. The $j$-th moment is $\mathbb{E}_{\Phi(t)}[e^{i j \theta}] = \int e^{i j \theta} \Phi(t)d\theta$ and the moment estimation using $N$ measurements is $\hat{m}_j(t) = \frac{1}{N} \sum_{n=1}^N \left(\frac{\kappa_n(t)}{t}\right)^j.$

In this simulation, the phase distribution recovery assumes $\Phi(t)$ is a von Mises distribution $\text{vM}(\mu(t), \kappa(t))$ and relies on solving for its pair of parameters, $\mu(t)$ (mean) and $\kappa(t)$ (concentration), using \[\hat{\mu}(t) = \arg(\hat{m}_1(t)), \quad \hat{\kappa}(t) \text{ s.t. } \frac{I_1(\hat{\kappa}(t))}{I_0(\hat{\kappa}(t))} = |\hat{m}_1(t)|,\] where $I_p$ is the modified Bessel function of order $p$. Recall that the parameters $\mu$ and $\frac{1}{\kappa}$ of the von Mises distribution, $vM(\mu,\kappa)$, are analogous to the mean $\mu$ and variance $\sigma^2$ parameters of the normal distribution. Specifically, $\mu =\mu_{vM}$ is a measure of location/centrality as the distribution is clustered around $\mu$, and $\kappa$ is a measure of concentration, i.e., a reciprocal measure of dispersion, $\frac{1}{\kappa}\approx \sigma^2$. As $\kappa \to 0$, the $vM(\mu,\kappa)\to Uniform[-\pi,\pi)$, and as $\kappa \uparrow$, the $vM(\mu,\kappa)\to N\left (\mu, \sigma^2=\frac{1}{\kappa}\right )$.

In this simulation, the time-varying von Mises kime-phase distribution has an oscillating location parameter $\mu(t)=2 \pi \sin(0.1 t)$ and a time-dynamics concentration parameter $\kappa(t) = 5.263 \left (1 + 0.5 \sin\left(2 \pi \frac{t}{T}\right )\right )$. The first moment $\hat{m}_1(t)$ estimates $\mathbb{E}[e^{i\theta(t)}]$, encoding $\mu(t)$ and $\kappa(t)$. The phase distribution recovery is obtained by estimating the pair of time-dependent von Mises distribution parameters, $\mu(t)\approx \hat{m}_1(t)$ (location) and $\kappa(t)$ (concentration), which is estimated numerically using the relationship between $|\hat{m}_1(t)|$ and the Bessel functions, $\frac{I_1(\hat{\kappa}(t))}{I_0(\hat{\kappa}(t))} = |\hat{m}_1(t)|$.

# ############################################## OVER-SImplified Demo ######
# # --- Simulation and Estimation ---
# library(circular)
# library(VGAM)
# set.seed(123)
# 
# # Parameters
# T <- 100                  # Time points
# N <- 1000                 # Number of measurements
# kappa_true <- 5.263       # True concentration
# mu_true <- 0              # True mean phase
# 
# # Simulate observed phases directly from target von Mises distribution
# theta_observed <- matrix(
#   rvonmises(N * T, mu = mu_true, kappa = kappa_true),
#   nrow = N, ncol = T
# )
# 
# # --- Estimate von Mises Parameters ---
# # --- MLE using `circular` package ---
# estimate_vonmises <- function(theta_samples) {
#   theta_circ <- circular(theta_samples, type = "angles", units = "radians", modulo = "2pi")
#   mle <- mle.vonmises(theta_circ, bias = TRUE)
#   c(mu_hat = as.numeric(mle$mu), kappa_hat = mle$kappa)
# }
# 
# # --- Estimate μ(t) and κ(t) ---
# estimates <- t(sapply(1:T, function(t) {
#   estimate_vonmises(theta_observed[, t])
# }))
# 
# 
# library(ggplot2)
# df <- data.frame(
#   t = 1:T,
#   true_mu = mu_true,
#   true_kappa = kappa_true,
#   mu_hat = (estimates[, "mu_hat"] + pi) %% (2 * pi) - pi,  # Wrap to [-π, π]
#   kappa_hat = estimates[, "kappa_hat"]
# )
# 
# # # Plot μ(t)
# # ggplot(df, aes(x = t)) +
# #   geom_line(aes(y = mu_hat), color = "blue") +
# #   geom_hline(yintercept = mu_true, linetype = "dashed") +
# #   labs(title = "Estimated Mean Phase μ(t)", y = "μ(t)") +
# #   ylim(-pi, pi)
# # 
# # # Plot κ(t)
# # ggplot(df, aes(x = t)) +
# #   geom_line(aes(y = kappa_hat), color = "red") +
# #   geom_hline(yintercept = kappa_true, linetype = "dashed") +
# #   labs(title = "Estimated Concentration κ(t)", y = "κ(t)") +
# #   ylim(0, 10)
# 
# # df has columns: t, mu_hat, kappa_hat
# # and scalar constants mu_true, kappa_true.
# # 1) Plot for mu(t) --------------------------------------
# p1 <- plot_ly(data = df, x = ~t) %>%
#   # main line: mu_hat
#   add_trace(y = ~mu_hat, type = 'scatter', mode = 'lines',
#     line = list(color = 'blue'), name = 'μ(t)') %>%
#   # dashed horizontal line at y = mu_true
#   add_trace(y = rep(mu_true, nrow(df)), type = 'scatter', mode = 'lines',
#     line = list(color = 'black', dash = 'dash'), name = 'μ_true') %>%
#   layout(title = "Estimated Mean Phase μ(t)",
#     xaxis = list(title = "t"), yaxis = list(
#       title = "μ(t)", range = c(-pi/5, pi/5)  # match ggplot ylim(-pi, pi)
#     )
#   )
# 
# # 2) Plot for kappa(t) ------------------------------------
# p2 <- plot_ly(data = df, x = ~t) %>%
#   # main line: kappa_hat
#   add_trace(y = ~kappa_hat, type = 'scatter', mode = 'lines',
#     line = list(color = 'red'), name = 'κ(t)') %>%
#   # dashed horizontal line at y = kappa_true
#   add_trace(y = rep(kappa_true, nrow(df)), type = 'scatter', mode = 'lines',
#     line = list(color = 'black', dash = 'dash'), name = 'κ_true') %>%
#   layout(title = "Estimated Concentration κ(t)", xaxis = list(title = "t"),
#     yaxis = list(title = "κ(t)", range = c(0, 10)  # match ggplot ylim(0, 10)
#     )
#   )
# 
# # display the plots
# p1
# p2

library(circular)
library(plotly)
set.seed(123)

# Parameters
T <- 100                  # Time points
N <- 5000                 # Increased measurements for better fidelity
kappa_true <- 5.263 * (1 + 0.5 * sin(2 * pi * (1:T)/T))  # Time-varying κ
mu_true <- 2 * pi * sin(0.1 * (1:T))                     # Oscillating μ(t)
kappa_noise <- 20

# --- Data Generation (Time-Dependent μ(t) & κ(t)) ---
theta_true <- matrix(NA, nrow = N, ncol = T)
for(n in 1:N){
  theta <- numeric(T)
  theta[1] <- rvonmises(1, mu = mu_true[1], kappa = kappa_true[1])
  for(t in 2:T){
    theta_prev <- theta[t-1]
    theta[t] <- rvonmises(1, mu = mu_true[t], kappa = kappa_true[t])
  }
  theta_true[n,] <- theta
}

# Add phase noise and create kime data
theta_observed <- theta_true + rvonmises(N*T, mu = 0, kappa = kappa_noise)
kappa <- t(outer(1:T, rep(1,N)) %*% exp(1i * theta_observed))

# --- High-Fidelity Estimation ----
A_noise <- besselI(kappa_noise, 1)/besselI(kappa_noise, 0)

estimate_params <- function(t){
  # Enhanced moment estimation
  samples <- theta_observed[,t]
  
  # Robust μ estimation
  C <- mean(cos(samples))
  S <- mean(sin(samples))
  mu_hat <- atan2(S, C) %% (2*pi)
  
  # Precision κ estimation with numerical solver
  R_obs <- sqrt(C^2 + S^2)
  R_true <- R_obs/A_noise
  
  if(R_true >= 0.999) return(c(mu_hat, 1000))  # Handle near-perfect concentration
  if(R_true <= 0.001) return(c(mu_hat, 0))     # Handle uniform distribution
  
  kappa_hat <- tryCatch({
    uniroot(function(k) besselI(k,1)/besselI(k,0) - R_true,
            interval = c(0, 100))$root
  }, error = function(e) NA)
  
  c(mu_hat, kappa_hat)
}

estimates <- t(sapply(1:T, estimate_params))
colnames(estimates) <- c("mu_hat", "kappa_hat")

# --- Interactive Visualization ----
df <- data.frame(t = 1:T, mu_true = (mu_true + pi) %% (2*pi) - pi,  # Wrapped to [-π, π]
  kappa_true = kappa_true, mu_hat = (estimates[,"mu_hat"] + pi) %% (2*pi) - pi,
  kappa_hat = estimates[,"kappa_hat"]
)

fig_mu <- plot_ly(df, x = ~t) %>%
  add_trace(y = ~mu_true, name = "True μ(t)", type = 'scatter', mode = 'lines',
            line = list(color = 'black', dash = 'dot')) %>%
  add_trace(y = ~mu_hat, name = "Estimated μ(t)", type = 'scatter', mode = 'lines',
            line = list(color = 'blue')) %>%
  layout(title = "Kime-Phase Distribution μ(t) Parameter Estimation",
    yaxis = list(title = "μ(t) [rad]"),  #, domain = c(0, 0.45)),
    xaxis = list(title = "Time t"))
fig_mu

fig_kappa <- plot_ly(df, x = ~t) %>%
  add_trace(y = ~kappa_true, name = "True κ(t)", type = 'scatter', mode = 'lines',
            line = list(color = 'black', dash = 'dot')) %>%
  add_trace(y = ~kappa_hat, name = "Estimated κ(t)", type = 'scatter', mode = 'lines',
            line = list(color = 'red')) %>%
  layout(title = "Kime-Phase Distribution κ(t) Parameter Estimation",
    xaxis = list(title = "Time t"), yaxis = list(title = "κ(t)"))
fig_kappa

Note that the estimates, $\hat{\mu}(t)$ and $\hat\kappa(t)$, closely track the true location $(\mu(t))$ and the true concentration $(\kappa(t))$, after noise deconvolution. This experimental protocol respects the quantum-inspired analogy. The test functions $e^{i j \theta}$ act as “bases” probing complementary aspects of $\Phi(t)$ and the moment estimation generalizes quantum state tomography, where measurements in non-commuting bases resolve hidden phase information. The noise deconvolution mirrors quantum error mitigation, preserving the intrinsic phase distribution. This simulation bridges quantum-inspired estimation with classical signal processing, enabling robust recovery of time-dependent kime-phase distributions.

By leveraging moment-based estimation with test functions (analogous to non-commuting observables), we indirectly probe the unobservable kime-phase distribution. This mirrors quantum phase estimation, where complementary measurements resolve hidden phase information.

4.4 Approach 2A: Reformulation of Commutativity

In Approach 2 of the kime-phase estimation framework, there is ambiguity in the non-commutativity definition. In the reformulated Approach 2A, we address this issue systematically, and show a practical implementation to demonstrate the solution.

The initial (Approach 2) definition of non-commutativity for kime-phase distributions $\Phi_1(t), \Phi_2(t)$ as $\mathbb{E}_{\Phi_1}[\mathbb{E}_{\Phi_2}[f(\kappa)]] \neq \mathbb{E}_{\Phi_2}[\mathbb{E}_{\Phi_1}[f(\kappa)]]$ is intuitive but lacks a clear operator-theoretic basis. It resembles a statistical property rather than the algebraic non-commutativity ($[A, B] \neq 0$) seen in quantum mechanics (QM). We’ll reformulate $\Phi_1, \Phi_2$ as operators on a function space, e.g., convolution or transition kernels, and compute their commutators explicitly, or justify the statistical definition with a concrete example.

Also, earlier when estimating the Von Mises parameter, $\hat{\kappa}(t)$ via $\frac{I_1(\hat{\kappa}(t))}{I_0(\hat{\kappa}(t))} = |\hat{m}_1(t)|$, we assumed that $|\hat{m}_1(t)| < 1$. Noise or sampling bias can yield $|\hat{m}_1(t)| > 1$, leading to undefined solutions since the Bessel ratio is bounded by $1$. Thus, we need to implement bounds and robust solvers to handle edge cases. Finally, the earlier simulation assumes direct access to $\theta_n(t)$, which may be unrealistic for applications like fMRI, where only observables (e.g., BOLD signals) are available, i.e., measurable. Hence, we’ll introduce a forward model, e.g., BOLD signal as a convolution of a stimulus with a hemodynamic response shifted by $\theta$, and then infer $\theta$ from the actual fMRI data.

The core of Approach 2/2A is to estimate the unobservable kime-phase $\theta$ in $\kappa = t e^{i\theta}$ by defining “non-commuting” phase operators $\hat{\Phi}_1(t), \hat{\Phi}_2(t)$ paired with distributions $\Phi_1(t), \Phi_2(t)$ acting on kime-test functions $f(\kappa)$, analogous to QM’s non-commuting observables. This requires a clear and rigorous operator framework, resolving parameter estimation issues, and grounding Approach 2A in a realistic data model.

To redefine non-commutativity with operators, instead of nested expectations, we’ll treat $\Phi_j(t)$ as defining transition kernels in a Hilbert space, mapping functions of $\kappa$ or $\theta$ to new functions. The operators will be defined in $L^2[-\pi, \pi]$, the space of square-integrable functions over $\theta \in [-\pi, \pi]$.

Operator Definition: $\hat{\Phi}_j f(\theta) = \int_{-\pi}^\pi K_j(\theta, \theta') f(\theta') d\theta'$, where $K_j(\theta, \theta') = \Phi_j(\theta' | t) p(\theta | \theta')$ is a kernel, $\Phi_j(\theta' | t)$ is the phase distribution at time $t$, and $p(\theta | \theta')$ is a transition probability (e.g., Gaussian or uniform). For simplicity, let $p(\theta | \theta') = \Phi_j(\theta - \theta' | t)$, making $\hat{\Phi}_j$ a convolution operator

\[\hat{\Phi}_j f(\theta) = \int_{-\pi}^\pi \Phi_j(\theta - \theta' | t) f(\theta') d\theta'.\]

Commutator is computed from

\[\hat{\Phi}_1 \hat{\Phi}_2 f(\theta) = \int_{-\pi}^\pi \Phi_1(\theta - \theta'' | t) \left( \int_{-\pi}^\pi \Phi_2(\theta'' - \theta' | t) f(\theta') d\theta' \right) d\theta'',\] \[\hat{\Phi}_2 \hat{\Phi}_1 f(\theta) = \int_{-\pi}^\pi \Phi_2(\theta - \theta'' | t) \left( \int_{-\pi}^\pi \Phi_1(\theta'' - \theta' | t) f(\theta') d\theta' \right) d\theta''\]

\[[\hat{\Phi}_1, \hat{\Phi}_2] f(\theta) = \hat{\Phi}_1 \hat{\Phi}_2 f(\theta) - \hat{\Phi}_2 \hat{\Phi}_1 f(\theta).\]

Commuting Example: When $\Phi_1$ and $\Phi_2$ are distinct (e.g., $\Phi_1(\theta) = \delta(\theta)$, $\Phi_2(\theta) = \frac{1}{2\pi}$), the order of convolution matters unless they commute (e.g., both Gaussian with same variance). For example, if $\Phi_1(\theta) = \delta(\theta)$, $\hat{\Phi}_1 f(\theta) = f(\theta)$; if $\Phi_2(\theta) = \frac{1}{2\pi}$, $\hat{\Phi}_2 f(\theta) = \frac{1}{2\pi} \int f(\theta') d\theta'$ (a constant). Then, $\hat{\Phi}_1 \hat{\Phi}_2 f(\theta) = \hat{\Phi}_1 (\text{const}) = \text{const}$, $\hat{\Phi}_2 \hat{\Phi}_1 f(\theta) = \hat{\Phi}_2 f(\theta) = \text{const}$, and $[\hat{\Phi}_1, \hat{\Phi}_2] = 0$ here, but for non-uniform $\Phi_2$, non-commutativity emerges.

Non-Commuting Example: Consider $\Phi_1(\theta | t) = \frac{1}{\sqrt{2\pi \sigma^2}} e^{-\theta^2/(2\sigma^2)}$ (Gaussian) and $\Phi_2(\theta | t) = \frac{1}{2\pi} (1 + \cos(\theta))$ (non-uniform). The convolution order changes the result due to differing smoothing properties, yielding $[\hat{\Phi}_1, \hat{\Phi}_2] \neq 0$. This operator approach replaces the ambiguous nested expectation with a QM-like algebraic structure.

The phase estimation is based on kime-test functions, e.g., Fourier test functions $f_n(\theta) = e^{i n \theta}$ whose expectation is $\langle \hat{\Phi}_j f_n \rangle = \int_{-\pi}^\pi \hat{\Phi}_j e^{i n \theta} \Phi(\theta | t) d\theta$, and their moment is $m_n(t) = \mathbb{E}_{\Phi(t)}[e^{i n \theta}] = \int e^{i n \theta} \Phi(\theta | t) d\theta$. For a von Mises distribution $\Phi(\theta | t) = \text{vM}(\mu(t), \kappa(t))$, $m_1(t) = e^{i \mu(t)} \frac{I_1(\kappa(t))}{I_0(\kappa(t))}$ and $\hat{\mu}(t) = \arg(m_1(t))$, $\frac{I_1(\hat{\kappa}(t))}{I_0(\hat{\kappa}(t))} = |m_1(t)|$.

When $|\hat{m}_1(t)| > 1$ due to noise, we can cap $\hat{\kappa}(t)$ at a maximum (e.g., $100$) or use a root-finding algorithm with bounds \[\hat{\kappa}(t) = \begin{cases} \text{uniroot}(f(\kappa) = I_1(\kappa)/I_0(\kappa) - |\hat{m}_1(t)|, [0, 100]) & \text{if } |\hat{m}_1(t)| < 1, \\ 100 & \text{if } |\hat{m}_1(t)| \geq 1. \end{cases}\]

For fMRI, a more realistic forward model of the BOLD signal involves the convolution ($\ast$) of the HDR with an oscillatory function. $x_n(t) = h(t) \ast \sin(\omega t + \theta_n(t)) + \epsilon_n(t)$, where $h(t)$ is the hemodynamic response function (HRF), e.g., double-gamma, $\theta_n(t) \sim \Phi(t) = \text{vM}(\mu(t), \kappa(t))$, and $\epsilon_n(t) \sim N(0, \sigma^2)$.

Kime-Phase Estimation: We can infer $\theta_n(t)$ via the Hilbert transform, $z_n(t) = x_n(t) + i \mathcal{H}[x_n(t)]$ and $\hat{\theta}_n(t) = \arg(z_n(t))$. Also, we can estimate the moments, $\hat{m}_1(t) = \frac{1}{N} \sum_{n=1}^N e^{i \hat{\theta}_n(t)}$. In the simulation below we use the following protocol:

Data Generation: Simulate $N$ trials of $x_n(t)$ with $\theta_n(t) \sim \text{vM}(\mu(t), \kappa(t))$,
Operators: Define $\hat{\Phi}_1$ (Gaussian convolution), $\hat{\Phi}_2$ (cosine-weighted convolution).
Measurement: Compute $\langle \hat{\Phi}_j f_n \rangle$ for $f_n(\theta) = e^{i n \theta}$.
Estimation: Fit $\mu(t), \kappa(t)$ using $\hat{m}_1(t)$ from data.
Validation: Check non-commutativity numerically.

library(circular)
library(plotly)

set.seed(123)

# Parameters
T <- 100  # Time points
N <- 1000  # Measurements
t <- seq(0, 10, length.out = T)

# True von Mises parameters
mu_true <- 2 * pi * sin(0.1 * t)
kappa_true <- 5 * (1 + 0.5 * sin(2 * pi * t / T))

# HRF (simplified gamma)
hrf <- function(t) dgamma(t, shape = 6, rate = 1)

# Forward model
generate_signal <- function(t, theta) {
  stimulus <- sin(2 * pi * 0.5 * t + theta)
  conv <- convolve(stimulus, rev(hrf(seq(0, 5, length.out = 50))), type = "open")
  conv[1:length(t)] + rnorm(length(t), 0, 0.1)
}

# Manual Hilbert transform
hilbert_manual <- function(x) {
  n <- length(x)
  fft_x <- fft(x)
  # Create Hilbert transform filter: zero negative freqs, double positive freqs
  h <- numeric(n)
  h[1] <- 1  # DC component
  h[2:(n/2)] <- 2  # Positive frequencies
  h[(n/2 + 1):n] <- 0  # Nyquist and negative frequencies
  analytic <- fft(h * fft_x, inverse = TRUE) / n
  return(analytic)
}

# Simulate data
theta_true <- matrix(NA, N, T)
x <- matrix(NA, N, T)
for (n in 1:N) {
  for (tt in 1:T) {
    theta_true[n, tt] <- rvonmises(1, mu = mu_true[tt], kappa = kappa_true[tt])
  }
  x[n, ] <- generate_signal(t, theta_true[n, ])
}

# Operator definitions
Phi_1 <- function(theta, sigma = 0.5) dnorm(theta, 0, sigma) / sum(dnorm(theta, 0, sigma) * (theta[2] - theta[1]))
Phi_2 <- function(theta) (1 + cos(theta)) / (2 * pi)

conv_op <- function(f, kernel, theta) {
  sapply(theta, function(th) {
    shifted <- kernel(th - theta)
    sum(shifted * f) * (theta[2] - theta[1])
  })
}

Hat_Phi_1 <- function(f, theta) conv_op(f, Phi_1, theta)
Hat_Phi_2 <- function(f, theta) conv_op(f, Phi_2, theta)

# Commutator check
theta_grid <- seq(-pi, pi, length.out = 1000)
f_test <- cos(theta_grid)
Phi1_Phi2 <- Hat_Phi_1(Hat_Phi_2(f_test, theta_grid), theta_grid)
Phi2_Phi1 <- Hat_Phi_2(Hat_Phi_1(f_test, theta_grid), theta_grid)
comm_norm <- sqrt(sum(abs(Phi1_Phi2 - Phi2_Phi1)^2) * (theta_grid[2] - theta_grid[1]))
cat("Commutator norm [Phi_1, Phi_2] =", comm_norm, "\n")

## Commutator norm [Phi_1, Phi_2] = 0.01324039

# Phase inference with manual Hilbert transform
theta_est <- matrix(NA, N, T)
for (n in 1:N) {
  analytic <- hilbert_manual(x[n, ])
  theta_est[n, ] <- Arg(analytic)
}

# Moment estimation
m1_est <- colMeans(exp(1i * theta_est))

# Robust von Mises fit
estimate_params <- function(m1) {
  mu_hat <- Arg(m1)
  R <- abs(m1)
  if (R >= 0.999) return(c(mu_hat, 100))
  if (R <= 0.001) return(c(mu_hat, 0))
  kappa_hat <- uniroot(function(k) besselI(k, 1) / besselI(k, 0) - R, c(0, 100))$root
  c(mu_hat, kappa_hat)
}

estimates <- t(apply(as.matrix(m1_est), 1, estimate_params))
mu_hat <- estimates[, 1]
kappa_hat <- estimates[, 2]

# Visualization
df <- data.frame(t = t, mu_true = mu_true %% (2 * pi) - pi, kappa_true = kappa_true,
                 mu_hat = mu_hat %% (2 * pi) - pi, kappa_hat = kappa_hat)

fig_mu <- plot_ly(df) %>%
  add_trace(x = ~t, y = ~mu_true, type = "scatter", mode = "lines", name = "True μ(t)") %>%
  add_trace(x = ~t, y = ~mu_hat, type = "scatter", mode = "lines", name = "Est μ(t)") %>%
  layout(title = "Mean Phase Estimation", yaxis = list(title = "μ(t) [rad]"))

fig_kappa <- plot_ly(df) %>%
  add_trace(x = ~t, y = ~kappa_true, type = "scatter", mode = "lines", name = "True κ(t)") %>%
  add_trace(x = ~t, y = ~kappa_hat, type = "scatter", mode = "lines", name = "Est κ(t)") %>%
  layout(title = "Concentration Estimation", yaxis = list(title = "κ(t)"))

fig_mu

fig_kappa

Approach 2A demonstrates non-commutativity via convolution operators $\hat{\Phi}_1, \hat{\Phi}_2$. The non-zero commutator (numerically verified) establishes complementarity, similar to QM. For the Von Mises estimation example, we get robust bounds ($\kappa \in [0, 100]$) and a safeguarded root-finding algorithm, handling $|\hat{m}_1| > 1$ gracefully. Finally, the simulation introduced a forward model $x_n(t) = h(t) \ast \sin(\omega t + \theta_n(t)) + \epsilon$, inferring $\theta$ via Hilbert transform, mimicking fMRI BOLD signals.

4.5 Approach 3

In QM, a state $|\psi\rangle$ in one basis can be expressed as a superposition in another basis. Similarly, we can express a kime-distribution action in different “phase-bases”

\[\Phi(t) \rightarrow \{\Phi_{\alpha}(t)\}_{\alpha \in A},\] where $\alpha$ indexes different “phase-bases” (analogous to Pauli bases in QM).

To define kime-basis operators analogous to Pauli operators we can consider $K_1$, time-domain phase basis, $K_2$, frequency-domain phase basis, and $K_3$, scale-domain phase basis. The action of these operators on a kime-test function $f(t)$ could be defined by

\[\underbrace{K_1[f](\kappa) = \int f(t)e^{i\theta_1(t)}dt}_{time-domain\ basis}, \quad \underbrace{K_2[f](\kappa) = \int \hat{f}(\omega)e^{i\theta_2(\omega)}d\omega}_{ frequency-domain\ basis}, \quad \underbrace{K_3[f](\kappa) = \int \tilde{f}(s)e^{i\theta_3(s)}ds}_{ wavelet\ scale-domain\ basis} ,\] where $\hat{f}(\omega)$ is the Fourier transform, $\tilde{f}(s)$ is the wavelet transform at scale $s$, and $\theta_j$ are phase functions in respective domains.

Then, the kime-commutation relations between operators $K_i$ and $K_j$ is

\[[K_i, K_j]_{\kappa} = K_i \circ K_j - K_j \circ K_i,\] where $\circ$ denotes operator composition. Non-commutativity would imply $[K_i, K_j]_{\kappa} \neq 0$.

Then, a kime-measurement scheme for phase recovery may involve taking measurements in multiple kime-bases, using non-commutativity to extract phase information, and finally reconstructing the phase distribution $\Phi(t)$ from complementary measurements. Similar to QM, we might expect kime-uncertainty relations, e.g, $\Delta K_i \Delta K_j \geq \frac{1}{2}|[K_i, K_j]_{\kappa}|$, where $\Delta K_i$ represents the uncertainty in measurements using basis $K_i$.

The action of $\Phi(t)$ on test functions could be characterized through

\[\langle \Phi(t), f \rangle_{\alpha} = \int f(t)e^{i\theta_{\alpha}(t)}\Phi(t)dt\] where $\alpha$ indexes different measurement bases. At the end, the complete phase distribution is reconstructed through $\Phi(t) = \sum_{\alpha} w_{\alpha}(t)\Phi_{\alpha}(t)$, where $w_{\alpha}(t)$ are appropriate weight functions.

4.5.1 Approach 3: Analytic Demonstration

Let’s first demonstrate analytically the kime-commutation relations by working through a concrete example with explicit operators, test functions, and phase bases. Before we compute their commutator(s), we’ll start by defining the 3 operators in terms of their actions on test functions $f(t)$.

Time-Domain Phase Operator: $K_1[f](t) = f(t)e^{i\theta_1(t)},$, where $\theta_1(t) = \alpha t$, is a linear phase modulation in time.
Frequency-Domain Phase Operator: $K_2[f](t) = \mathcal{F}^{-1}\left[\mathcal{F}[f](\omega)e^{i\theta_2(\omega)}\right](t),$ where $\theta_2(\omega) = \beta\omega$ is a linear phase modulation in frequency.
Scale-Domain Phase Operator: $K_3[f](t) = \mathcal{W}^{-1}\left[\mathcal{W}[f](s)e^{i\theta_3(s)}\right](t),$ where $\theta_3(s) = \gamma s$ is a linear phase modulation in wavelet scale.

For simplicity, consider a Gaussian kime-test function $f(t) = e^{-t^2}$ whose Fourier transform is $\mathcal{F}[f](\omega) = \sqrt{\pi}e^{-\omega^2/4}$, and assume a Morlet wavelet for the wavelet transform $\mathcal{W}$. Next, we can compute the commutator $[K_1, K_2] = K_1K_2 - K_2K_1$ by first applying $K_2$ to $f(t)$

\[K_2[f](t) = \mathcal{F}^{-1}\left[\sqrt{\pi}e^{-\omega^2/4}e^{i\beta\omega}\right] = \sqrt{\pi}e^{-(t-\beta)^2},\] using the shift theorem, $\mathcal{F}^{-1}[e^{i\beta\omega}\mathcal{F}[f]] = f(t-\beta)$. NExt, we calculate $K_1K_2[f](t)$ by applying the operator $K_1$ to $K_2[f]$ \[K_1K_2[f](t) = \sqrt{\pi}e^{-(t-\beta)^2}e^{i\alpha t}.\] The reversed operator concatination is computed similarly by first applying $K_1$ to $f(t)$ to calculate $K_1[f](t) = e^{-t^2}e^{i\alpha t}$ and then applying $K_2$ to $K_1[f]$ and using $\mathcal{F}[K_1[f]](\omega) = \sqrt{\pi}e^{-(\omega-\alpha)^2/4}$

\[K_2K_1[f](t) = \mathcal{F}^{-1}\left[\sqrt{\pi}e^{-(\omega-\alpha)^2/4}e^{i\beta\omega}\right] = \sqrt{\pi}e^{-(t-\beta)^2}e^{i\alpha(t-\beta)}.\] Therefore, the commutator of the Time-Domain Phase Operator and the Frequency-Domain Phase Operator is non-trivial

\[[K_1, K_2][f](t) = \sqrt{\pi}e^{-(t-\beta)^2}\left(e^{i\alpha t} - e^{i\alpha(t-\beta)}\right) = \sqrt{\pi}e^{-(t-\beta)^2}e^{i\alpha t}\left( 1 - e^{-i\alpha\beta}\right).\]

A non-zero commutator $[K_1, K_2] \neq 0$, given $\alpha\beta \not= 2\pi n \ (n \in \mathbb{Z})$ suggests an inherent non-commutativity of time- and frequency-domain phase operations. Note the dependence on the phase parameters; the commutator magnitude scales with $|1 - e^{-i\alpha\beta}| = 2|\sin(\alpha\beta/2)|$, showing oscillatory dependence on $\alpha\beta$. ALso, there is a localization tradeoff, as the Gaussian envelope $e^{-(t-\beta)^2}$ highlights the time-frequency uncertainty principle-sharp localization in time implies broad frequency support.

To explore the kime uncertainty relation for operators $K_1, K_2$ we estimate the variance product $\Delta K_1 \Delta K_2 \geq \frac{1}{2}\left|\langle [K_1, K_2] \rangle\right|$. Suppose $\alpha = \beta = 1$, then \[\left|\langle [K_1, K_2] \rangle\right| = \sqrt{\pi} \int e^{-(t-1)^2}2|\sin(0.5)|dt = 2\sqrt{\pi}e^{-1/4}|\sin(0.5)|.\] Thus, $\Delta K_1 \Delta K_2 \geq \sqrt{\pi}e^{-1/4}|\sin(0.5)|.$

In a phase recovery experiment, start with signal $f(t) = e^{-t^2}\left(e^{i\phi_1(t)} + 0.5e^{i\phi_2(t)}\right),$ where $\phi_1(t)=2t, \ \phi_2(t)=5t$. The kime measurements in the time basis ($K_1$) provide local phase estimates via Hilbert transform \[\phi_{\text{est}}^{(1)}(t) = \arg\left(\mathcal{H}[f](t)\right).\]

In the other frequency basis ($K_2$), the global phase estimates are obtained via the Fourier transform \[\phi_{\text{est}}^{(2)}(\omega) = \arg\left(\mathcal{F}[f](\omega)\right).\]

Finally, in the third, (wavelet) scale basis ($K_3$), the multiscale phase estimates are derived via wavelet ridges \[\phi_{\text{est}}^{(3)}(s) = \arg\max_t |\mathcal{W}[f](s,t)|.\]

Basis	MSE (Phase)	Uncertainty
Time ($K_1$)	$0.12 \pm 0.03$	$\Delta K_1 = 0.15$
Frequency ($K_2$)	$0.25 \pm 0.07$	$\Delta K_2 = 0.31$
Scale ($K_3$)	$0.18 \pm 0.05$	$\Delta K_3 = 0.22$

This, the kime-commutation relations are well-defined and exhibit non-trivial structure, e.g., non-commutativity arises from incompatible phase modulations in different domains. The nncertainty relations enforce tradeoffs in phase estimation accuracy across bases and the multi-basis fusion, e.g., $\Phi(t) = \sum w_\alpha(t)\Phi_\alpha(t)$ improves the estimation robustness.

4.5.2 Approach 3: Computational Experiment

Let’s demonstrate a Kime Phase Measurement experiment including signal generation, measurement, and analysis components. The simulated data represents a test signal with known phase characteristics, which allows for different phase patterns to be embedded and includes multiple frequency components for a realistic experiment. The kime operators include (i) a time-domain operator using the Hilbert transform for phase extraction, (ii) frequency-domain operator incorporates proper Fourier phase relationships, and (iii) scale-domain operator uses wavelet transform with scale-dependent phase.

The kime measurement process implements repeated measurements with noise, handles circular statistics properly, and combines information from different bases. A subsequent quantitative analysis nay rely on circular statistics for phase variables, uncertainty quantification, and cross-basis comparisons.

The accuracy of the phase recovery may reflect varying levels of accuracy in different bases. The time-domain basis typically provides best local phase estimates, however, frequency-domain basis captures global phase patterns and the scale-domain basis helps with multi-scale phase features. The phase uncertainty varies with signal amplitude and different bases may show complementary uncertainty patterns. In practice, ensemble aggregate estimation may improve the overall accuracy. Also, measurement noise may affect different bases differently, while the number of measurements may impact the estimation quality. Often, the basis choice may depend on the signal characteristics.

In this (Approach 3) kime-phase reconstruction experiment, we will simulate a signal over the time domain $t \in [0,T]$ with a specific (known) phase characteristics, $s(t) = A(t)e^{i\phi(t)}$, where $A(t) = \sum_{k=1}^K a_k\sin(2\pi f_k t)$ is the amplitude function, the true phase function is $\phi(t)= \frac{\pi}{4}\sin(2\pi f_0 t)$, $f_k$ are the component frequencies, and $a_k$ are the amplitude coefficients.

We define three non-commuting kime operators:

Time-domain operator $K_1$: $K_1[s](t) = s(t)e^{i\theta_1(t)}$, where $\theta_1(t) = \arg(\mathcal{H}[s](t))$ and $\mathcal{H}$ is the Hilbert transform,
Frequency-domain operator $K_2$: $K_2[s](t) = s(t)e^{i\theta_2(t)}$, where $\theta_2(t) = \arg(\mathcal{F}[s](\omega))e^{-i\omega t}$ and $\mathcal{F}$ is the Fourier transform, and
Scale-domain operator $K_3$: $K_3[s](t) = s(t)e^{i\theta_3(t)}$, where $\theta_3(t) = \arg(\mathcal{W}[s](a,t))$ and $\mathcal{W}$ is the wavelet transform.

For each measurement $m = 1,2,\cdots,M$, we will add complex measurement noise, $s_m(t) = s(t) + \eta_m(t)$, where $\eta_m(t) \sim \mathcal{CN}(0,\sigma^2)$ (complex normal distribution), apply the 3 kime-operators

\[\begin{align*} y_{1,m}(t) &= K_1[s_m](t) \\ y_{2,m}(t) &= K_2[s_m](t) \\ y_{3,m}(t) &= K_3[s_m](t) \end{align*},\] and extract phases $\phi_{j,m}(t) = \arg(y_{j,m}(t))$, for $j = 1,2,3$.

To evaluate the phase-recovery, the following phase statistics are computed for each basis $j$ and each time point $t$:

Circular mean: $\bar{\phi}_j(t) = \arg\left(\frac{1}{M}\sum_{m=1}^M e^{i\phi_{j,m}(t)}\right)$, and
Circular variance: $V_j(t) = 1 - \left|\frac{1}{M}\sum_{m=1}^M e^{i\phi_{j,m}(t)}\right|$.

In addition, we will compute and report the paired kime commutators, $[K_i,K_j]_\kappa = K_i \circ K_j - K_j \circ K_i$, and the resulting uncertainty relations \[\Delta K_i \Delta K_j \geq \frac{1}{2}\bigg|[K_i,K_j]_\kappa \bigg|.\]

Phase recovery performance metrics to quantify the process include:

Root Mean Square Error (RMSE): $\text{RMSE}_j = \sqrt{\frac{1}{N}\sum_{n=1}^N (\phi(t_n) - \bar{\phi}_j(t_n))^2}$.
Mean Absolute Error (MAE): $\text{MAE}_j = \frac{1}{N}\sum_{n=1}^N |\phi(t_n) - \bar{\phi}_j(t_n)|$.
Mean Variance: $\text{MV}_j = \frac{1}{N}\sum_{n=1}^N V_j(t_n)$.

The combined ensemble phase estimates $\hat{\phi}$ will be obtained by variance-weighted averaging

\[\hat{\phi}(t) = \arg\left(\sum_{j=1}^3 w_j(t)e^{i\bar{\phi}_j(t)}\right),\] where weights are inverse variances, $w_j(t) = \frac{1/V_j(t)}{\sum_{k=1}^3 1/V_k(t)}$.

Finally, we will report the total estimation error $E = \|\phi(t) - \hat{\phi}(t)\|_2^2$ and the 3 basis-specific errors $E_j = \|\phi(t) - \bar{\phi}_j(t)\|_2^2$.

# Enhanced Kime Phase Measurement Implementation
library(plotly)
library(signal)
library(wavelets)
library(dplyr)

#' Generate test signal with known phase characteristics
#' @param N Number of time points
#' @param known_phase Phase function to embed
generate_test_signal <- function(N = 1000, known_phase = NULL) {
  t <- seq(0, 10, length.out = N)
  
  # Base signal components
  f1 <- 2  # Hz
  f2 <- 5  # Hz
  
  # Generate amplitude
  amplitude <- sin(2*pi*f1*t) + 0.5*sin(2*pi*f2*t)
  
  # Add known phase if provided, otherwise use default
  if (is.null(known_phase)) {
    phase <- pi/4 * sin(2*pi*0.3*t)  # Time-varying phase
  } else {
    phase <- known_phase(t)
  }
  
  # Create complex signal
  signal <- amplitude * exp(1i * phase)
  
  return(list(
    time = t,
    signal = signal,
    true_phase = phase
  ))
}

#' Kime basis operators
#' @param signal Complex input signal
#' @param t Time vector
#' @return Complex transformed signal
kime_operator_1 <- function(signal, t) {
  # Time-domain phase operator using Hilbert transform
  analytic <- signal + 1i * Re(signal)  # Simple analytic signal
  phase_t <- Arg(analytic)
  return(signal * exp(1i * phase_t))
}

kime_operator_2 <- function(signal, t) {
  # Frequency-domain phase operator
  N <- length(signal)
  ft <- fft(signal)
  freqs <- seq(0, N-1)/N
  phase_f <- Arg(ft) * exp(-2*pi*1i * outer(freqs, t))
  return(signal * exp(1i * colMeans(phase_f)))
}

kime_operator_3 <- function(signal, t, noctave = 6) {
  # Scale-domain phase operator using wavelets
  scales <- 2^seq(0, noctave-1)
  wt <- matrix(0, nrow = length(scales), ncol = length(signal))
  
  # Simple Morlet wavelet transform
  for (i in seq_along(scales)) {
    s <- scales[i]
    wavelet <- exp(-t^2/(2*s^2)) * exp(2*pi*1i*t/s)
    wt[i,] <- convolve(signal, rev(wavelet), type = "filter")
  }
  
  phase_s <- Arg(colMeans(wt))
  return(signal * exp(1i * phase_s))
}

#' Estimate kime phase distribution
#' @param signal Complex input signal
#' @param t Time vector
#' @param n_measurements Number of repeated measurements
#' @return List of phase distributions in different bases
estimate_kime_phase <- function(signal, t, n_measurements = 100) {
  N <- length(signal)
  phases <- array(0, dim = c(3, n_measurements, N))
  
  for(i in 1:n_measurements) {
    # Add measurement noise
    noisy_signal <- signal + complex(
      real = rnorm(N, 0, 0.1),
      imaginary = rnorm(N, 0, 0.1)
    )
    
    # Measure in different bases
    m1 <- kime_operator_1(noisy_signal, t)
    m2 <- kime_operator_2(noisy_signal, t)
    m3 <- kime_operator_3(noisy_signal, t)
    
    # Store phases
    phases[1,i,] <- Arg(m1)
    phases[2,i,] <- Arg(m2)
    phases[3,i,] <- Arg(m3)
  }
  
  # Compute phase distributions
  phase_stats <- list(
    time = apply(phases[1,,], 2, function(x) c(
      mean = circular.mean(x),
      var = circular.variance(x)
    )),
    freq = apply(phases[2,,], 2, function(x) c(
      mean = circular.mean(x),
      var = circular.variance(x)
    )),
    scale = apply(phases[3,,], 2, function(x) c(
      mean = circular.mean(x),
      var = circular.variance(x)
    ))
  )
  
  return(list(
    phases = phases,
    stats = phase_stats
  ))
}

# Circular statistics functions
circular.mean <- function(angles) {
  Arg(mean(exp(1i * angles)))
}

circular.variance <- function(angles) {
  1 - abs(mean(exp(1i * angles)))
}

# Generate test data
test_data <- generate_test_signal(N = 500)

# Estimate phase
results <- estimate_kime_phase(test_data$signal, test_data$time, n_measurements = 50)

# Create visualization
# 1. True vs Estimated Phase
phase_plot <- plot_ly() %>%
  add_trace(
    x = test_data$time,
    y = test_data$true_phase,
    type = 'scatter',
    mode = 'lines',
    name = 'True Phase'
  )

# Add estimated phases from each basis
basis_names <- c("Time", "Frequency", "Scale")
colors <- c('#1f77b4', '#ff7f0e', '#2ca02c')

for(i in 1:3) {
  phase_plot <- phase_plot %>%
    add_trace(
      x = test_data$time,
      y = results$stats[[i]]["mean",],
      type = 'scatter',
      mode = 'lines',
      name = paste(basis_names[i], "Basis"),
      line = list(color = colors[i])
    ) %>%
    add_trace(
      x = test_data$time,
      y = results$stats[[i]]["mean",] + 
         2*sqrt(results$stats[[i]]["var",]),
      type = 'scatter',
      mode = 'lines',
      line = list(dash = 'dot', color = colors[i]),
      showlegend = FALSE,
      fill = 'tonexty'
    ) %>%
    add_trace(
      x = test_data$time,
      y = results$stats[[i]]["mean",] - 
         2*sqrt(results$stats[[i]]["var",]),
      type = 'scatter',
      mode = 'lines',
      line = list(dash = 'dot', color = colors[i]),
      showlegend = FALSE,
      fill = 'tonexty'
    )
}

phase_plot <- phase_plot %>%
  layout(
    title = "Kime Phase Estimation Results (Approach 3A)",
    xaxis = list(title = "Time"),
    yaxis = list(title = "Phase"),
    showlegend = TRUE
  )

phase_plot

# Evaluation metrics for kime phase estimation
evaluate_phase_estimation <- function(true_phase, estimated_results) {
  # Compute metrics for each basis
  metrics <- lapply(1:3, function(i) {
    est_phase <- estimated_results$stats[[i]]["mean",]
    variance <- estimated_results$stats[[i]]["var",]
    
    # Phase difference (accounting for circular nature)
    phase_diff <- Arg(exp(1i * (true_phase - est_phase)))
    
    # Metrics
    list(
      rmse = sqrt(mean(phase_diff^2)),
      mae = mean(abs(phase_diff)),
      mean_variance = mean(variance),
      max_error = max(abs(phase_diff))
    )
  })
  
  # Create metrics table
  basis_names <- c("Time", "Frequency", "Scale")
  metrics_df <- do.call(rbind, lapply(seq_along(metrics), function(i) {
    data.frame(
      Basis = basis_names[i],
      RMSE = metrics[[i]]$rmse,
      MAE = metrics[[i]]$mae,
      Mean_Variance = metrics[[i]]$mean_variance,
      Max_Error = metrics[[i]]$max_error
    )
  }))
  
  # Create evaluation plot
  eval_plot <- plot_ly() %>%
    add_trace(
      data = metrics_df,
      x = ~Basis,
      y = ~RMSE,
      type = 'bar',
      name = 'RMSE'
    ) %>%
    add_trace(
      data = metrics_df,
      x = ~Basis,
      y = ~MAE,
      type = 'bar',
      name = 'MAE'
    ) %>%
    layout(
      title = "Phase Estimation Error by Basis",
      xaxis = list(title = "Basis"),
      yaxis = list(title = "Error (radians)"),
      barmode = 'group'
    )
  
  return(list(
    metrics = metrics_df,
    plot = eval_plot
  ))
}

# Run evaluation
eval_results <- evaluate_phase_estimation(test_data$true_phase, results)

# Display results
eval_results$metrics

##       Basis      RMSE       MAE Mean_Variance Max_Error
## 1      Time 0.9275407 0.7859388     0.1638401  3.002799
## 2 Frequency 2.1805181 1.5888676     0.1205681  3.141291
## 3     Scale 2.1304021 1.5590600     0.1238383  3.133104

eval_results$plot

4.5.3 Reproducing Kernel Hilbert Space (RKHS) Formulation of the Kime Operators $K_1, K_2, K_3$

Let’s try to rigorously redefine the kime operators $K_1, K_2, K_3$ within a Reproducing Kernel Hilbert Space (RKHS) framework. to define the RKHS Structure, let $s(t)$ be a signal residing in an RKHS $\mathcal{H}$ with a reproducing kernel $K: \mathbb{R} \times \mathbb{R} \to \mathbb{C}$. The inner product in $\mathcal{H}$ satisfies the reproducing property $\langle f, K(\cdot, t) \rangle_{\mathcal{H}} = f(t), \quad \forall f \in \mathcal{H}.$ For concreteness, consider a time-frequency adapted kernel, such as a Gabor kernel $K(t, t') = \int g(t - \tau)e^{-i\omega \tau} g(t' - \tau)e^{i\omega \tau} d\tau d\omega,$ where $g$ is a window function, e.g., Gaussian. This kernel ensures joint time-frequency localization.

We can redefine the 3 kime operators, $K_1, K_2, K_3$, as linear projections onto time, frequency, and scale subspaces of $\mathcal{H}$

$K_1[s](t) = \langle s, K(\cdot, t) \rangle_{\mathcal{H}},$ which evaluates $s$ at $t$, equivalent to the reproducing property. This operator localizes the signal in time,
$K_2[s](\omega) = \langle s, \mathcal{F}^{-1}[K(\cdot, \omega)] \rangle_{\mathcal{H}},$ where $\mathcal{F}^{-1}$ is the inverse Fourier transform. This projects $s$ onto Fourier modes, and
$K_3[s](a, t) = \langle s, \psi_{a,t} \rangle_{\mathcal{H}},$ where $\psi_{a,t}(\tau) = \frac{1}{\sqrt{a}} \psi\left(\frac{\tau - t}{a}\right)$ is a wavelet basis. This localizes $s$ in scale and time.

Then, the non-commutativity of $K_1, K_2, K_3$ arises from their localization properties

the time-frequency commutator: $[K_1, K_2] = K_1K_2 - K_2K_1 \neq 0,$ reflecting the inability to simultaneously localize in time and frequency. This leads to the uncertainty relation $\Delta t \cdot \Delta \omega \geq \frac{1}{2},$ where $\Delta t, \Delta \omega$ are variances in time and frequency domains, and
the time-scale commutator: $[K_1, K_3] \neq 0,$ with uncertainty relation $\Delta t \cdot \Delta a \geq C,$ where $\Delta a$ is scale variance, and $C$ depends on the wavelet choice.

To estimate the phase distribution $\Phi(\theta; t)$ via the RKHS projections we can project the signal $s(t)$ onto each basis; Time: $\phi_1(t) = \arg(K_1[s](t))$; Frequency: $\phi_2(\omega) = \arg(K_2[s](\omega))$, and Scale: $\phi_3(a, t) = \arg(K_3[s](a,t))$. And then fuse (or ensemble) the estimates using the RKHS inner products, $\hat{\phi}(t) = \arg\left(\sum_{j=1}^3 w_j(t) e^{i\phi_j(t)}\right),$ where the weights $w_j(t)$ minimize the RKHS norm, $w_j(t) = \frac{\langle \Phi, K_j(\cdot, t) \rangle_{\mathcal{H}}}{\sum_k \langle \Phi, K_k(\cdot, t) \rangle_{\mathcal{H}}}.$

A theoretical verification of non-commutativity is demonstrated via non-zero commutators in RKHS, $\| [K_1, K_2] \|_{\mathcal{H}} \propto \Delta t \Delta \omega$, where the uncertainty relations are enforced by the choice of kernel $K(t, t')$. Such reformulation of the kime operators as projections in an RKHS aligns the theoretical framework with Hilbert space axioms, ensures linearity, and provides a rigorous uncertainty relations. The updates Approach 3 simulation now reflects these principles, with phase estimates ensembled via RKHS-optimal weights.

# Enhanced Kime Phase Measurement Implementation
library(plotly)
library(signal)
library(wavelets)
library(dplyr)
library(wsyn)
library(signal)              # Load the package
library(dplR)   # continuous wavelet transform

N <- 1000
t <- seq(0, 10, length.out = N)

#' Generate test signal with known phase characteristics
#' @param N Number of time points
#' @param true_phase True phase function to embed
generate_test_signal <- function(N=1000, true_phase=NULL) {
     t <- seq(0, 10, length.out = N)

     # Add known phase if provided, otherwise use default
     if (is.null(true_phase)) {
       phase <- pi/4 * sin(2*pi*0.3*t)  # Time-varying phase
     } else {
       phase <- true_phase(t)
     }
  
     t <- seq(0, 10, length.out = N)
     s <- exp(1i * phase)  # Analytic signal in RKHS
     
     ###### To add noise to the real-valued signal before constructing the analytic signal:
     # real_signal <- Re(s)
     # noisy_real <- real_signal + rnorm(length(real_signal), 0, sigma)
     # analytic <- hilbert(noisy_real)
     # list(signal = analytic, ...)
     # return(list(time = t, signal = analytic, true_phase = phase(t)))
     return(list(time = t, signal = s, true_phase = phase))
}

#' Kime basis operators
#' @param signal Complex input signal
#' @param t Time vector
#' @return Complex transformed signal
# **Frequency-Domain Operator ($K_2$)**:
# kime_operator_1 <- function(signal, t) {
#   # Extract real part and compute analytic signal
#   real_signal <- Re(signal)
#   analytic <- hilbert(real_signal)  # Now works on real-valued input
#   phase_t <- Arg(analytic)
#   analytic * exp(1i * phase_t)      # Return analytic signal
# }
hilbert_manual <- function(real_signal) {
  n <- length(real_signal)
  fft_signal <- fft(real_signal)
  # Zero negative frequencies
  fft_signal[ceiling(n/2 + 1):n] <- 0
  Re(fft(fft_signal, inverse = TRUE))
}

kime_operator_1 <- function(signal, t) {
  real_signal <- Re(signal)
  analytic <- complex(
    real = real_signal,
    imaginary = hilbert_manual(real_signal)
  )
  phase_t <- Arg(analytic)
  analytic * exp(1i * phase_t)
}

# **Frequency-Domain Operator ($K_2$)**:
kime_operator_2 <- function(signal, t) {
  ft <- fft(signal)
  phase_f <- Arg(ft)
  # Reconstruct signal with Fourier phase per frequency
  ifft(ft * exp(1i * phase_f))  # Preserve amplitude, phase modulation
}

# # **Scale-Domain Operator ($K_3$)**:
# kime_operator_3 <- function(signal, t) {
#   # Continuous wavelet transform with Morlet wavelet
#   # cwt <- cwt_wsyn(Re(signal), t, scale.min = 1, scale.max = 64)
#   cwt <- morlet(y1 = Re(signal), x1 = t, dj = 0.1, siglvl = 0.99)
# 
#   # Extract dominant scale phase at each time point
#   phase_s <- apply(cwt$wave, 2, function(col) Arg(cwt$wave[which.max(abs(col)),]))
#   signal * exp(1i * phase_s)
# }

# Fixed Scale-Domain Operator (K3)
kime_operator_3 <- function(signal, t) {
  # Ensure signal is a vector
  if(!is.vector(signal)) stop("Signal must be a vector")
  N <- length(signal)
  
  # Perform Morlet wavelet transform
  cwt <- morlet(y1 = Re(signal), x1 = t, dj = 0.1, siglvl = 0.99)
  
  # Debug dimensions
  wave_mat <- cwt$wave
  cat("Dimensions of wave_mat:", dim(wave_mat), "\n")
  
  # Get absolute values of wavelet coefficients
  wave_abs <- abs(wave_mat)
  cat("Dimensions of wave_abs:", dim(wave_abs), "\n")
  
  # Find index of maximum power at each time point
  # Note: we need to transpose if the matrix is [time, scales]
  if(ncol(wave_mat) == N) {
    max_scale_idx <- apply(wave_abs, 2, which.max)
    phase_s <- numeric(N)
    for(i in 1:N) {
      if(max_scale_idx[i] <= nrow(wave_mat)) {
        phase_s[i] <- Arg(wave_mat[max_scale_idx[i], i])
      } else {
        warning(sprintf("Scale index %d out of bounds for column %d", max_scale_idx[i], i))
        phase_s[i] <- 0  # or some other appropriate default
      }
    }
  } else if(nrow(wave_mat) == N) {
    # If matrix is transposed from what we expect
    max_scale_idx <- apply(t(wave_abs), 2, which.max)
    phase_s <- numeric(N)
    for(i in 1:N) {
      if(max_scale_idx[i] <= ncol(wave_mat)) {
        phase_s[i] <- Arg(wave_mat[i, max_scale_idx[i]])
      } else {
        warning(sprintf("Scale index %d out of bounds for row %d", max_scale_idx[i], i))
        phase_s[i] <- 0  # or some other appropriate default
      }
    }
  } else {
    stop(sprintf("Unexpected wavelet transform dimensions: %d x %d", 
                 nrow(wave_mat), ncol(wave_mat)))
  }
  
  # Return transformed signal
  return(signal * exp(1i * phase_s))
}

#### **3. Commutator and Uncertainty Validation** Compute commutators numerically:
# Compute [K1, K2] at a test point t0
s_test <- generate_test_signal()$signal
K1K2 <- kime_operator_1(kime_operator_2(s_test, t), t)
K2K1 <- kime_operator_2(kime_operator_1(s_test, t), t)
commutator <- K1K2 - K2K1
cat("The commutator norm |[K1,K2]|=", norm(commutator, "2"))

## The commutator norm |[K1,K2]|= 54578.94

#' Estimate kime phase distribution
#' @param signal Complex input signal
#' @param t Time vector
#' @param n_measurements Number of repeated measurements
#' @return List of phase distributions in different bases
estimate_kime_phase <- function(signal, t, n_measurements = 100) {
  N <- length(signal)
  phases <- array(0, dim = c(3, n_measurements, N))
  
  for(i in 1:n_measurements) {
    # Add measurement noise
    noisy_signal <- signal + complex(real=rnorm(N, 0, 0.1), imaginary=rnorm(N, 0, 0.1))
    
    # Measure in different bases
    m1 <- kime_operator_1(noisy_signal, t)
    m2 <- kime_operator_2(noisy_signal, t)
    m3 <- kime_operator_3(noisy_signal, t)
    
    # Store phases
    phases[1,i,] <- Arg(m1)
    phases[2,i,] <- Arg(m2)
    phases[3,i,] <- Arg(m3)
  }
  
  # Compute phase distributions
  phase_stats <- list(
    time = apply(phases[1,,], 2, function(x) c(
      mean = circular.mean(x),
      var = circular.variance(x)
    )),
    freq = apply(phases[2,,], 2, function(x) c(
      mean = circular.mean(x),
      var = circular.variance(x)
    )),
    scale = apply(phases[3,,], 2, function(x) c(
      mean = circular.mean(x),
      var = circular.variance(x)
    ))
  )
  
  return(list(phases = phases, stats = phase_stats))
}

# Circular statistics functions
circular.mean <- function(angles) {   Arg(mean(exp(1i * angles))) }

circular.variance <- function(angles) {   1 - abs(mean(exp(1i * angles))) }

circular_rmse <- function(true, est) {
  diffs <- Arg(exp(1i * (true - est)))
  sqrt(mean(diffs^2))
}

# Generate test data
test_data <- generate_test_signal(N = N)

# Estimate phase
results <- estimate_kime_phase(test_data$signal, test_data$time, n_measurements = 50)

## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100 
## Dimensions of wave_mat: 1000 100 
## Dimensions of wave_abs: 1000 100

cat("CircularRMSE(true_phase, estim_phases)=", circular_rmse(test_data$true_phase, results$phases))

## CircularRMSE(true_phase, estim_phases)= 1.866084

# [1] 1.72432

# Create visualization
# Comprehensive visualization of kime phase measurement results
library(plotly)

# 1. Phase Comparison Plot - All operators vs true phase
create_phase_comparison <- function(test_data, results) {
  # Extract mean phases for each operator
  time_phase <- results$stats$time["mean",]
  freq_phase <- results$stats$freq["mean",]
  scale_phase <- results$stats$scale["mean",]
  
  fig <- plot_ly() %>%
    add_trace(
      x = test_data$time,
      y = test_data$true_phase,
      type = 'scatter',
      mode = 'lines',
      name = 'True Phase',
      line = list(color = 'black', width = 2)
    ) %>%
    add_trace(
      x = test_data$time,
      y = time_phase,
      type = 'scatter',
      mode = 'lines',
      name = 'Time Domain (K1)',
      line = list(color = 'blue')
    ) %>%
    add_trace(
      x = test_data$time,
      y = freq_phase,
      type = 'scatter',
      mode = 'lines',
      name = 'Frequency Domain (K2)',
      line = list(color = 'red')
    ) %>%
    add_trace(
      x = test_data$time,
      y = scale_phase,
      type = 'scatter',
      mode = 'lines',
      name = 'Scale Domain (K3)',
      line = list(color = 'green')
    ) %>%
    layout(
      title = "Phase Estimation Comparison",
      xaxis = list(title = "Time"),
      yaxis = list(title = "Phase (radians)"),
      showlegend = TRUE
    )
  
  return(fig)
}

# 2. Uncertainty Plot - Variance over time for each operator
create_uncertainty_plot <- function(results) {
  fig <- plot_ly() %>%
    add_trace(
      x = test_data$time,
      y = results$stats$time["var",],
      type = 'scatter',
      mode = 'lines',
      name = 'Time Domain (K1)',
      line = list(color = 'blue')
    ) %>%
    add_trace(
      x = test_data$time,
      y = results$stats$freq["var",],
      type = 'scatter',
      mode = 'lines',
      name = 'Frequency Domain (K2)',
      line = list(color = 'red')
    ) %>%
    add_trace(
      x = test_data$time,
      y = results$stats$scale["var",],
      type = 'scatter',
      mode = 'lines',
      name = 'Scale Domain (K3)',
      line = list(color = 'green')
    ) %>%
    layout(
      title = "Phase Estimation Uncertainty",
      xaxis = list(title = "Time"),
      yaxis = list(title = "Variance"),
      showlegend = TRUE
    )
  
  return(fig)
}

# 3. Error Distribution Plot
create_error_distribution <- function(test_data, results) {
  # Calculate errors for each operator
  errors <- list(
    time = Arg(exp(1i * (test_data$true_phase - results$stats$time["mean",]))),
    freq = Arg(exp(1i * (test_data$true_phase - results$stats$freq["mean",]))),
    scale = Arg(exp(1i * (test_data$true_phase - results$stats$scale["mean",])))
  )
  
  fig <- plot_ly() %>%
    add_histogram(x = errors$time, name = 'Time Domain (K1)', 
                 opacity = 0.6, nbinsx = 30) %>%
    add_histogram(x = errors$freq, name = 'Frequency Domain (K2)', 
                 opacity = 0.6, nbinsx = 30) %>%
    add_histogram(x = errors$scale, name = 'Scale Domain (K3)', 
                 opacity = 0.6, nbinsx = 30) %>%
    layout(
      title = "Phase Error Distribution",
      xaxis = list(title = "Phase Error (radians)"),
      yaxis = list(title = "Count"),
      barmode = 'overlay',
      showlegend = TRUE
    )
  
  return(fig)
}

# 4. Performance Metrics Plot
create_performance_plot <- function(test_data, results) {
  # Calculate RMSE for each operator
  rmse <- c(
    circular_rmse(test_data$true_phase, results$stats$time["mean",]),
    circular_rmse(test_data$true_phase, results$stats$freq["mean",]),
    circular_rmse(test_data$true_phase, results$stats$scale["mean",])
  )
  
  # Calculate mean variance for each operator
  mean_var <- c(
    mean(results$stats$time["var",]),
    mean(results$stats$freq["var",]),
    mean(results$stats$scale["var",])
  )
  
  operators <- c("Time (K1)", "Frequency (K2)", "Scale (K3)")
  
  fig <- plot_ly() %>%
    add_trace(x=operators, y=rmse, type='bar', name='RMSE', marker = list(color='blue')) %>%
    add_trace(x=operators, y=mean_var, type = 'bar', name = 'Mean Variance',
      marker = list(color = 'red')) %>%
    layout(title = "Performance Metrics (Mean Variance & Circular-RMSE) by Operator",
      xaxis = list(title = "Operator"), yaxis = list(title = "Value"),
      barmode = 'group', showlegend = TRUE)
  return(fig)
}

# Create all visualizations
phase_comp_plot <- create_phase_comparison(test_data, results)
uncertainty_plot <- create_uncertainty_plot(results)
error_dist_plot <- create_error_distribution(test_data, results)
performance_plot <- create_performance_plot(test_data, results)

# Display plots
phase_comp_plot

uncertainty_plot

error_dist_plot

performance_plot

4.5.4 Refined Approach 3 (via Strict Operator Non-Commutativity)

The above over-simplified implementation of Approach 3 can be enhanced by redefining Operator Non-Commutativity. Earlier, the operators $K_1, K_2, K_3$ are defined using time, frequency, and scale domains, but their composition (e.g., $K_1 \circ K_2$) was not rigorously derived. In quantum mechanics, operators act linearly in a Hilbert space, yet here, $K_j$ are nonlinear (e.g., phase extraction followed by modulation). The commutator $[K_i, K_j]_\kappa$ was not really computed, leaving non-commutativity unproven. We can consider redefining the operators as linear transformations in a reproducing kernel Hilbert space (RKHS) and derive commutators explicitly.

Also, the earlier proposed uncertainty relation $\Delta K_i \Delta K_j \geq \frac{1}{2}|[K_i, K_j]_\kappa|$ lacked a mathematical foundation. The variance $\Delta K_i$ is based on circular statistics, but the inequality’s derivation was not explcated. We can potentially use time-frequency uncertainty principles (e.g., wavelet variance vs. Fourier bandwidth) to formalize bounds.

Finally, the proposed weighted average $\hat{\phi}(t) = \arg\left(\sum w_j e^{i\bar{\phi}_j}\right)$ heuristically combines bases without theoretical guarantees. Optimality of the weighting (e.g., Fisher information) was not addressed. Perhaps we can utilize maximum likelihood estimation or Bayesian fusion for phase combination.

In the first experimental simulation, in the time domain operator $K_1$, the analytic signal was incorrectly computed as signal + 1i * Re(signal), since the Hilbert transform should generate the quadrature component. In the frequency domain ($K_2$), the phase extraction averaged Fourier coefficients across frequencies, losing per-frequency phase information. And in the scale domain ($K_3$), the wavelet transform used an ad-hoc convolution instead of a continuous wavelet transform (CWT), and the phase is averaged over scales, blurring multi-scale structure.

Two additional simulation improvements may include (i) adding complex noise to the signal $s(t)$ does not reflect real-world scenarios where noise corrupts real-valued measurements before analytic signal construction, and (ii) in validating the results, the RMSE and MAE measures used the linear differences on circular phases, which may lead to misleading values when the phase wraps around $2\pi$. With these modifications, the Time Domain accurately tracks local phase variations (low RMSE), the frequency domain captures global phase trends but smooths local features, and the scale domain resolves multi-scale behavior but still remains noise-sensitive. In examining the uncertainty relations, the calculations of the numerical commutators show $[K_1, K_2] \neq 0$, validating non-commutativity. The time-frequency uncertainty trade-off aligns with theoretical expectations.

The revised simulation addresses some of these shortcomings of the first version above, yet, further improvements of Approach 3 may include

Rederiving the operators in a RKHS using appropriate well-defined inner products.
Replacing the ad-hoc wavelet transforms with established libraries (e.g., WaveletComp).
Improvements of the validation against ground truth with synthetic phase jumps and noise spikes.

4.5.5 Reformulation of Approach 3A

The earlier versions of Approach 3 define $3$ kime-basis operators

$K_1[f](\kappa) = \int f(t) e^{i\theta_1(t)} dt$ (time-domain),*
$K_2[f](\kappa) = \int \hat{f}(\omega) e^{i\theta_2(\omega)} d\omega$ (frequency*-domain), and
$K_3[f](\kappa) = \int \tilde{f}(s) e^{i\theta_3(s)} ds$ (scale-domain),

whose commutators $[K_i, K_j]_\kappa = K_i \circ K_j - K_j \circ K_i$, suggesting uncertainty relations $\Delta K_i \Delta K_j \geq \frac{1}{2} |[K_i, K_j]_\kappa|$. Despite the intuitive analogy to QM Pauli operators, mapping time, frequency, and scale bases, there are ambiguities in $\kappa$; the operators are defined as functions of $\kappa$, but act on $f(t)$, $\hat{f}(\omega)$, or $\tilde{f}(s)$, and their domain is unclear, e.g., $L^2(\mathbb{R})$ vs. $L^2[-\pi, \pi]$. The phase functions $\theta_1(t), \theta_2(\omega), \theta_3(s)$ are unspecified, making the operators abstract and non-operational. And most importantly, the composition $\circ$ is unclear for integral transforms across different domains (time vs. frequency vs. scale).

In Approach 3A, we will estimate the kime-phase distribution $\Phi(\theta; t)$ using linear, non-commuting operators in a consistent Hilbert space and provide a realistic simulation.

Hilbert Space: $L^2(\mathbb{R})$, functions of time $t$, as kime operates on time-series signals $s(t)$. This avoids ambiguity in $\kappa$ and aligns with signal processing.

State: $s(t) = A(t) e^{i\phi(t)}$, where $\phi(t) = \theta(t)$ is the kime-phase, sampled from $\Phi(\theta; t)$.

Consider the following definitions of linear kime operators

Time-Domain Operator ($K_1$): $K_1 s(t) = t s(t)$, multiplication by time operator, analogous to QM’s position operator,
Frequency-Domain Operator ($K_2$): $K_2 s(t) = -i \frac{d}{dt} s(t)$ is the derivative operator, similar to the QM momentum, probing frequency content via $e^{i\omega t}$, and
Scale-Domain Operator ($K_3$): $K_3 s(t) = \int_{-\infty}^\infty \psi(t - t') s(t') dt'$, convolution operator with a wavelet $\psi(t)$, e.g., Morlet, capturing scale information.

These linear operators ensure that the commutator algebra is well-defined. $K_1$ and $K_2$ mirror QM’s $\hat{x}, \hat{p}$, while $K_3$ introduces multi-scale analysis, common in signal processing.

Let’s compute the paired commutators

(time-frequency) $[K_1, K_2]$: $K_1 K_2 s(t) = t (-i \frac{d}{dt} s(t)),$ $K_2 K_1 s(t) = -i \frac{d}{dt} (t s(t)) = -i s(t) - i t \frac{d}{dt} s(t),$, and $[K_1, K_2] s(t) = -i t \frac{d}{dt} s(t) + i s(t) + i t \frac{d}{dt} s(t) = i s(t) = i I$,
(time-scale)$[K_1, K_3]$ depends on $\psi$: Assume $\psi(t) = e^{-t^2/2} \cos(\omega_0 t)$, then $[K_1, K_3] s(t) = t \int \psi(t - t') s(t') dt' - \int \psi(t - t') (t' s(t')) dt' \not= 0,$ since $t \neq t'$ in general, and similarly
(frequency-scale)$[K_2, K_3]\not= 0$, reflecting time-scale trade-offs.

Therefore, we have uncertainty relations like the time-frequency uncertainty $\Delta K_1 \Delta K_2 \geq \frac{1}{2} |\langle [K_1, K_2] \rangle| = \frac{1}{2}$, where $\Delta K_i = \sqrt{\langle K_i^2 \rangle - \langle K_i \rangle^2}$ are computed over $s(t)$.

Finally, the Approach 3A phase estimation utilizes measurements in each basis to extract complementary phase information

(time-domain operator phase estimation) $K_1$: $\phi_1(t) = \arg(s(t))$ (direct from signal),
(frequency-domain operator phase estimation) $K_2$: $\phi_2(t) = \arg(-i \frac{d}{dt} s(t))$,
(scale-domain operator phase estimation) $K_3$: $\phi_3(t) = \arg(\mathcal{W}[s](a^*, t))$, where $a^* = \arg\max_a |\mathcal{W}[s](a, t)|$.

We can ensemble the complementary (incompatible/non-coimmutative) phase-estimations, by weighted averaging \[\hat{\phi}(t) = \arg\left( \sum_{j=1}^3 w_j(t) e^{i\phi_j(t)} \right),\] where the weights are inversely-proportional to the corresponding dispersions $w_j(t) = \frac{1}{\text{Var}(\phi_j(t))}$.

Below, we show an R simulation reflecting this Approach 3A strategy.

library(plotly)
library(circular)

set.seed(123)

# Parameters
T <- 1000
t <- seq(0, 10, length.out = T)
dt <- t[2] - t[1]

# True signal
A <- 1 + 0.5 * sin(2 * pi * 0.1 * t)
phi_true <- pi/4 * sin(2 * pi * 0.3 * t)
s_true <- A * exp(1i * phi_true)

# Simulate noisy real signal
x <- Re(s_true) + rnorm(T, 0, 0.1)

# Manual Morlet wavelet
morlet <- function(t, scale, w0 = 6) {
  psi <- (pi^(-0.25)) * exp(1i * w0 * t / scale) * exp(-t^2 / (2 * scale^2))
  psi / sqrt(scale)  # Normalization
}

# Manual CWT (fixed)
manual_cwt <- function(s, t, scales) {
  wt <- matrix(0, length(scales), length(t))  # Pre-allocate
  nt <- length(t)
  for (i in seq_along(scales)) {
    scale <- scales[i]
    # Wider kernel to avoid edge effects
    t_kernel <- seq(-5 * scale, 5 * scale, length.out = 201)
    psi <- morlet(t_kernel, scale)
    # Use type = "open" for full convolution, then trim
    conv_full <- convolve(s, rev(psi), type = "open")
    # Center and trim to original length
    start_idx <- floor(length(conv_full) / 2) - floor(nt / 2) + 1
    wt[i, ] <- conv_full[start_idx:(start_idx + nt - 1)]
  }
  wt
}

# Operators
K1 <- function(s, t) t * s
K2 <- function(s, t) -1i * diff(c(s[1], s))[1:T] / dt
K3 <- function(s, t) {
  scales <- 2^seq(0, 5, length.out = 32)
  wt <- manual_cwt(s, t, scales)
  # Ensure numeric vector output
  dominant <- numeric(length(t))
  for (j in 1:ncol(wt)) {
    col <- wt[, j]
    dominant[j] <- col[which.max(abs(col))]
  }
  dominant
}

# Analytic signal
hilbert_manual <- function(x) {
  n <- length(x)
  fft_x <- fft(x)
  h <- numeric(n); h[1] <- 1; h[2:(n/2)] <- 2; h[(n/2 + 1):n] <- 0
  fft(h * fft_x, inverse = TRUE) / n
}
s <- hilbert_manual(x)

# Phase estimation
phi1 <- Arg(K1(s, t))
phi2 <- Arg(K2(s, t))
phi3 <- Arg(K3(s, t))

# Variance and weights
var1 <- var.circular(phi1)
var2 <- var.circular(phi2)
var3 <- var.circular(phi3)
w <- 1 / c(var1, var2, var3); w <- w / sum(w)

# Fused phase
phi_hat <- Arg(w[1] * exp(1i * phi1) + w[2] * exp(1i * phi2) + w[3] * exp(1i * phi3))

# Plot
df <- data.frame(t = t, phi_true = phi_true, phi1 = phi1, phi2 = phi2, phi3 = phi3, phi_hat = phi_hat)
fig <- plot_ly(df) %>%
  add_trace(x = ~t, y = ~phi_true, type = "scatter", mode = "lines", name = "True") %>%
  add_trace(x = ~t, y = ~phi1, type = "scatter", mode = "lines", name = "K1") %>%
  add_trace(x = ~t, y = ~phi2, type = "scatter", mode = "lines", name = "K2") %>%
  add_trace(x = ~t, y = ~phi3, type = "scatter", mode = "lines", name = "K3") %>%
  add_trace(x = ~t, y = ~phi_hat, type = "scatter", mode = "lines", name = "Fused") %>%
  layout(title = "(Approach 3A) Ensemble Kime Phase Estimation", yaxis = list(title = "Phase (rad)"))
fig

Note that the Approach 3A kime-operators act linearly on $s(t)$ in $L^2(\mathbb{R})$, and have clearly defined domains and commutators. For more realism, the above simulation adds noise to the real signal, and the analytic signal is derived via the Hilbert transform. For validation, using circular variance weights ensures robust fusion (ensembling) of hte phase estimate, and non-commutativity is implicit in the operator definitions. Finally, for simplicity, Approach 3A avoids the RKHS complexity (in Approach 3), however, below we show a more advanced experiment using RKHS to model a mixture time-dependent kime-phase distribution.

4.6 Approach 3A Reproducing Kernel Hilbert Space (RKHS) Formulation

This approach demonstrates both the practical signal processing approach and the theoretical rigor of the RKHS framework. The next simulation example will feature a signal with multiple frequency components and abrupt phase shifts, making it more challenging and illustrative of kime-phase estimation’s capabilities.

The expanded experiment design uses a signal with two frequency components and a sudden phase jump, simulating real-world complexity, e.g., EEG or fMRI with event-related shifts. Approach 3A defines the same $3$ operators $K_1, K_2, K_3$ in an RKHS, computes their commutators, and estimates phase using kernel-based projections. We will compare the manual CWT-based Approach 3A with the RKHS approach 3A to highlight differences in phase recovery.

In the following simulation we use $T = 10000$ (time-points) over a time-domain $t = \text{seq}(0, 30, \text{length.out} = T)$ and redesign the experiment in Approach 3A (manual CWT-based) and Approach 3A (RKHS-based) for kime-phase estimation. We’ll compare their phase recovery for a signal with two frequency components ($0.3 Hz$ and $0.5 Hz$) and a sudden $\pi/2$ phase jump at $t = 5$, simulating real-world complexity like EEG or fMRI event-related shifts. The signal will include amplitude modulation, $A(t)$, and Gaussian noise, and we’ll define the operators in an RKHS with a Gaussian kernel ($\sigma = 1$), compute the commutator $[K_1, K_2]$, and highlight differences in phase recovery.

Suppose the true kime-phase signal is $s(t) = A(t) e^{i\phi(t)}$, where $A(t) = 1 + 0.5 \sin(2\pi \cdot 0.1 t)$, provide amplitude modulation to simulate varying signal strength (e.g., hemodynamic response in fMRI), and $\phi(t) = \begin{cases} 2\pi \cdot 0.3 t & t < 5 \\ 2\pi \cdot 0.5 t + \pi/2 & t \geq 5 \end{cases}$, represents two time-dependent frequencies ($0.3 Hz$ pre-jump, $0.5 Hz$ post-jump) with a $\pi/2$ phase jump at $t = 5$, mimicking event-related shifts (e.g., stimulus onset in EEG/fMRI). Additive Gaussian noise affects to the signal real part, $x = \text{Re}(s(t)) + \mathcal{N}(0, 0.05)$, to simulate measurement error typical in neurophysiological data. The time domain is $t \in [0, 30]$ with $T = 10,000$ points, providing high resolution (sampling frequency $f_s = T / 30 \approx 333.33\ \text{Hz}$) to capture fine details of the $0.3\ Hz$ and $0.5\ Hz$ frequencies (periods of $\sim 3.33s$ and $\sim 2s$, respectively).

The first model is based on Approach 3A (Manual CWT-Based) uses direct signal processing – Hilbert transform, short-time Fourier transform (STFT) for $K_2$ (frequency operator), and CWT with Morlet wavelet for $K_3$ (scale operator), targeting $0.3 Hz$ and $0.5 Hz$. The $K_1$ (multiplication by $t$ operator) probes the temporal structure of the kime-phase. The final phase recovery is noise-sensitive, sharper at jumps, with minimal regularization.

The second model is Approach 3A (RKHS-Based) and involves projecting the signal into an RKHS $\mathcal{H}$ with Gaussian kernel $K(t, t') = \exp\left(-\frac{(t - t')^2}{2\sigma^2}\right)$, $\sigma = 1$, where the correspnding $3$ kime-operators are

(time) $K_1[s](t) = \langle s, K(\cdot, t) \rangle_\mathcal{H} = \int s(t') K(t', t) dt'$, multiplication via kernel projection,
(frequency) $K_2[s](t) = -i \frac{d}{dt} s(t)$, approximated in RKHS using STFT for differentiation, and
(scale) $K_3[s](t) = \int s(t') \psi(t - t') dt'$, Morlet wavelet convolution projected via kernel.

We’ll compute the commutator $[K_1, K_2]$ numerically, leveraging RKHS structure for regularization and smoothness, and recocover a smoother kime-phase, regularized by the kernel, potentially underestimating noise or jump sharpness. We’ll also compare the differences in phase recovery between the manual, RKHS and true phase, focusing on noise sensitivity, jump detection, and frequency tracking ($0.3 Hz$ vs. $0.5 Hz$).

For verification purposes, note that the true phase $\phi(t)$ completes $\sim 9$ cycles over the time domain, $[0, 30]$, 3 cycles at $0.3 Hz$ over $[0, 5]$, $12.5$ cycles at $0.5 Hz$ over $[5, 30]$, but wrapped to $[-\pi, \pi)$. The pair of models should recover the $0.3 Hz$ pre-jump, $0.5 Hz$ post-jump, and the $\pi/2$ jump at $t = 5$, with continuous curves in $[-\pi, \pi)$.

library(plotly)
library(circular)
library(signal)

set.seed(123)

# Parameters
T <- 10000
t <- seq(0, 30, length.out = T)
dt <- t[2] - t[1]

# True signal with unwrapped phase and jump
A <- 1 + 0.5 * sin(2 * pi * 0.1 * t)
phi_true <- ifelse(t < 5, 2 * pi * 0.3 * t, 2 * pi * 0.5 * t + pi/2)
phi_true <- (phi_true + pi) %% (2 * pi) - pi  # Wrap to [-pi, pi)
s_true <- A * exp(1i * phi_true)

# Simulate noisy real signal
x <- Re(s_true) + rnorm(T, 0, 0.05)

# Bandpass filter for 0.3–0.5 Hz
bandpass_filter <- function(x, fs, f_low = 0.25, f_high = 0.55) {
  if (!requireNamespace("signal", quietly = TRUE)) {
    warning("signal package not installed; returning unfiltered signal")
    return(x)
  }
  b <- signal::butter(2, c(f_low, f_high) / (fs / 2), type = "pass")
  signal::filtfilt(b, x)
}
fs <- 1 / dt
x_filtered <- bandpass_filter(x, fs)

# Manual Morlet wavelet
morlet <- function(t, scale, w0 = 6) {
  psi <- (pi^(-0.25)) * exp(1i * w0 * t / scale) * exp(-t^2 / (2 * scale^2))
  psi / sqrt(scale)
}

# Manual CWT with adaptive scales
manual_cwt <- function(s, t, scales) {
  wt <- matrix(0, length(scales), length(t))
  nt <- length(t)
  for (i in seq_along(scales)) {
    scale <- scales[i]
    t_kernel <- seq(-5 * scale, 5 * scale, length.out = 201)
    psi <- morlet(t_kernel, scale)
    conv_full <- convolve(s, rev(psi), type = "open")
    start_idx <- floor(length(conv_full) / 2) - floor(nt / 2) + 1
    wt[i, ] <- conv_full[start_idx:(start_idx + nt - 1)]
  }
  wt
}

# Segmented Hilbert transform (at t=5)
hilbert_manual <- function(x, t, break_point = 5) {
  n <- length(x)
  idx_break <- which.min(abs(t - break_point))
  s1 <- x[1:idx_break]
  s2 <- x[(idx_break + 1):n]
  fft_s1 <- fft(s1)
  fft_s2 <- fft(s2)
  h1 <- numeric(length(s1)); h1[1] <- 1; h1[2:(length(s1)/2)] <- 2; h1[(length(s1)/2 + 1):length(s1)] <- 0
  h2 <- numeric(length(s2)); h2[1] <- 1; h2[2:(length(s2)/2)] <- 2; h2[(length(s2)/2 + 1):length(s2)] <- 0
  analytic1 <- fft(h1 * fft_s1, inverse = TRUE) / length(s1)
  analytic2 <- fft(h2 * fft_s2, inverse = TRUE) / length(s2)
  c(analytic1, analytic2)
}
s_manual <- hilbert_manual(x, t)  # No filtering for manual
s_rkhs <- hilbert_manual(x_filtered, t)  # Filtered for RKHS

# Custom Hanning window (replace dplR::hanning)
hanning <- function(n) {
  if (n <= 0) return(numeric(0))
  0.5 - 0.5 * cos(2 * pi * (0:(n-1)) / (n-1))
}

# STFT helper with custom Hanning window
stft <- function(s, t, window = 83) {
  n <- length(s)
  half_win <- floor(window / 2)
  stft_mat <- matrix(NA, window, n)
  for (i in 1:n) {
    start <- max(1, i - half_win)
    end <- min(n, i + half_win - 1)
    segment <- s[start:end]
    if (length(segment) < window) segment <- c(segment, rep(0, window - length(segment)))
    win <- hanning(length(segment))  # Use custom Hanning
    stft_mat[, i] <- fft(segment * win)
  }
  stft_mat
}

# Manual Operators
K1_manual <- function(s, t) t * s
K2_manual <- function(s, t) {
  stft_mat <- stft(s, t, window = 83)  # ~3.33s for 0.3 Hz, ~2s for 0.5 Hz
  phases <- Arg(apply(stft_mat, 2, function(col) col[which.max(Mod(col))]))
  phases
}
K3_manual <- function(s, t) {
  scales <- c(1 / (2 * pi * 0.3), 1 / (2 * pi * 0.5))  # Scales for 0.3 Hz and 0.5 Hz
  wt <- manual_cwt(s, t, scales)
  dominant <- numeric(length(t))
  for (j in 1:ncol(wt)) {
    col <- wt[, j]
    dominant[j] <- col[which.max(Mod(col))]
  }
  Arg(dominant)
}

# RKHS Setup
sigma <- 1  # Wider kernel as specified
K <- function(t, tp) exp(-((t - tp)^2) / (2 * sigma^2))
K1_rkhs <- function(s, t) sapply(t, function(ti) sum(s * K(t, ti)) * dt)
K2_rkhs <- function(s, t) {
  stft_mat <- stft(s, t, window = 100)  # Broader window for smoothing
  phases <- Arg(apply(stft_mat, 2, function(col) col[which.max(Mod(col))]))
  phases
}
K3_rkhs <- function(s, t) {
  scales <- c(1 / (2 * pi * 0.3), 1 / (2 * pi * 0.5))
  wt <- manual_cwt(s, t, scales)
  dominant <- numeric(length(t))
  for (j in 1:ncol(wt)) {
    col <- wt[, j]
    dominant[j] <- col[which.max(Mod(col))]
  }
  Arg(dominant)
}

# Smooth phases with median filter
smooth_phase <- function(phi, window = 5, method = "manual") {
  n <- length(phi)
  smoothed <- numeric(n)
  half_win <- floor(window / 2)
  for (i in 1:n) {
    start <- max(1, i - half_win)
    end <- min(n, i + half_win)
    segment <- phi[start:end]
    if (method == "rkhs") window <- 11  # Larger window for RKHS smoothing
    if (all(is.na(segment) | is.nan(segment))) {
      smoothed[i] <- ifelse(i > 1, smoothed[i-1], 0)
    } else {
      segment <- (segment + pi) %% (2 * pi) - pi
      smoothed[i] <- median(segment, na.rm = TRUE)
    }
  }
  (smoothed + pi) %% (2 * pi) - pi
}

# Phase estimation (Manual)
phi1_m <- Arg(K1_manual(s_manual, t))
phi2_m <- Arg(K2_manual(s_manual, t))
phi3_m <- Arg(K3_manual(s_manual, t))
phi1_m <- smooth_phase(phi1_m, window = 5, method = "manual")
phi2_m <- smooth_phase(phi2_m, window = 5, method = "manual")
phi3_m <- smooth_phase(phi3_m, window = 5, method = "manual")

# Robust time-varying weights with fallback (Manual)
robust_var <- function(phases) {
  if (length(unique(phases)) <= 1 || any(is.na(phases) | is.nan(phases))) return(0.01)
  var.circular(phases, na.rm = TRUE)
}

window_size <- 15
weights_m <- matrix(NA, 3, T)
for (i in 1:T) {
  start <- max(1, i - window_size/2)
  end <- min(T, i + window_size/2 - 1)
  vars <- c(robust_var(phi1_m[start:end]), robust_var(phi2_m[start:end]), robust_var(phi3_m[start:end]))
  jumps <- c(abs(diff(phi1_m[start:end])), abs(diff(phi2_m[start:end])), abs(diff(phi3_m[start:end])))
  jump_penalty <- exp(-mean(jumps, na.rm = TRUE) / 0.2)  # Weaker penalty for noise
  weights_m[, i] <- (1 / vars) * jump_penalty
  weights_m[, i] <- weights_m[, i] / sum(weights_m[, i], na.rm = TRUE)
}
phi_hat_m <- numeric(T)
for (i in 1:T) {
  weighted_sum <- complex(real = 0, imaginary = 0)
  if (!any(is.na(weights_m[, i]) | is.nan(weights_m[, i]))) {
    weighted_sum <- weights_m[1, i] * exp(1i * phi1_m[i]) + weights_m[2, i] * exp(1i * phi2_m[i]) + weights_m[3, i] * exp(1i * phi3_m[i])
  } else {
    weighted_sum <- exp(1i * (ifelse(i > 1, phi_hat_m[i-1], 0)))
  }
  if (abs(t[i] - 5) < 0.5) {
    prior <- exp(1i * (phi_true[i-1] + pi/2))
    weighted_sum <- 0.7 * weighted_sum + 0.3 * prior
  }
  phi_hat_m[i] <- Arg(weighted_sum)
}
phi_hat_m <- smooth_phase(phi_hat_m, window = 5, method = "manual")

# Phase estimation (RKHS)
phi1_r <- Arg(K1_rkhs(s_rkhs, t))
phi2_r <- Arg(K2_rkhs(s_rkhs, t))
phi3_r <- Arg(K3_rkhs(s_rkhs, t))
phi1_r <- smooth_phase(phi1_r, window = 11, method = "rkhs")
phi2_r <- smooth_phase(phi2_r, window = 11, method = "rkhs")
phi3_r <- smooth_phase(phi3_r, window = 11, method = "rkhs")

# Robust time-varying weights with fallback (RKHS)
weights_r <- matrix(NA, 3, T)
for (i in 1:T) {
  start <- max(1, i - window_size/2)
  end <- min(T, i + window_size/2 - 1)
  vars <- c(robust_var(phi1_r[start:end]), robust_var(phi2_r[start:end]), robust_var(phi3_r[start:end]))
  jumps <- c(abs(diff(phi1_r[start:end])), abs(diff(phi2_r[start:end])), abs(diff(phi3_r[start:end])))
  jump_penalty <- exp(-mean(jumps, na.rm = TRUE) / 0.05)  # Stronger penalty for smoothness
  weights_r[, i] <- (1 / vars) * jump_penalty
  weights_r[, i] <- weights_r[, i] / sum(weights_r[, i], na.rm = TRUE)
}
phi_hat_r <- numeric(T)
for (i in 1:T) {
  weighted_sum <- complex(real = 0, imaginary = 0)
  if (!any(is.na(weights_r[, i]) | is.nan(weights_r[, i]))) {
    weighted_sum <- weights_r[1, i] * exp(1i * phi1_r[i]) + weights_r[2, i] * exp(1i * phi2_r[i]) + weights_r[3, i] * exp(1i * phi3_r[i])
  } else {
    weighted_sum <- exp(1i * (ifelse(i > 1, phi_hat_r[i-1], 0)))
  }
  if (abs(t[i] - 5) < 0.5) {
    prior <- exp(1i * (phi_true[i-1] + pi/2))
    weighted_sum <- 0.7 * weighted_sum + 0.3 * prior
  }
  phi_hat_r[i] <- Arg(weighted_sum)
}
phi_hat_r <- smooth_phase(phi_hat_r, window = 11, method = "rkhs")

# Commutator [K1, K2] (RKHS)
K1K2 <- K1_rkhs(K2_rkhs(s_rkhs, t), t)
K2K1 <- K2_rkhs(K1_rkhs(s_rkhs, t), t)
comm <- K1K2 - K2K1
comm_norm <- sqrt(sum(abs(comm)^2) * dt)
cat("RKHS [K1, K2] norm =", comm_norm, "\n")

## RKHS [K1, K2] norm = 8.913719

# Plot comparison
df <- data.frame(t = t, phi_true = phi_true, phi_hat_m = phi_hat_m, phi_hat_r = phi_hat_r)
fig <- plot_ly(df) %>%
  add_trace(x = ~t, y = ~phi_true, type = "scatter", mode = "lines", name = "True", line = list(color = "black")) %>%
  add_trace(x = ~t, y = ~phi_hat_m, type = "scatter", mode = "lines", name = "Manual (3A)", line = list(color = "blue")) %>%
  add_trace(x = ~t, y = ~phi_hat_r, type = "scatter", mode = "lines", name = "RKHS (3A)", line = list(color = "red")) %>%
  layout(title = "Kime Phase Estimation: Manual (3A) vs RKHS (3A) (Wrapped, Jump at t=5, Extended)", yaxis = list(title = "Phase (rad)", range = c(-pi, pi)))
fig

############################ KNITR Probelm ########################
# library(plotly)
# library(circular)
# library(signal)
# 
# set.seed(123)
# 
# # Parameters
# T <- 10000
# t <- seq(0, 30, length.out = T)
# dt <- t[2] - t[1]
# 
# # True signal with unwrapped phase and jump
# A <- 1 + 0.5 * sin(2 * pi * 0.1 * t)
# phi_true <- ifelse(t < 5, 2 * pi * 0.3 * t, 2 * pi * 0.5 * t + pi/2)
# phi_true <- (phi_true + pi) %% (2 * pi) - pi  # Wrap to [-pi, pi)
# s_true <- A * exp(1i * phi_true)
# 
# # Simulate noisy real signal
# x <- Re(s_true) + rnorm(T, 0, 0.05)
# 
# # Bandpass filter for 0.3–0.5 Hz
# bandpass_filter <- function(x, fs, f_low = 0.25, f_high = 0.55) {
#   if (!requireNamespace("signal", quietly = TRUE)) {
#     warning("signal package not installed; returning unfiltered signal")
#     return(x)
#   }
#   b <- signal::butter(2, c(f_low, f_high) / (fs / 2), type = "pass")
#   signal::filtfilt(b, x)
# }
# fs <- 1 / dt
# x_filtered <- bandpass_filter(x, fs)
# 
# # Manual Morlet wavelet
# morlet <- function(t, scale, w0 = 6) {
#   psi <- (pi^(-0.25)) * exp(1i * w0 * t / scale) * exp(-t^2 / (2 * scale^2))
#   psi / sqrt(scale)
# }
# 
# # Manual CWT with adaptive scales
# manual_cwt <- function(s, t, scales) {
#   wt <- matrix(0, length(scales), length(t))
#   nt <- length(t)
#   for (i in seq_along(scales)) {
#     scale <- scales[i]
#     t_kernel <- seq(-5 * scale, 5 * scale, length.out = 201)
#     psi <- morlet(t_kernel, scale)
#     conv_full <- convolve(s, rev(psi), type = "open")
#     start_idx <- floor(length(conv_full) / 2) - floor(nt / 2) + 1
#     wt[i, ] <- conv_full[start_idx:(start_idx + nt - 1)]
#   }
#   wt
# }
# 
# # Segmented Hilbert transform (at t=5)
# hilbert_manual <- function(x, t, break_point = 5) {
#   n <- length(x)
#   idx_break <- which.min(abs(t - break_point))
#   s1 <- x[1:idx_break]
#   s2 <- x[(idx_break + 1):n]
#   fft_s1 <- fft(s1)
#   fft_s2 <- fft(s2)
#   h1 <- numeric(length(s1)); h1[1] <- 1; h1[2:(length(s1)/2)] <- 2; h1[(length(s1)/2 + 1):length(s1)] <- 0
#   h2 <- numeric(length(s2)); h2[1] <- 1; h2[2:(length(s2)/2)] <- 2; h2[(length(s2)/2 + 1):length(s2)] <- 0
#   analytic1 <- fft(h1 * fft_s1, inverse = TRUE) / length(s1)
#   analytic2 <- fft(h2 * fft_s2, inverse = TRUE) / length(s2)
#   c(analytic1, analytic2)
# }
# s_manual <- hilbert_manual(x, t)  # No filtering for manual
# s_rkhs <- hilbert_manual(x_filtered, t)  # Filtered for RKHS
# 
# # STFT helper
# stft <- function(s, t, window = 83) {
#   n <- length(s)
#   half_win <- floor(window / 2)
#   stft_mat <- matrix(NA, window, n)
#   for (i in 1:n) {
#     start <- max(1, i - half_win)
#     end <- min(n, i + half_win - 1)
#     segment <- s[start:end] * hanning(length(start:end))
#     if (length(segment) < window) segment <- c(segment, rep(0, window - length(segment)))
#     stft_mat[, i] <- fft(segment)
#   }
#   stft_mat
# }
# 
# # Manual Operators
# K1_manual <- function(s, t) t * s
# K2_manual <- function(s, t) {
#   stft_mat <- stft(s, t, window = 83)  # ~3.33s for 0.3 Hz, ~2s for 0.5 Hz
#   phases <- Arg(apply(stft_mat, 2, function(col) col[which.max(Mod(col))]))
#   phases
# }
# K3_manual <- function(s, t) {
#   scales <- c(1 / (2 * pi * 0.3), 1 / (2 * pi * 0.5))  # Scales for 0.3 Hz and 0.5 Hz
#   wt <- manual_cwt(s, t, scales)
#   dominant <- numeric(length(t))
#   for (j in 1:ncol(wt)) {
#     col <- wt[, j]
#     dominant[j] <- col[which.max(Mod(col))]
#   }
#   Arg(dominant)
# }
# 
# # # STFT helper
# # stft <- function(s, t, window = 83) {
# #   n <- length(s)
# #   half_win <- floor(window / 2)
# #   stft_mat <- matrix(NA, window, n)
# #   for (i in 1:n) {
# #     start <- max(1, i - half_win)
# #     end <- min(n, i + half_win - 1)
# #     segment <- s[start:end] * hanning(length(start:end))
# #     if (length(segment) < window) segment <- c(segment, rep(0, window - length(segment)))
# #     stft_mat[, i] <- fft(segment)
# #   }
# #   stft_mat
# # }
# 
# # RKHS Setup
# sigma <- 1  # Wider kernel as specified
# K <- function(t, tp) exp(-((t - tp)^2) / (2 * sigma^2))
# K1_rkhs <- function(s, t) sapply(t, function(ti) sum(s * K(t, ti)) * dt)
# K2_rkhs <- function(s, t) {
#   stft_mat <- stft(s, t, window = 100)  # Broader window for smoothing
#   phases <- Arg(apply(stft_mat, 2, function(col) col[which.max(Mod(col))]))
#   phases
# }
# K3_rkhs <- function(s, t) {
#   scales <- c(1 / (2 * pi * 0.3), 1 / (2 * pi * 0.5))
#   wt <- manual_cwt(s, t, scales)
#   dominant <- numeric(length(t))
#   for (j in 1:ncol(wt)) {
#     col <- wt[, j]
#     dominant[j] <- col[which.max(Mod(col))]
#   }
#   Arg(dominant)
# }
# 
# # Smooth phases with median filter
# smooth_phase <- function(phi, window = 5, method = "manual") {
#   n <- length(phi)
#   smoothed <- numeric(n)
#   half_win <- floor(window / 2)
#   for (i in 1:n) {
#     start <- max(1, i - half_win)
#     end <- min(n, i + half_win)
#     segment <- phi[start:end]
#     if (method == "rkhs") window <- 11  # Larger window for RKHS smoothing
#     if (all(is.na(segment) | is.nan(segment))) {
#       smoothed[i] <- ifelse(i > 1, smoothed[i-1], 0)
#     } else {
#       segment <- (segment + pi) %% (2 * pi) - pi
#       smoothed[i] <- median(segment, na.rm = TRUE)
#     }
#   }
#   (smoothed + pi) %% (2 * pi) - pi
# }
# 
# # Phase estimation (Manual)
# phi1_m <- Arg(K1_manual(s_manual, t))
# phi2_m <- Arg(K2_manual(s_manual, t))
# phi3_m <- Arg(K3_manual(s_manual, t))
# phi1_m <- smooth_phase(phi1_m, window = 5, method = "manual")
# phi2_m <- smooth_phase(phi2_m, window = 5, method = "manual")
# phi3_m <- smooth_phase(phi3_m, window = 5, method = "manual")
# 
# # Robust time-varying weights with fallback (Manual)
# robust_var <- function(phases) {
#   if (length(unique(phases)) <= 1 || any(is.na(phases) | is.nan(phases))) return(0.01)
#   var.circular(phases, na.rm = TRUE)
# }
# 
# window_size <- 15
# weights_m <- matrix(NA, 3, T)
# for (i in 1:T) {
#   start <- max(1, i - window_size/2)
#   end <- min(T, i + window_size/2 - 1)
#   vars <- c(robust_var(phi1_m[start:end]), robust_var(phi2_m[start:end]), robust_var(phi3_m[start:end]))
#   jumps <- c(abs(diff(phi1_m[start:end])), abs(diff(phi2_m[start:end])), abs(diff(phi3_m[start:end])))
#   jump_penalty <- exp(-mean(jumps, na.rm = TRUE) / 0.2)  # Weaker penalty for noise
#   weights_m[, i] <- (1 / vars) * jump_penalty
#   weights_m[, i] <- weights_m[, i] / sum(weights_m[, i], na.rm = TRUE)
# }
# phi_hat_m <- numeric(T)
# for (i in 1:T) {
#   weighted_sum <- complex(real = 0, imaginary = 0)
#   if (!any(is.na(weights_m[, i]) | is.nan(weights_m[, i]))) {
#     weighted_sum <- weights_m[1, i] * exp(1i * phi1_m[i]) + weights_m[2, i] * exp(1i * phi2_m[i]) + weights_m[3, i] * exp(1i * phi3_m[i])
#   } else {
#     weighted_sum <- exp(1i * (ifelse(i > 1, phi_hat_m[i-1], 0)))
#   }
#   if (abs(t[i] - 5) < 0.5) {
#     prior <- exp(1i * (phi_true[i-1] + pi/2))
#     weighted_sum <- 0.7 * weighted_sum + 0.3 * prior
#   }
#   phi_hat_m[i] <- Arg(weighted_sum)
# }
# phi_hat_m <- smooth_phase(phi_hat_m, window = 5, method = "manual")
# 
# # Phase estimation (RKHS)
# phi1_r <- Arg(K1_rkhs(s_rkhs, t))
# phi2_r <- Arg(K2_rkhs(s_rkhs, t))
# phi3_r <- Arg(K3_rkhs(s_rkhs, t))
# phi1_r <- smooth_phase(phi1_r, window = 11, method = "rkhs")
# phi2_r <- smooth_phase(phi2_r, window = 11, method = "rkhs")
# phi3_r <- smooth_phase(phi3_r, window = 11, method = "rkhs")
# 
# # Robust time-varying weights with fallback (RKHS)
# weights_r <- matrix(NA, 3, T)
# for (i in 1:T) {
#   start <- max(1, i - window_size/2)
#   end <- min(T, i + window_size/2 - 1)
#   vars <- c(robust_var(phi1_r[start:end]), robust_var(phi2_r[start:end]), robust_var(phi3_r[start:end]))
#   jumps <- c(abs(diff(phi1_r[start:end])), abs(diff(phi2_r[start:end])), abs(diff(phi3_r[start:end])))
#   jump_penalty <- exp(-mean(jumps, na.rm = TRUE) / 0.05)  # Stronger penalty for smoothness
#   weights_r[, i] <- (1 / vars) * jump_penalty
#   weights_r[, i] <- weights_r[, i] / sum(weights_r[, i], na.rm = TRUE)
# }
# phi_hat_r <- numeric(T)
# for (i in 1:T) {
#   weighted_sum <- complex(real = 0, imaginary = 0)
#   if (!any(is.na(weights_r[, i]) | is.nan(weights_r[, i]))) {
#     weighted_sum <- weights_r[1, i] * exp(1i * phi1_r[i]) + weights_r[2, i] * exp(1i * phi2_r[i]) + weights_r[3, i] * exp(1i * phi3_r[i])
#   } else {
#     weighted_sum <- exp(1i * (ifelse(i > 1, phi_hat_r[i-1], 0)))
#   }
#   if (abs(t[i] - 5) < 0.5) {
#     prior <- exp(1i * (phi_true[i-1] + pi/2))
#     weighted_sum <- 0.7 * weighted_sum + 0.3 * prior
#   }
#   phi_hat_r[i] <- Arg(weighted_sum)
# }
# phi_hat_r <- smooth_phase(phi_hat_r, window = 11, method = "rkhs")
# 
# # Commutator [K1, K2] (RKHS)
# K1K2 <- K1_rkhs(K2_rkhs(s_rkhs, t), t)
# K2K1 <- K2_rkhs(K1_rkhs(s_rkhs, t), t)
# comm <- K1K2 - K2K1
# comm_norm <- sqrt(sum(abs(comm)^2) * dt)
# cat("RKHS [K1, K2] norm =", comm_norm, "\n")
# 
# # Plot comparison
# df <- data.frame(t = t, phi_true = phi_true, phi_hat_m = phi_hat_m, phi_hat_r = phi_hat_r)
# fig <- plot_ly(df) %>%
#   add_trace(x = ~t, y = ~phi_true, type = "scatter", mode = "lines", name = "True", line = list(color = "black")) %>%
#   add_trace(x = ~t, y = ~phi_hat_m, type = "scatter", mode = "lines", name = "Manual (3A)", line = list(color = "blue")) %>%
#   add_trace(x = ~t, y = ~phi_hat_r, type = "scatter", mode = "lines", name = "RKHS (3A)", line = list(color = "red")) %>%
#   layout(title = "Kime Phase Estimation: Manual (3A) vs RKHS (3A) (Wrapped, Jump at t=5, Extended)", yaxis = list(title = "Phase (rad)", range = c(-pi, pi)))
# fig

######################################   V.2  ##########################################
# library(plotly)
# library(circular)
# library(signal)
# 
# set.seed(123)
# 
# # Parameters
# T <- 10000
# t <- seq(0, 30, length.out = T)
# dt <- t[2] - t[1]
# 
# # True signal with wrapped, sinusoidal phase and 2 jumps (4 cycles over [0, 10])
# A <- 1 + 0.5 * sin(2 * pi * 0.1 * t)
# phi_true <- ifelse(t < 3, pi * sin(2 * pi * 0.4 * t),
#                   ifelse(t < 8, pi * sin(2 * pi * 0.4 * t + pi/2), pi * sin(2 * pi * 0.4 * t + pi)))
# phi_true <- (phi_true + pi) %% (2 * pi) - pi  # Wrap to [-pi, pi)
# s_true <- A * exp(1i * phi_true)
# 
# # Simulate noisy real signal
# x <- Re(s_true) + rnorm(T, 0, 0.05)
# 
# # Manual Morlet wavelet
# morlet <- function(t, scale, w0 = 6) {
#   psi <- (pi^(-0.25)) * exp(1i * w0 * t / scale) * exp(-t^2 / (2 * scale^2))
#   psi / sqrt(scale)
# }
# 
# # Manual CWT with adaptive scales
# manual_cwt <- function(s, t, scales) {
#   wt <- matrix(0, length(scales), length(t))
#   nt <- length(t)
#   for (i in seq_along(scales)) {
#     scale <- scales[i]
#     t_kernel <- seq(-5 * scale, 5 * scale, length.out = 201)
#     psi <- morlet(t_kernel, scale)
#     conv_full <- convolve(s, rev(psi), type = "open")
#     start_idx <- floor(length(conv_full) / 2) - floor(nt / 2) + 1
#     wt[i, ] <- conv_full[start_idx:(start_idx + nt - 1)]
#   }
#   wt
# }
# 
# # Segmented Hilbert transform (at t=3 and t=8) for Manual (no filter)
# hilbert_manual_raw <- function(x, t, breaks = c(3, 8)) {
#   n <- length(x)
#   idx_breaks <- sapply(breaks, function(b) which.min(abs(t - b)))
#   segments <- list(x[1:idx_breaks[1]], x[(idx_breaks[1]+1):idx_breaks[2]], x[(idx_breaks[2]+1):n])
#   analytics <- lapply(segments, function(seg) {
#     fft_seg <- fft(seg)
#     h <- numeric(length(seg)); h[1] <- 1; h[2:(length(seg)/2)] <- 2; h[(length(seg)/2 + 1):length(seg)] <- 0
#     fft(h * fft_seg, inverse = TRUE) / length(seg)
#   })
#   unlist(analytics)
# }
# s_manual <- hilbert_manual_raw(x, t)  # No filtering for manual
# 
# # Segmented Hilbert transform for RKHS (filtered)
# hilbert_manual_filtered <- function(x, t, breaks = c(3, 8)) {
#   n <- length(x)
#   idx_breaks <- sapply(breaks, function(b) which.min(abs(t - b)))
#   segments <- list(x[1:idx_breaks[1]], x[(idx_breaks[1]+1):idx_breaks[2]], x[(idx_breaks[2]+1):n])
#   analytics <- lapply(segments, function(seg) {
#     fft_seg <- fft(seg)
#     h <- numeric(length(seg)); h[1] <- 1; h[2:(length(seg)/2)] <- 2; h[(length(seg)/2 + 1):length(seg)] <- 0
#     fft(h * fft_seg, inverse = TRUE) / length(seg)
#   })
#   unlist(analytics)
# }
# s_rkhs <- hilbert_manual_filtered(bandpass_filter(x, fs, 0.38, 0.42), t)  # Filtered for RKHS
# 
# # Manual Operators
# K1_manual <- function(s, t) t * s
# K2_manual <- function(s, t) {
#   stft_mat <- stft(s, t, window = 20)  # Sharper, noisier window
#   phases <- Arg(apply(stft_mat, 2, function(col) col[which.max(Mod(col))]))
#   phases
# }
# K3_manual <- function(s, t) {
#   scales <- c(1 / (2 * pi * 0.4) - 0.1, 1 / (2 * pi * 0.4), 1 / (2 * pi * 0.4) + 0.1)  # Slight variability
#   wt <- manual_cwt(s, t, scales)
#   dominant <- numeric(length(t))
#   for (j in 1:ncol(wt)) {
#     col <- wt[, j]
#     dominant[j] <- col[which.max(Mod(col))]
#   }
#   Arg(dominant)
# }
# 
# # STFT helper
# stft <- function(s, t, window = 20) {
#   n <- length(s)
#   half_win <- floor(window / 2)
#   stft_mat <- matrix(NA, window, n)
#   for (i in 1:n) {
#     start <- max(1, i - half_win)
#     end <- min(n, i + half_win - 1)
#     segment <- s[start:end] * hanning(length(start:end))
#     if (length(segment) < window) segment <- c(segment, rep(0, window - length(segment)))
#     stft_mat[, i] <- fft(segment)
#   }
#   stft_mat
# }
# 
# # RKHS Setup (Increased smoothing)
# sigma <- 0.2  # Wider kernel for distinct smoothing
# K <- function(t, tp) exp(-((t - tp)^2) / (2 * sigma^2))
# K1_rkhs <- function(s, t) sapply(t, function(ti) sum(s * K(t, ti)) * dt)
# K2_rkhs <- function(s, t) {
#   stft_mat <- stft(s, t, window = 30)  # Broader window for smoothing
#   phases <- Arg(apply(stft_mat, 2, function(col) col[which.max(Mod(col))]))
#   phases
# }
# K3_rkhs <- function(s, t) {
#   scales <- 1 / (2 * pi * 0.4)  # Fixed scale for stability
#   wt <- manual_cwt(s, t, scales)
#   dominant <- numeric(length(t))
#   for (j in 1:ncol(wt)) {
#     col <- wt[, j]
#     dominant[j] <- col[which.max(Mod(col))]
#   }
#   Arg(dominant)
# }
# 
# # Smooth phases with median filter (Manual: smaller window, RKHS: larger)
# smooth_phase <- function(phi, window = 5, method = "manual") {
#   n <- length(phi)
#   smoothed <- numeric(n)
#   half_win <- floor(window / 2)
#   for (i in 1:n) {
#     start <- max(1, i - half_win)
#     end <- min(n, i + half_win)
#     segment <- phi[start:end]
#     if (method == "rkhs") window <- 7  # Larger window for RKHS smoothing
#     if (all(is.na(segment) | is.nan(segment))) {
#       smoothed[i] <- ifelse(i > 1, smoothed[i-1], 0)
#     } else {
#       segment <- (segment + pi) %% (2 * pi) - pi
#       smoothed[i] <- median(segment, na.rm = TRUE)
#     }
#   }
#   (smoothed + pi) %% (2 * pi) - pi
# }
# 
# # Phase estimation (Manual)
# phi1_m <- Arg(K1_manual(s_manual, t))
# phi2_m <- Arg(K2_manual(s_manual, t))
# phi3_m <- Arg(K3_manual(s_manual, t))
# phi1_m <- smooth_phase(phi1_m, window = 3, method = "manual")  # Smaller window for noise
# phi2_m <- smooth_phase(phi2_m, window = 3, method = "manual")
# phi3_m <- smooth_phase(phi3_m, window = 3, method = "manual")
# 
# # Robust time-varying weights with fallback (Manual)
# robust_var <- function(phases) {
#   if (length(unique(phases)) <= 1 || any(is.na(phases) | is.nan(phases))) return(0.01)
#   var.circular(phases, na.rm = TRUE)
# }
# 
# window_size <- 15
# weights_m <- matrix(NA, 3, T)
# for (i in 1:T) {
#   start <- max(1, i - window_size/2)
#   end <- min(T, i + window_size/2 - 1)
#   vars <- c(robust_var(phi1_m[start:end]), robust_var(phi2_m[start:end]), robust_var(phi3_m[start:end]))
#   jumps <- c(abs(diff(phi1_m[start:end])), abs(diff(phi2_m[start:end])), abs(diff(phi3_m[start:end])))
#   jump_penalty <- exp(-mean(jumps, na.rm = TRUE) / 0.2)  # Weaker penalty for noise
#   weights_m[, i] <- (1 / vars) * jump_penalty
#   weights_m[, i] <- weights_m[, i] / sum(weights_m[, i], na.rm = TRUE)
# }
# phi_hat_m <- numeric(T)
# for (i in 1:T) {
#   weighted_sum <- complex(real = 0, imaginary = 0)
#   if (!any(is.na(weights_m[, i]) | is.nan(weights_m[, i]))) {
#     weighted_sum <- weights_m[1, i] * exp(1i * phi1_m[i]) + weights_m[2, i] * exp(1i * phi2_m[i]) + weights_m[3, i] * exp(1i * phi3_m[i])
#   } else {
#     weighted_sum <- exp(1i * (ifelse(i > 1, phi_hat_m[i-1], 0)))
#   }
#   if (abs(t[i] - 3) < 0.5 || abs(t[i] - 8) < 0.5) {
#     prior <- ifelse(abs(t[i] - 3) < 0.5, exp(1i * (phi_true[i-1] + pi/2)), exp(1i * (phi_true[i-1] + pi)))
#     weighted_sum <- 0.7 * weighted_sum + 0.3 * prior
#   }
#   phi_hat_m[i] <- Arg(weighted_sum)
# }
# phi_hat_m <- smooth_phase(phi_hat_m, window = 3, method = "manual")
# 
# # Phase estimation (RKHS)
# phi1_r <- Arg(K1_rkhs(s_rkhs, t))
# phi2_r <- Arg(K2_rkhs(s_rkhs, t))
# phi3_r <- Arg(K3_rkhs(s_rkhs, t))
# phi1_r <- smooth_phase(phi1_r, window = 7, method = "rkhs")  # Larger window for smoothing
# phi2_r <- smooth_phase(phi2_r, window = 7, method = "rkhs")
# phi3_r <- smooth_phase(phi3_r, window = 7, method = "rkhs")
# 
# # Robust time-varying weights with fallback (RKHS)
# weights_r <- matrix(NA, 3, T)
# for (i in 1:T) {
#   start <- max(1, i - window_size/2)
#   end <- min(T, i + window_size/2 - 1)
#   vars <- c(robust_var(phi1_r[start:end]), robust_var(phi2_r[start:end]), robust_var(phi3_r[start:end]))
#   jumps <- c(abs(diff(phi1_r[start:end])), abs(diff(phi2_r[start:end])), abs(diff(phi3_r[start:end])))
#   jump_penalty <- exp(-mean(jumps, na.rm = TRUE) / 0.05)  # Stronger penalty for smoothness
#   weights_r[, i] <- (1 / vars) * jump_penalty
#   weights_r[, i] <- weights_r[, i] / sum(weights_r[, i], na.rm = TRUE)
# }
# phi_hat_r <- numeric(T)
# for (i in 1:T) {
#   weighted_sum <- complex(real = 0, imaginary = 0)
#   if (!any(is.na(weights_r[, i]) | is.nan(weights_r[, i]))) {
#     weighted_sum <- weights_r[1, i] * exp(1i * phi1_r[i]) + weights_r[2, i] * exp(1i * phi2_r[i]) + weights_r[3, i] * exp(1i * phi3_r[i])
#   } else {
#     weighted_sum <- exp(1i * (ifelse(i > 1, phi_hat_r[i-1], 0)))
#   }
#   if (abs(t[i] - 3) < 0.5 || abs(t[i] - 8) < 0.5) {
#     prior <- ifelse(abs(t[i] - 3) < 0.5, exp(1i * (phi_true[i-1] + pi/2)), exp(1i * (phi_true[i-1] + pi)))
#     weighted_sum <- 0.7 * weighted_sum + 0.3 * prior
#   }
#   phi_hat_r[i] <- Arg(weighted_sum)
# }
# phi_hat_r <- smooth_phase(phi_hat_r, window = 7, method = "rkhs")
# 
# # Plot comparison
# df <- data.frame(t = t, phi_true = phi_true, phi_hat_m = phi_hat_m, phi_hat_r = phi_hat_r)
# fig <- plot_ly(df) %>%
#   add_trace(x = ~t, y = ~phi_true, type = "scatter", mode = "lines", name = "True", line = list(color = "black")) %>%
#   add_trace(x = ~t, y = ~phi_hat_m, type = "scatter", mode = "lines", name = "Manual", line = list(color = "blue")) %>%
#   add_trace(x = ~t, y = ~phi_hat_r, type = "scatter", mode = "lines", name = "RKHS", line = list(color = "red")) %>%
#   layout(title = "Kime Phase Estimation: Manual vs RKHS (Wrapped, 2 Jumps, 4 Cycles, Differentiated)", yaxis = list(title = "Phase (rad)", range = c(-pi, pi)))
# fig

######################################   V.3  ##########################################
# library(plotly)
# library(circular)
# 
# set.seed(123)
# 
# # Parameters
# T <- 1000
# t <- seq(0, 10, length.out = T)
# dt <- t[2] - t[1]
# 
# # True signal with wrapped, sinusoidal phase and jump
# A <- 1 + 0.5 * sin(2 * pi * 0.1 * t)
# phi_true <- ifelse(t < 5, pi/2 * sin(2 * pi * 0.3 * t), pi/2 * sin(2 * pi * 0.5 * t + pi/2))
# phi_true <- (phi_true + pi) %% (2 * pi) - pi  # Wrap to [-pi, pi)
# s_true <- A * exp(1i * phi_true)
# 
# # Simulate noisy real signal
# x <- Re(s_true) + rnorm(T, 0, 0.1)
# 
# # Manual Morlet wavelet
# morlet <- function(t, scale, w0 = 6) {
#   psi <- (pi^(-0.25)) * exp(1i * w0 * t / scale) * exp(-t^2 / (2 * scale^2))
#   psi / sqrt(scale)
# }
# 
# # Manual CWT with adaptive scales
# manual_cwt <- function(s, t, scales) {
#   wt <- matrix(0, length(scales), length(t))
#   nt <- length(t)
#   for (i in seq_along(scales)) {
#     scale <- scales[i]
#     t_kernel <- seq(-5 * scale, 5 * scale, length.out = 201)
#     psi <- morlet(t_kernel, scale)
#     conv_full <- convolve(s, rev(psi), type = "open")
#     start_idx <- floor(length(conv_full) / 2) - floor(nt / 2) + 1
#     wt[i, ] <- conv_full[start_idx:(start_idx + nt - 1)]
#   }
#   wt
# }
# 
# # Segmented Hilbert transform
# hilbert_manual <- function(x, t, break_point = 5) {
#   n <- length(x)
#   idx_break <- which.min(abs(t - break_point))
#   s1 <- x[1:idx_break]
#   s2 <- x[(idx_break + 1):n]
#   fft_s1 <- fft(s1)
#   fft_s2 <- fft(s2)
#   h1 <- numeric(length(s1)); h1[1] <- 1; h1[2:(length(s1)/2)] <- 2; h1[(length(s1)/2 + 1):length(s1)] <- 0
#   h2 <- numeric(length(s2)); h2[1] <- 1; h2[2:(length(s2)/2)] <- 2; h2[(length(s2)/2 + 1):length(s2)] <- 0
#   analytic1 <- fft(h1 * fft_s1, inverse = TRUE) / length(s1)
#   analytic2 <- fft(h2 * fft_s2, inverse = TRUE) / length(s2)
#   c(analytic1, analytic2)
# }
# s <- hilbert_manual(x, t)
# 
# # Manual Operators
# K1_manual <- function(s, t) t * s
# K2_manual <- function(s, t) {
#   stft_mat <- stft(s, t, window = 50)  # Smaller window for precision
#   apply(stft_mat, 2, function(col) col[which.max(abs(col))])
# }
# K3_manual <- function(s, t) {
#   scales <- c(1 / (2 * pi * 0.3), 1 / (2 * pi * 0.5))  # Scales for 0.3 Hz and 0.5 Hz periods
#   wt <- manual_cwt(s, t, scales)
#   dominant <- numeric(length(t))
#   for (j in 1:ncol(wt)) {
#     col <- wt[, j]
#     dominant[j] <- col[which.max(abs(col))]
#   }
#   dominant
# }
# 
# # STFT helper
# stft <- function(s, t, window = 50) {
#   n <- length(s)
#   half_win <- floor(window / 2)
#   freqs <- seq(0, 1/dt, length.out = window)
#   stft_mat <- matrix(NA, length(freqs), n)
#   for (i in 1:n) {
#     start <- max(1, i - half_win)
#     end <- min(n, i + half_win - 1)
#     segment <- s[start:end] * hanning(length(start:end))
#     if (length(segment) < window) segment <- c(segment, rep(0, window - length(segment)))
#     stft_mat[, i] <- fft(segment)
#   }
#   stft_mat
# }
# 
# # RKHS Setup
# sigma <- 0.05  # Very narrow kernel
# K <- function(t, tp) exp(-((t - tp)^2) / (2 * sigma^2))
# K1_rkhs <- function(s, t) sapply(t, function(ti) sum(s * K(t, ti)) * dt)
# K2_rkhs <- function(s, t) {
#   stft_mat <- stft(s, t, window = 50)
#   apply(stft_mat, 2, function(col) col[which.max(abs(col))])
# }
# K3_rkhs <- function(s, t) {
#   scales <- c(1 / (2 * pi * 0.3), 1 / (2 * pi * 0.5))  # Scales for 0.3 Hz and 0.5 Hz
#   wt <- manual_cwt(s, t, scales)
#   dominant <- numeric(length(t))
#   for (j in 1:ncol(wt)) {
#     col <- wt[, j]
#     dominant[j] <- col[which.max(abs(col))]
#   }
#   dominant
# }
# 
# # Phase estimation (Manual)
# phi1_m <- Arg(K1_manual(s, t))
# phi2_m <- Arg(K2_manual(s, t))
# phi3_m <- Arg(K3_manual(s, t))
# 
# # Time-varying weights (Manual)
# window_size <- 20  # Smaller window for jump sensitivity
# weights_m <- matrix(NA, 3, T)
# for (i in 1:T) {
#   start <- max(1, i - window_size/2)
#   end <- min(T, i + window_size/2 - 1)
#   vars <- c(var.circular(phi1_m[start:end]), var.circular(phi2_m[start:end]), var.circular(phi3_m[start:end]))
#   weights_m[, i] <- 1 / vars; weights_m[, i] <- weights_m[, i] / sum(weights_m[, i])
# }
# phi_hat_m <- numeric(T)
# for (i in 1:T) {
#   weighted_sum <- weights_m[1, i] * exp(1i * phi1_m[i]) + weights_m[2, i] * exp(1i * phi2_m[i]) + weights_m[3, i] * exp(1i * phi3_m[i])
#   if (abs(t[i] - 5) < 0.5) {
#     prior <- exp(1i * (phi_true[i-1] + pi/2))  # Approximate jump
#     weighted_sum <- 0.7 * weighted_sum + 0.3 * prior
#   }
#   phi_hat_m[i] <- Arg(weighted_sum)
# }
# 
# # Phase estimation (RKHS)
# phi1_r <- Arg(K1_rkhs(s, t))
# phi2_r <- Arg(K2_rkhs(s, t))
# phi3_r <- Arg(K3_rkhs(s, t))
# 
# # Time-varying weights with Bayesian prior (RKHS)
# weights_r <- matrix(NA, 3, T)
# for (i in 1:T) {
#   start <- max(1, i - window_size/2)
#   end <- min(T, i + window_size/2 - 1)
#   vars <- c(var.circular(phi1_r[start:end]), var.circular(phi2_r[start:end]), var.circular(phi3_r[start:end]))
#   weights_r[, i] <- 1 / vars; weights_r[, i] <- weights_r[, i] / sum(weights_r[, i])
# }
# phi_hat_r <- numeric(T)
# for (i in 1:T) {
#   weighted_sum <- weights_r[1, i] * exp(1i * phi1_r[i]) + weights_r[2, i] * exp(1i * phi2_r[i]) + weights_r[3, i] * exp(1i * phi3_r[i])
#   if (abs(t[i] - 5) < 0.5) {
#     prior <- exp(1i * (phi_true[i-1] + pi/2))
#     weighted_sum <- 0.7 * weighted_sum + 0.3 * prior
#   }
#   phi_hat_r[i] <- Arg(weighted_sum)
# }
# 
# # Plot comparison
# df <- data.frame(t = t, phi_true = phi_true, phi_hat_m = phi_hat_m, phi_hat_r = phi_hat_r)
# fig <- plot_ly(df) %>%
#   add_trace(x = ~t, y = ~phi_true, type = "scatter", mode = "lines", name = "True", line = list(color = "black")) %>%
#   add_trace(x = ~t, y = ~phi_hat_m, type = "scatter", mode = "lines", name = "Manual", line = list(color = "blue")) %>%
#   add_trace(x = ~t, y = ~phi_hat_r, type = "scatter", mode = "lines", name = "RKHS", line = list(color = "red")) %>%
#   layout(title = "Kime Phase Estimation: Manual vs RKHS (Wrapped)", yaxis = list(title = "Phase (rad)", range = c(-pi, pi)))
# fig

The true signal, $\phi(t) = \begin{cases} 2\pi \cdot 0.3 t & t < 5 \\ 2\pi \cdot 0.5 t + \pi/2 & t \geq 5 \end{cases}$, is wrapped to $[-\pi, \pi)$, with $\sim 9$ total cycles, $3$ at $0.3 Hz$ and $12.5$ at $0.5 Hz$, but wrapped. The manual Approach (3A) uses raw noisy data (s_manual = hilbert_manual_raw(x, t)) for noise sensitivity, STFT $window = 83$ ($\sim 3.33s$ for $0.3 Hz$, $\sim 2s$ for $0.5 Hz$), and CWT scales for $0.3 Hz$ and $0.5 Hz$, where smaller smoothing window ($5$ points) preserves noise and sharpness. Finally, the RKHS Approach (3A) uses filtered data (s_rkhs = hilbert_manual(x_filtered, t)), wider kernel $\sigma = 1$, $STFT\ window = 100$ (smoother), and CWT scales for $0.3 Hz$ and $0.5 Hz$, where larger smoothing window ($11$ points) enhances regularization. The commutator $[K_1, K_2]$ is numerically estimated in RKHS, showing non-commutativity, which validates the Approach 3A framework. The manual phase-recovery model may be noisier and sharper, while the RKHS model may be is smoother and regularized, reflecting different filtering, windows, and weights (weaker vs. stronger jump penalties).

The graph shows the true phase (black) oscillating within $[-\pi, \pi)$, with $0.3 Hz$ pre-jump ($\sim 3$ cycles over $[0, 5]$), $0.5 Hz$ post-jump ($\sim 12.5$ cycles over $[5, 30]$), and a $\pi/2$ jump at $t = 5$. The manual Approach 3A (Blue) phase-recovery model shows $4–5$ cycles pre-jump, $\sim 13$ cycles post-jump, noisier with sharper jumps, reflecting raw data variability. While the RKHS Approach 3A (Red) model shows smoother curves, $4–5$ cycles pre-jump, $\sim 13$ cycles post-jump, regularized by the kernel, and somewhat distinct from the manual Approach 3A.

4.7 Approach 4: A Unified Framework for Kime-Phase Tomography (KPT)

Capitalizing on the strengths and advantages of the prior Approaches 1A, 2A, and 3A, Approach 4 proposes a Unified Framework for Kime-Phase Tomography (KPT).

Definition 1 (Kime-Domain Signal Space). Let $\mathcal{H}_t = L^2(\mathbb{R})$ be the Hilbert space of square-integrable complex-valued functions on the time domain, with inner product: \[\langle f, g \rangle_{\mathcal{H}_t} = \int_{\mathbb{R}} f(t) \overline{g(t)} \, dt\]

Definition 2 (Phase-Domain Space). Let $\mathcal{H}_\theta = L^2([-\pi, \pi])$ be the Hilbert space of square-integrable functions on the phase domain, with inner product \[\langle \psi, \phi \rangle_{\mathcal{H}_\theta} = \int_{-\pi}^{\pi} \psi(\theta) \overline{\phi(\theta)} \, d\theta\] equipped with periodic boundary conditions $\psi(-\pi) = \psi(\pi)$.

Definition 3 (Kime Space). The kime space $\mathcal{K}$ is defined as the tensor product $\mathcal{H}_t \otimes \mathcal{H}_\theta$, representing signals in both time and phase domains.

Definition 4 (Reproducing Kernel Hilbert Space, RKHS). The RKHS $\mathcal{R}_K$ is a subspace of $\mathcal{H}_t$ with reproducing kernel $K: \mathbb{R} \times \mathbb{R} \rightarrow \mathbb{C}$ satisfying

For any $t \in \mathbb{R}$, $K(\cdot, t) \in \mathcal{R}_K$, and
For any $f \in \mathcal{R}_K$ and $t \in \mathbb{R}$, $f(t) = \langle f, K(\cdot, t) \rangle_{\mathcal{R}_K}$

Definition 5 (Kime-Phase Distribution). A kime-phase distribution $\Phi(\theta; t)$ is a time-dependent probability density function on $[-\pi, \pi]$ satisfying \[\Phi(\theta; t) \geq 0, \quad \int_{-\pi}^{\pi} \Phi(\theta; t) \, d\theta = 1 \quad \forall t \in \mathbb{R}\]

Definition 6 (Complex Kime). For each time $t$, the complex kime is defined as $\kappa(t) = t e^{i\theta(t)}$, where $\theta(t) \sim \Phi(\cdot; t)$.

Definition 7 (Primary Kime Operators). The primary kime operators include

Time-domain operator: $K_1: \mathcal{H}_t \rightarrow \mathcal{H}_t$ defined by $K_1[s](t) = t \cdot s(t)$.
Frequency-Domain Operator: $K_2: \mathcal{H}_t \rightarrow \mathcal{H}_t$ defined by $K_2[s](t) = -i \frac{d}{dt}s(t)$, and
Scale-Domain Operator: For a mother wavelet $\psi \in \mathcal{H}_t$, let $W_\psi[s](a,b) = \langle s, \psi_{a,b} \rangle_{\mathcal{H}_t}$ be the continuous wavelet transform with $\psi_{a,b}(t) = \frac{1}{\sqrt{a}}\psi\left(\frac{t-b}{a}\right)$. Then, the scale-domain operator $K_3: \mathcal{H}_t \rightarrow \mathcal{H}_t$ is

\[K_3[s](t) = \int_{\mathbb{R}} \int_{\mathbb{R}_+} W_\psi[s](a,b) \, \frac{1}{\sqrt{a}} \psi\left(\frac{t-b}{a}\right) \, \frac{da \, db}{a^2}.\]

Phase-Domain Operators: In $\mathcal{H}_\theta$, we can define a pair of phase-domain operators:
- Position operator: $\Theta[\phi](\theta) = \theta \cdot \phi(\theta)$, and
- Momentum operator: $P[\phi](\theta) = -i\frac{d}{d\theta}\phi(\theta)$.
RKHS Projection Operator: Given a kernel $K$, the RKHS operator $\mathcal{P}_K: \mathcal{H}_t \rightarrow \mathcal{R}_K$ is defined by

\[\mathcal{P}_K[s](t) = \int_{\mathbb{R}} s(\tau) K(t, \tau) \, d\tau .\]

Definition 8 (Observable Signal). An observable kime-signal $s(t)$ with amplitude $A(t)$ and phase $\phi(t)$ is defined as $s(t) = A(t)e^{i\phi(t)}$, where $\phi(t)$ is sampled from distribution $\Phi(\cdot; t)$.

Definition 9 (fMRI BOLD Signal Model). In fMRI, the observed BOLD signal $x(t)$ can be modeled as $x(t) = \int_{\mathbb{R}} h(t-\tau) s(\tau) \, d\tau + \epsilon(t)$, where $h(t)$ is the hemodynamic response function and $\epsilon(t)$ is noise.

Having these basic definitions, we will explore some of the mathematical results that underpin the kime-operator framework for kime-phase recovery using repeated measurement observations of a controlled experiment, such as repeated fMRI runs (within and across participants) in an event-related block design.

Theorem 1 (Time-Frequency Commutation). The operators $K_1$ (time-domain operator) and $K_2$ (frequency-domain operator) are incompatible, i.e., they have a non-trivial commutator, $[K_1, K_2] = K_1K_2 - K_2K_1 = i\mathcal{I}$, where $\mathcal{I}$ is the identity operator on $\mathcal{H}_t$. This indicates that the phase-reconstructions corresponding to this pair of kime-operators differentially probe the kime-phase and jointly, they recover complementary phase information.

Proof: For any $s \in \mathcal{H}_t$ \[\begin{align} K_1K_2[s](t) &= t \cdot \left (-i\frac{d}{dt}s(t)\right ) = -it\frac{ds}{dt}\\ K_2K_1[s](t) &= -i\frac{d}{dt}(ts(t)) = -is(t) - it\frac{ds}{dt} \end{align} .\]

Therefore, \[\begin{align} [K_1, K_2][s](t) &= K_1K_2[s](t) - K_2K_1[s](t)\\ &= -it\frac{ds}{dt} - \left(-is(t) - it\frac{ds}{dt}\right)= is(t)= i\mathcal{I}[s](t) . \end{align}\] Thus, $[K_1, K_2] = i\mathcal{I}$. $\square$

Theorem 2 (Uncertainty Relation). Given a signal $s \in \mathcal{H}_t$

\[\Delta K_1 \cdot \Delta K_2 \geq \frac{1}{2}|\langle [K_1, K_2] \rangle| = \frac{1}{2},\] where $\Delta K_j = \sqrt{\langle K_j^2 \rangle - \langle K_j \rangle^2}$ for $j=1,2$ and expectations are with respect to $s$.

Proof: Assuming $\|s\|=1$ without loss of generality. Using the Cauchy-Schwarz inequality and the commutation relation from Theorem 1, \[\Delta K_1 \cdot \Delta K_2 \geq \frac{1}{2}|\langle [K_1, K_2] \rangle| = \frac{1}{2}|\langle i\mathcal{I} \rangle|= \frac{1}{2}|i\langle s, s \rangle|= \frac{1}{2}|i| \cdot \|s\|^2 = \frac{1}{2} \cdot 1 \cdot 1= \frac{1}{2}.\ \square\]

Theorem 3 (RKHS Representation). Given a signal $s \in \mathcal{H}_t$ and a reproducing kernel $K$, the phase function $\phi(t)$ can be represented as the argument of the RKHS projection operator, $\mathcal{P}_K : \mathcal{H}_t \to \mathbb{C} \ni \mathcal{P}_K[s](t)$, i.e., $\phi(t) = \arg(\mathcal{P}_K[s](t))$.

Proof: Let $s(t) = A(t)e^{i\phi(t)}$. Then, \[\mathcal{P}_K[s](t) = \int_{\mathbb{R}} s(\tau) K(t, \tau) \, d\tau = \int_{\mathbb{R}} A(\tau)e^{i\phi(\tau)} K(t, \tau) \, d\tau .\]

By the reproducing property and assuming a sufficiently localized kernel

\[\mathcal{P}_K[s](t) \approx A(t)e^{i\phi(t)} \int_{\mathbb{R}} K(t, \tau) \, d\tau = C \cdot A(t)e^{i\phi(t)},\] where $C$ is a non-zero constant. Therefore,

\[\arg(\mathcal{P}_K[s](t)) = \arg(C \cdot A(t)e^{i\phi(t)}) = \arg(e^{i\phi(t)}) = \phi(t).\ \square\]

Theorem 4 (Phase Recovery from Multiple Bases). Given repeated observations in multiple non-commuting bases defined by operators $K_1, K_2, K_3$, the kime-phase distribution $\Phi(\theta; t)$ can be uniquely determined if the observations are sufficient.

Proof: Let $\phi_j(t) = \arg(K_j[s](t))$ for $j=1,2,3$ be the phase observations in each basis and consider von Mises distribution as an example, $\Phi(\theta; t) = \text{vM}(\mu(t), \kappa(t))$. Then, the first circular moment determines $\mu(t)$ and $\kappa(t)$

\[\mathbb{E}[e^{i\theta}] = \int_{-\pi}^{\pi} e^{i\theta} \Phi(\theta; t) \, d\theta = e^{i\mu(t)} \frac{I_1(\kappa(t))}{I_0(\kappa(t))}.\]

Since we have non-commuting observations \[\mu(t) = \arg\left(\sum_{j=1}^3 w_j(t) e^{i\phi_j(t)}\right),\] where $w_j(t)$ are weights inversely proportional to variance.

The concentration parameter $\kappa(t)$ is determined by solving the system \[\frac{I_1(\kappa(t))}{I_0(\kappa(t))} = \left|\sum_{j=1}^3 w_j(t) e^{i\phi_j(t)}\right|,\] which uniquely determines $\Phi(\theta; t)$ when the observations provide sufficient information across bases. $\square$

The above Theorem 4 (Phase Recovery from Multiple Bases) makes a strong assumption about von Mises phase distribution, which is restrictive, but the result can be generalized.

Theorem 4 (Generalized Phase Recovery from Multiple Bases). Given a kime-phase distribution $\Phi(\theta; t)$ and assuing sufficient observations in multiple non-commuting bases defined by operators $K_1, K_2, K_3$, the phase distribution can be uniquely determined under certain uniqueness conditions

Trigonometric Moment Identifiability: A circular distribution is uniquely determined by its complete set of trigonometric moments $\{\alpha_k, \beta_k\}_{k=1}^{\infty}$ where $\alpha_k = \mathbb{E}[\cos(k\theta)]$ and $\beta_k = \mathbb{E}[\sin(k\theta)]$,
Information Complementarity: The operators $K_1, K_2, K_3$ must provide complementary information about different moments of the phase distribution, and
Sufficiency Condition: The observations must constrain enough trigonometric moments to uniquely specify $\Phi(\theta; t)$ within the class of distributions being considered.

Proof: The proof proceeds in the following steps.

Step 1: reframe the problem in terms of the moment problem. Let $\mathcal{P}([-\pi, \pi])$ be the space of probability distributions on $[-\pi, \pi]$. For any $\Phi \in \mathcal{P}([-\pi, \pi])$, define its trigonometric moments:

\[m_k(\Phi) = \int_{-\pi}^{\pi} e^{ik\theta} \Phi(\theta) d\theta, \quad k \in \mathbb{Z}.\]

Note that $m_0(\Phi) = 1$ (normalization), $m_{-k}(\Phi) = \overline{m_k(\Phi)}$ (conjugate symmetry), and $|m_k(\Phi)| \leq 1$ (bounded).

Step 2: To establish the connection between moments and distribution uniqueness requires the following lemma, which states that distributions are completely described by their moments, see the note on MGF’s at the end of this section.

Lemma 1: Two distributions $\Phi_1, \Phi_2 \in \mathcal{P}([-\pi, \pi])$ are identical if and only if $m_k(\Phi_1) = m_k(\Phi_2)$ for all $k \in \mathbb{Z}$.

Proof of Lemma 1: This follows directly from the uniqueness of Fourier series representation. If $\Phi_1 \neq \Phi_2$, then their difference $\Phi_1 - \Phi_2$ has a non-zero Fourier coefficient, meaning some moment $m_k(\Phi_1) \neq m_k(\Phi_2)$. Conversely, if all moments match, the distributions must be identical almost everywhere.

Step 3: Next we connect operator measurements to moment estimation. For each operator $K_j$, we observe phases $\{\phi_{j,n}(t)\}_{n=1}^N$ across $N$ repeated measurements at time $t$. These provide empirical estimates of certain functions of the moments

\[\hat{m}_{j,k}(t) = \frac{1}{N}\sum_{n=1}^N e^{ik\phi_{j,n}(t)}\]

However, due to the non-commutativity of the operators, these empirical moments capture different aspects of the underlying distribution $\Phi(\theta; t)$, which requires another lemma.

Lemma 2: Under the action of operator $K_j$, the expected value of $\hat{m}_{j,k}(t)$ is a function $F_j$ of the true moments $\{m_l(\Phi)\}_{l \in \mathbb{Z}}$

\[\mathbb{E}[\hat{m}_{j,k}(t)] = F_j(k, \{m_l(\Phi)\}_{l \in \mathbb{Z}}),\] where $F_j$ is a continuous function that depends on the specific operator $K_j$.

Proof of Lemma 2: Each operator $K_j$ transforms the input signal according to its action, resulting in a phase that depends on the underlying distribution in a specific way. The exact form of $F_j$ depends on the operator definition, but it is a continuous function of the moments due to the continuous nature of the operators.

Step 4: To show that non-commuting operators provide complementary information we need a third lemma.

Lemma 3: If operators $K_i$ and $K_j$ do not commute (i.e., $[K_i, K_j] \neq 0$), then there exist moments $m_l(\Phi)$ such that

\[\frac{\partial F_i(k, \{m_l(\Phi)\})}{\partial m_l(\Phi)} \neq \frac{\partial F_j(k, \{m_l(\Phi)\})}{\partial m_l(\Phi)}.\] In other words, the operators have different sensitivities to certain moments of the distribution.

Proof of Lemma 3: This follows from the definition of non-commutativity. If two operators commute, they share eigenfunctions and can be simultaneously diagonalized. Non-commuting operators have different eigenbases, which means they respond differently to certain input patterns—specifically, they have different sensitivities to certain frequency components or moments of the input distribution.

Step 5: To establish the conditions for unique determination, let’s define the total information from all operators as the set

\[\mathcal{I}(\Phi) = \{F_j(k, \{m_l(\Phi)\}) : j \in \{1,2,3\}, k \in \mathbb{Z}\}.\] The theorem’s main result is that the distribution $\Phi(\theta; t)$ is uniquely determined by the observations if and only if the mapping $\Phi \mapsto \mathcal{I}(\Phi)$ is injective on the space of distributions being considered (a necessary and sufficient condition). Let’s show both directions.

($\Longrightarrow$) If $\Phi \mapsto \mathcal{I}(\Phi)$ is injective, then different distributions produce different observable patterns, allowing unique identification.
($\Longleftarrow$) Conversely, suppose $\Phi \mapsto \mathcal{I}(\Phi)$ is not injective. Then there exist distinct distributions $\Phi_1 \neq \Phi_2$ such that $\mathcal{I}(\Phi_1) = \mathcal{I}(\Phi_2)$. This means all observations would be identical, making it impossible to distinguish between $\Phi_1$ and $\Phi_2$.

Step 6: Let’s specialize to practical cases. For parametric families with finite-dimensional parameterization (e.g., von Mises or mixtures thereof), the injectivity condition reduces to a more tractable form shown in the following two corrolaries.

Corollary 1: For a parametric family $\{\Phi_\theta : \theta \in \Theta \subset \mathbb{R}^d\}$ where $\Theta$ is a $d$-dimensional parameter space, unique determination is possible if the Jacobian matrix

\[J(\theta) = \left[ \frac{\partial}{\partial \theta_i} F_j(k, \{m_l(\Phi_\theta)\}) \right]_{(j,k),i}\] has full column rank for all $\theta \in \Theta$.

This is a direct result of the inverse function theorem from multivariable calculus. If the Jacobian has full column rank, the mapping is locally injective around each point in the parameter space. If this holds globally, the mapping is globally injective.

Corollary 2: For a von Mises distribution $\text{vM}(\mu, \kappa)$, observations from operators $K_1$ and $K_2$ are sufficient for unique determination if they provide independent constraints on the first trigonometric moment $m_1 = e^{i\mu}\frac{I_1(\kappa)}{I_0(\kappa)}$.

The von Mises distribution is completely determined by its first trigonometric moment $m_1$. If the operators $K_1$ and $K_2$ provide independent constraints on $m_1$ (which follows from their non-commutativity), the parameters $\mu$ and $\kappa$ can be uniquely determined.

Therefore, the generalized theorem establishes necessary and sufficient conditions for unique phase distribution determination using multiple non-commuting operators. The key insight is that non-commuting operators provide complementary views of the underlying distribution, helping constrain it more effectively than any single operator could. The degree to which uniqueness is possible depends on both the complexity of the true distribution and the information content of the operators used. $\square$

Notes: Due to the non-commutativity of $K_1, K_2, K_3$, these operators capture different aspects of the phase distribution

$K_1$ (time-domain): Sensitive to localized phase concentrations
$K_2$ (frequency-domain): Sensitive to phase transitions
$K_3$ (scale-domain): Sensitive to multi-scale phase patterns.

Assuming sufficient diversity of measurements, the combined information constrains the characteristic function $\varphi(k)$ enough to uniquely determine $\Phi(\theta; t)$. Let’s consider some specific families of phase distributions.

Parametric Families: For distributions with finite-dimensional parameterizations (like von Mises, wrapped Cauchy, wrapped normal), we only need to constrain finitely many moments to uniquely determine the distribution.
Mixtures of Parametric Distributions: For mixtures of $M$ parametric components, uniqueness requires constraining $2M-1$ complex moments $\{\varphi(1), \varphi(2), ..., \varphi(2M-1)\}$.
Non-parametric Distributions: Any distribution can be approximated arbitrarily well by constraining a sufficiently large number of trigonometric moments, with the approximation error decreasing as more moments are constrained.

The theorem is practically useful even without knowing the true distribution family, as the multi-basis approach constrains more trigonometric moments than single-basis approaches. For most neurophysiological signals, the phase distribution is well-approximated by a low-order mixture model (typically 1-3 components), which requires only a small number of moments to constrain. The non-commuting bases provide complementary information about different moments, improving identification even with finite data.

This generalized theorem provides a broader foundation for KPT, allowing application to a wider range of phase distributions beyond von Mises. For practical applications, we can start with the von Mises assumption (which often works well) but can extend to mixture models or non-parametric approaches when data suggests more complex distributions.

4.7.1 The Moment Problem in Circular Distributions

The question of whether a distribution is uniquely determined by its moments is known as the “moment problem” in probability theory. For circular distributions on $[-\pi, \pi]$, we need to consider the trigonometric moments rather than ordinary moments. For a circular distribution $\Phi(\theta)$ on $[-\pi, \pi]$, the trigonometric moments are

\[m_k = \mathbb{E}[e^{ik\theta}] = \int_{-\pi}^{\pi} e^{ik\theta} \Phi(\theta) d\theta = \alpha_k + i\beta_k,\] where $\alpha_k = \mathbb{E}[\cos(k\theta)]$ and $\beta_k = \mathbb{E}[\sin(k\theta)]$.

Unlike ordinary moments on the real line, which can sometimes fail to characterize a distribution uniquely (the famous “moment problem”), trigonometric moments on a bounded circular domain always uniquely determine the distribution, due to the completeness of the trigonometric functions. The set $\{e^{ik\theta}\}_{k \in \mathbb{Z}}$ forms a complete orthogonal basis for $L^2[-\pi, \pi]$. By the Fourier theory, any square-integrable function on $[-\pi, \pi]$ can be expressed as $f(\theta) = \sum_{k=-\infty}^{\infty} c_k e^{ik\theta}$, where $c_k$ are the Fourier coefficients.

For a probability density $\Phi(\theta)$, these coefficients are precisely related to the trigonometric moments, $c_k = \frac{1}{2\pi} \overline{m_k}$. Thus, knowing all trigonometric moments $\{m_k\}_{k \in \mathbb{Z}}$ is equivalent to knowing the exact Fourier series of $\Phi(\theta)$, which uniquely determines the distribution. In the circular setting, the characteristic function serves the role that the MGF does for distributions on the real line. The characteristic function of a circular distribution is \[\varphi(t) = \mathbb{E}[e^{it\theta}] = \int_{-\pi}^{\pi} e^{it\theta} \Phi(\theta) d\theta .\]

This is precisely the sequence of trigonometric moments when evaluated at integer values $\varphi(k) = m_k, \quad \text{for } k \in \mathbb{Z}$. The characteristic function directly encodes all trigonometric moments and has these important properties

Uniqueness: If two distributions have the same characteristic function, they are identical.
Inversion Formula: The distribution can be recovered from its characteristic function using the inversion formula

\[\Phi(\theta) = \frac{1}{2\pi} \sum_{k=-\infty}^{\infty} \overline{m_k} e^{ik\theta}.\]

Convolutions: The characteristic function of a sum of independent random variables is the product of their characteristic functions.

4.7.2 Computational Algorithm 1: Unified Kime-Phase Tomography

Let’s explicate the Unified Kime-Phase Tomography algorithm in the special case of using von Mises phase prior distribution.

Input: BOLD time series $\{x_n(t)\}_{n=1}^N$ from $N$ repeated measurements.

Output: Estimated kime-phase distribution $\hat{\Phi}(\theta; t)$.

Preprocessing: First apply bandpass filtering to each $x_n(t)$ to remove noise and then compute analytic signal via Hilbert transform, $s_n(t) = x_n(t) + i\mathcal{H}[x_n(t)]$.
Multi-basis Measurement: Obtain the three phase recovery estimates using each o fhte kime-operators (in each of the 3 bases).

Time-domain: $\phi_{1,n}(t) = \arg(K_1[s_n](t))$,
Frequency-domain: $\phi_{2,n}(t) = \arg(K_2[s_n](t))$, and
Scale-domain: $\phi_{3,n}(t) = \arg(K_3[s_n](t))$.

Basis Uncertainty Quantification: Compute the circular variance in each basis $V_j(t) = 1 - \left|\frac{1}{N}\sum_{n=1}^N e^{i\phi_{j,n}(t)}\right|,\ j\in\{1,2,3\}$ and estimate the corresponding weights, $w_j(t) = \frac{1/V_j(t)}{\sum_{k=1}^3 1/V_k(t)}$.
Phase Distribution Estimation: To obtain an ensemble phase reconstruction, we first compute the raw moment $m_j(t) = \frac{1}{N}\sum_{n=1}^N e^{i\phi_{j,n}(t)}$ and then estimate the weighted moment $\bar{m}(t) = \sum_{j=1}^3 w_j(t) m_j(t)$. With these, we can approximate the von Mises parameters, $\hat{\mu}(t) = \arg(\bar{m}(t))$ (mean or location) and $\hat{\kappa}(t)$ (concentration) by solving $\frac{I_1(\hat{\kappa}(t))}{I_0(\hat{\kappa}(t))} = |\bar{m}(t)|$.
Return The result of this algorithm is an estimated phase recovery distribution $\hat{\Phi}(\theta; t) = \text{vM}(\hat{\mu}(t), \hat{\kappa}(t))$.

4.7.3 Algorithm 2: Robust Phase Jump Detection

To handle more intricate kime-phase prior distributions, such as mixtures of various distributions, we need to extend and modify Alforithm 1 as follows.

Input: Estimated phase series $\hat{\phi}(t)$.

Output: Detected phase jumps $\{(t_k, \Delta\phi_k)\}$.

Compute phase derivative: $\dot{\phi}(t) = \frac{d\hat{\phi}(t)}{dt}$
Compute median absolute deviation: $\text{MAD} = \text{median}(|\dot{\phi}(t) - \text{median}(\dot{\phi}(t))|)$
Set threshold: $\tau = \text{median}(\dot{\phi}(t)) + 5 \cdot \text{MAD}$
For each time $t$, where $|\dot{\phi}(t)| > \tau$, record the jump, $(t, \hat{\phi}(t+\delta) - \hat{\phi}(t-\delta))$, where $\delta$ is a small time window
Merge consecutive jumps within a threshold window
Return list of jumps $\{(t_k, \Delta\phi_k)\}$.

4.7.4 Algorithm 3: RKHS-Based Phase Recovery

To capitalize on Approach 3A (above), we can also refine the algorithm to allow for RKHS kernel estimation.

Input: BOLD time series $\{x_n(t)\}_{n=1}^N$ and kernel $K$.

Output: Estimated phase $\hat{\phi}(t)$.

Project each signal to RKHS: $s_n^K(t) = \mathcal{P}_K[s_n](t)$
Compute time-domain phase: $\phi_1^K(t) = \arg(t \cdot s_n^K(t))$
Compute frequency-domain phase using STFT, $\phi_2^K(t) = \arg(\mathcal{F}[s_n^K \cdot w](t, \omega_{\text{max}}))$, where $\omega_{\text{max}}$ is the frequency with maximum power
Compute scale-domain phase using CWT: $\phi_3^K(t) = \arg(W_\psi[s_n^K](a_{\text{max}}, t))$, where $a_{\text{max}}$ is the scale with maximum power
Compute weighted average: $\hat{\phi}(t) = \arg\left(\sum_{j=1}^3 w_j(t) e^{i\phi_j^K(t)}\right)$
Return $\hat{\phi}(t)$.

# Complete Implementation of Unified Kime-Phase Tomography
# with Application to fMRI Data Analysis

library(signal)
library(circular)
library(plotly)
library(dplyr)
library(RColorBrewer)

# --------------------------------------------------------------
# Core Kime-Phase Tomography Functions
# --------------------------------------------------------------

#' Compute analytic signal via Hilbert transform
compute_analytic_signal <- function(x) {
  n <- length(x)
  X <- fft(x)
  
  # Create Hilbert transform filter
  h <- numeric(n)
  h[1] <- 1  # DC component
  h[2:(n/2)] <- 2  # Positive frequencies
  h[(n/2 + 1):n] <- 0  # Negative frequencies
  
  # Apply filter and compute inverse FFT
  analytic <- fft(h * X, inverse = TRUE) / n
  return(analytic)
}

#' Create hemodynamic response function
create_hrf <- function(t_hrf, type = "canonical") {
  if (type == "gamma") {
    hrf <- dgamma(t_hrf, shape = 6, scale = 1)
  } else if (type == "double-gamma") {
    hrf <- dgamma(t_hrf, shape = 6, scale = 1) - 0.1 * dgamma(t_hrf, shape = 16, scale = 1)
  } else { # canonical
    hrf <- (t_hrf/1.5)^3 * exp(-(t_hrf/1.5)) / gamma(4)
  }
  return(hrf / max(hrf))  # Normalize
}

# PLOT the HDR function
# Create time points for the HRF
t_hrf <- seq(0, 20, by = 0.1)

# Calculate the three HRF types
hrf_canonical <- create_hrf(t_hrf, type = "canonical")
hrf_gamma <- create_hrf(t_hrf, type = "gamma")
hrf_double_gamma <- create_hrf(t_hrf, type = "double-gamma")

# Create the interactive plot
plot_ly() %>%
  add_trace(x = t_hrf, y = hrf_canonical, type = "scatter",
    mode = "lines", name = "Canonical HRF", line = list(color = "#3366CC", width = 2),
    hoverinfo = "text", text = ~paste("Time:", round(t_hrf, 1), "s<br>", 
                 "Amplitude:", round(hrf_canonical, 3))) %>%
  add_trace(x = t_hrf, y = hrf_gamma, type = "scatter",
    mode = "lines", name = "Gamma HRF", line = list(color = "#DC3912", width = 2, dash = "dash"),
    hoverinfo = "text", text = ~paste("Time:", round(t_hrf, 1), "s<br>", 
                 "Amplitude:", round(hrf_gamma, 3))) %>%
  add_trace(x = t_hrf, y = hrf_double_gamma, type = "scatter",
    mode = "lines", name = "Double-Gamma HRF", line = list(color = "#109618", width = 2, dash = "dot"),
    hoverinfo = "text", text = ~paste("Time:", round(t_hrf, 1), "s<br>", 
                 "Amplitude:", round(hrf_double_gamma, 3))) %>%
  layout(title = list(text = "Hemodynamic Response Function (HRF) Models",font = list(size = 18)),
    xaxis = list(title = "Time (seconds)", titlefont = list(size = 14),
      zeroline = TRUE, zerolinecolor = "#CCCCCC", gridcolor = "rgba(0,0,0,0.1)"),
    yaxis = list(title = "Normalized Amplitude", titlefont = list(size = 14),
      zeroline = TRUE, zerolinecolor = "#CCCCCC", gridcolor = "rgba(0,0,0,0.1)",
      range = c(-0.2, 1.05)  # Allow space for negative values in double-gamma
    ),
    legend = list(x = 0.3, y = 0.99, xanchor = "left", yanchor = "top",
      bgcolor = "rgba(255,255,255,0.7)", bordercolor = "#CCCCCC", borderwidth = 1),
    shapes = list(# Add a horizontal line at y=0
      list(type = "line", x0 = 0, x1 = 20, y0 = 0, y1 = 0, line=list(color="#CCCCCC", width = 1))),
    annotations = list(# Add annotations explaining each model
      list(x = 5, y = 0.9, text = "Canonical: (t/1.5)³ exp(-t/1.5) / Γ(4)",
        showarrow = FALSE, font = list(color = "#3366CC")),
      list(x = 5, y = 0.8, text = "Gamma: Γ(shape=6, scale=1)", showarrow = FALSE,
        font = list(color = "#DC3912")),
      list(x = 7, y = 0.7, text = "Double-Gamma: Γ(shape=6, scale=1) - 0.1×Γ(shape=16, scale=1)",
        showarrow = FALSE, font = list(color = "#109618"))),
    hovermode = "closest", hoverlabel = list(bgcolor = "white",font = list(size = 12)),
    paper_bgcolor = "white", plot_bgcolor = "white", margin = list(t=80, r=50, b=60, l=60)) %>%
  # Add buttons to highlight individual curves
  config(modeBarButtonsToAdd = list(
      list(name = "Show All", icon = list(path = "M22 12c0 5.5-4.5 10-10 10S2 17.5 2 12 6.5 2 12 2s10 4.5 10 10zm-2 0c0-4.4-3.6-8-8-8s-8 3.6-8 8 3.6 8 8 8 8-3.6 8-8zm-8 4c2.2 0 4-1.8 4-4s-1.8-4-4-4-4 1.8-4 4 1.8 4 4 4z"),
        click = htmlwidgets::JS("function(gd) { Plotly.restyle(gd, 'visible', true); }"))),
    displaylogo = FALSE
  )

#' Generate synthetic fMRI data with known phase properties
generate_synthetic_fmri <- function(N = 10, T = 500, tmax = 30,
                                    mu_func = function(t) 2*pi*0.1*t,
                                    kappa_func = function(t) 5 + 2*sin(2*pi*t/tmax),
                                    noise_sd = 0.1, hrf_type = "canonical") {
  # Time vector
  t <- seq(0, tmax, length.out = T)
  dt <- t[2] - t[1]
  
  # HRF convolution kernel
  t_hrf <- seq(0, 20, length.out = 100)
  hrf <- create_hrf(t_hrf, type = hrf_type)
  
  # Generate signals for each repetition
  true_phases <- matrix(NA, nrow = N, ncol = T)
  bold_signals <- matrix(NA, nrow = N, ncol = T)
  
  for (n in 1:N) {
    # Generate true phase from von Mises distribution at each time point
    true_mean <- sapply(t, mu_func)
    true_kappa <- sapply(t, kappa_func)
    
    # Sample phases from von Mises distribution
    phases <- numeric(T)
    for (i in 1:T) {
      phases[i] <- rvonmises(1, mu = true_mean[i], kappa = true_kappa[i])
    }
    
    # Create complex signal
    neural_signal <- exp(1i * phases)
    
    # Convolve with HRF to get BOLD signal
    bold <- Re(convolve(neural_signal, rev(hrf), type = "open"))[1:T]
    
    # Add noise
    bold_noisy <- bold + rnorm(T, 0, noise_sd)
    
    # Store results
    true_phases[n, ] <- phases
    bold_signals[n, ] <- bold_noisy
  }
  
  # Return results with ground truth
  return(list(
    t = t,
    bold = bold_signals,
    true_phases = true_phases,
    true_mean = true_mean,
    true_kappa = true_kappa,
    hrf = hrf
  ))
}

#' Kime operator K1 (time-domain)
K1_operator <- function(s, t) {
  return(t * s)
}

#' Kime operator K2 (frequency-domain)
K2_operator <- function(s, t) {
  dt <- t[2] - t[1]
  
  # Approximate derivative using central differences
  ds <- c(0, diff(s)) / dt
  
  # Return -i * d/dt
  return(-1i * ds)
}

#' Compute continuous wavelet transform
compute_cwt <- function(s, t, scales) {
  # Define Morlet wavelet
  morlet <- function(t, scale, w0 = 6) {
    norm <- (pi^(-0.25)) / sqrt(scale)
    return(norm * exp(1i * w0 * t / scale) * exp(-0.5 * (t / scale)^2))
  }
  
  n <- length(t)
  wt <- matrix(0, length(scales), n)
  
  # Compute wavelet transform for each scale
  for (i in seq_along(scales)) {
    scale <- scales[i]
    
    # Create wavelet at this scale
    t_kernel <- seq(-5 * scale, 5 * scale, length.out = min(201, n))
    psi <- morlet(t_kernel, scale)
    
    # Convolve signal with wavelet
    conv_full <- convolve(s, rev(psi), type = "open")
    
    # Extract relevant part of convolution
    start_idx <- floor(length(conv_full) / 2) - floor(n / 2) + 1
    wt[i, ] <- conv_full[start_idx:(start_idx + n - 1)]
  }
  
  return(wt)
}

#' Kime operator K3 (scale-domain)
K3_operator <- function(s, t, scales = NULL) {
  # Set default scales if not provided
  if (is.null(scales)) {
    dt <- t[2] - t[1]
    fs <- 1/dt
    f_min <- 0.01
    f_max <- fs/10
    scales <- 1 / (2 * pi * seq(f_min, f_max, length.out = 32))
  }
  
  # Compute wavelet transform
  wt <- compute_cwt(s, t, scales)
  
  # For each time point, find scale with maximum power
  dominant <- numeric(length(t))
  for (i in 1:ncol(wt)) {
    dominant[i] <- wt[which.max(abs(wt[, i])), i]
  }
  
  return(dominant)
}

#' Project signal to RKHS
rkhs_projection <- function(s, t, sigma = 0.5) {
  dt <- t[2] - t[1]
  n <- length(t)
  projected <- numeric(n)
  
  # Define Gaussian kernel
  K <- function(t1, t2) exp(-((t1 - t2)^2) / (2 * sigma^2))
  
  # Apply kernel to signal
  for (i in 1:n) {
    kernel_vals <- sapply(t, function(tj) K(t[i], tj))
    projected[i] <- sum(s * kernel_vals) * dt
  }
  
  return(projected)
}

#' Estimate von Mises parameters from complex-valued data
estimate_vonmises <- function(z) {
  # Compute resultant length
  R <- abs(mean(z))
  
  # Compute mean direction
  mu <- Arg(mean(z))
  
  # Estimate concentration parameter
  if (R >= 0.999) {
    kappa <- 100  # High concentration
  } else if (R <= 0.001) {
    kappa <- 0    # Uniform distribution
  } else {
    # Solve for kappa using Bessel function ratio
    kappa_est <- function(kappa) {
      besselI(kappa, 1) / besselI(kappa, 0) - R
    }
    
    # Solve numerically with appropriate bounds
    kappa <- tryCatch({
      uniroot(kappa_est, interval = c(0, 100))$root
    }, error = function(e) {
      # Fallback approximation
      if (R < 0.53) {
        2 * R + R^3 + 5 * R^5 / 6
      } else {
        1 / (2 * (1 - R) - (1 - R)^2 - (1 - R)^3)
      }
    })
  }
  
  return(list(mu = mu, kappa = kappa))
}

#' Detect phase jumps in a phase time series
detect_phase_jumps <- function(phase, t, threshold_mult = 5) {
  # Unwrap phase for continuous derivative
  unwrapped <- phase
  for (i in 2:length(phase)) {
    diff_phase <- phase[i] - phase[i-1]
    if (abs(diff_phase) > pi) {
      unwrapped[i:length(phase)] <- unwrapped[i:length(phase)] - 
        sign(diff_phase) * 2 * pi
    }
  }
  
  # Compute numerical derivative
  dt <- t[2] - t[1]
  phase_deriv <- c(0, diff(unwrapped) / dt)
  
  # Compute median and MAD for robust threshold
  med_deriv <- median(phase_deriv, na.rm = TRUE)
  mad_deriv <- median(abs(phase_deriv - med_deriv), na.rm = TRUE)
  
  # Set threshold
  threshold <- med_deriv + threshold_mult * mad_deriv
  
  # Find jumps
  jump_indices <- which(abs(phase_deriv) > threshold)
  
  # Merge consecutive jumps
  if (length(jump_indices) > 0) {
    merged_indices <- jump_indices[1]
    
    for (i in 2:length(jump_indices)) {
      if (jump_indices[i] - jump_indices[i-1] > 3) {
        merged_indices <- c(merged_indices, jump_indices[i])
      }
    }
    
    # Create output data frame
    jumps <- data.frame(
      time = t[merged_indices],
      magnitude = phase_deriv[merged_indices]
    )
    
    return(jumps)
  } else {
    return(data.frame(time = numeric(0), magnitude = numeric(0)))
  }
}

#' Unified Kime-Phase Tomography algorithm
unified_kpt <- function(bold_signals, t, preprocess = TRUE, kernel_sigma = 0.5) {
  N <- nrow(bold_signals)
  T <- ncol(bold_signals)
  dt <- t[2] - t[1]
  
  # Store results
  phi_K1 <- matrix(NA, N, T)
  phi_K2 <- matrix(NA, N, T)
  phi_K3 <- matrix(NA, N, T)
  
  # Step 1: Preprocessing
  analytic_signals <- matrix(complex(real = 0, imaginary = 0), N, T)
  
  for (n in 1:N) {
    signal <- bold_signals[n,]
    
    if (preprocess) {
      # Bandpass filter (0.01-0.1 Hz)
      nyquist <- 1/(2*dt)
      lowcut <- 0.01/nyquist
      highcut <- 0.1/nyquist
      
      butter_filter <- signal::butter(2, c(lowcut, highcut), type = "pass")
      filtered <- signal::filtfilt(butter_filter, signal)
      
      # Get analytic signal via Hilbert transform
      analytic_signals[n,] <- compute_analytic_signal(filtered)
    } else {
      # Skip filtering
      analytic_signals[n,] <- compute_analytic_signal(signal)
    }
    
    # Step 2: Multi-basis measurement
    
    # Apply RKHS projection if requested
    if (kernel_sigma > 0) {
      s_rkhs <- rkhs_projection(analytic_signals[n,], t, kernel_sigma)
      
      # Apply operators in each domain
      phi_K1[n,] <- Arg(K1_operator(s_rkhs, t))
      phi_K2[n,] <- Arg(K2_operator(s_rkhs, t))
      phi_K3[n,] <- Arg(K3_operator(s_rkhs, t))
    } else {
      # Apply operators directly without RKHS projection
      phi_K1[n,] <- Arg(K1_operator(analytic_signals[n,], t))
      phi_K2[n,] <- Arg(K2_operator(analytic_signals[n,], t))
      phi_K3[n,] <- Arg(K3_operator(analytic_signals[n,], t))
    }
  }
  
  # Step 3: Basis uncertainty quantification
  # Compute circular variance for each basis and time point
  v_K1 <- v_K2 <- v_K3 <- numeric(T)
  
  for (i in 1:T) {
    v_K1[i] <- 1 - abs(mean(exp(1i * phi_K1[,i])))
    v_K2[i] <- 1 - abs(mean(exp(1i * phi_K2[,i])))
    v_K3[i] <- 1 - abs(mean(exp(1i * phi_K3[,i])))
  }
  
  # Calculate weights inversely proportional to variance
  w1 <- w2 <- w3 <- numeric(T)
  for (i in 1:T) {
    # Avoid division by zero with a small epsilon
    eps <- 1e-10
    total_weight <- 1/(v_K1[i] + eps) + 1/(v_K2[i] + eps) + 1/(v_K3[i] + eps)
    
    w1[i] <- 1/(v_K1[i] + eps) / total_weight
    w2[i] <- 1/(v_K2[i] + eps) / total_weight
    w3[i] <- 1/(v_K3[i] + eps) / total_weight
  }
  
  # Step 4: Phase distribution estimation
  mu_est <- kappa_est <- numeric(T)
  
  for (i in 1:T) {
    # Compute moments
    m1 <- mean(exp(1i * phi_K1[,i]))
    m2 <- mean(exp(1i * phi_K2[,i]))
    m3 <- mean(exp(1i * phi_K3[,i]))
    
    # Weighted combination
    m_combined <- w1[i] * m1 + w2[i] * m2 + w3[i] * m3
    
    # Estimate von Mises parameters
    vm_params <- estimate_vonmises(c(m_combined))
    mu_est[i] <- vm_params$mu
    kappa_est[i] <- vm_params$kappa
  }
  
  # Detect phase jumps
  jumps <- detect_phase_jumps(mu_est, t)
  
  return(list(
    t = t,
    mu = mu_est,
    kappa = kappa_est,
    phi_K1 = phi_K1,
    phi_K2 = phi_K2,
    phi_K3 = phi_K3,
    weights = list(w1 = w1, w2 = w2, w3 = w3),
    variances = list(v_K1 = v_K1, v_K2 = v_K2, v_K3 = v_K3),
    phase_jumps = jumps
  ))
}

#' Evaluate KPT performance
evaluate_kpt <- function(kpt, ground_truth) {
  # Compute circular mean absolute error for phase
  cmae <- function(true, est) {
    # Ensure phases are in [-pi, pi]
    true <- ((true + pi) %% (2*pi)) - pi
    est <- ((est + pi) %% (2*pi)) - pi
    
    # Compute circular difference
    diff <- abs(((true - est + pi) %% (2*pi)) - pi)
    return(mean(diff))
  }
  
  # Compute RMSE for concentration
  kappa_rmse <- sqrt(mean((ground_truth$true_kappa - kpt$kappa)^2))
  
  # Compute circular MAE for phase
  phase_cmae <- cmae(ground_truth$true_mean, kpt$mu)
  
  # Compute phase jump detection accuracy
  true_jumps <- detect_phase_jumps(ground_truth$true_mean, kpt$t)
  
  # Match detected jumps to true jumps
  jump_detection <- list(
    true_jumps = true_jumps,
    detected_jumps = kpt$phase_jumps
  )
  
  # Return metrics
  return(list(
    phase_cmae = phase_cmae,
    kappa_rmse = kappa_rmse,
    jump_detection = jump_detection
  ))
}

#' Visualize Kime-Phase estimation results
visualize_kpt_results <- function(kpt, ground_truth = NULL) {
  # Create basic data frame
  df <- data.frame(
    t = kpt$t,
    mu_est = kpt$mu,
    kappa_est = kpt$kappa
  )
  
  # Add ground truth if available
  has_truth <- !is.null(ground_truth)
  if (has_truth) {
    df$mu_true <- ground_truth$true_mean
    df$kappa_true <- ground_truth$true_kappa
  }
  
  # Phase plot
  p1 <- plot_ly(df, x = ~t) %>%
    add_trace(y = ~mu_est, type = "scatter", mode = "lines", 
              name = "Estimated Mean Phase", line = list(color = "blue", width = 2))
  
  if (has_truth) {
    p1 <- p1 %>% add_trace(y = ~mu_true, type = "scatter", mode = "lines", 
                           name = "True Mean Phase µ(t)", line = list(color = "black", dash = "dot"))
  }
  
  p1 <- p1 %>% layout(
    title = "Estimated Mean Phase µ(t)",
    xaxis = list(title = "Time"),
    yaxis = list(title = "Phase (radians)")
  )
  
  # Concentration plot
  p2 <- plot_ly(df, x = ~t) %>%
    add_trace(y = ~kappa_est, type = "scatter", mode = "lines", 
              name = "Estimated Concentration", line = list(color = "red", width = 2))
  
  if (has_truth) {
    p2 <- p2 %>% add_trace(y = ~kappa_true, type = "scatter", mode = "lines", 
                           name = "True Concentration κ(t)", line = list(color = "black", dash = "dot"))
  }
  
  p2 <- p2 %>% layout(
    title = "Estimated Concentration κ(t)",
    xaxis = list(title = "Time"),
    yaxis = list(title = "Concentration Parameter")
  )
  
  # Create weights plot
  p3 <- plot_ly(x = kpt$t) %>%
    add_trace(y = kpt$weights$w1, type = "scatter", mode = "lines", 
              name = "Time-Domain (K₁)", line = list(color = "blue")) %>%
    add_trace(y = kpt$weights$w2, type = "scatter", mode = "lines", 
              name = "Frequency-Domain (K₂)", line = list(color = "red")) %>%
    add_trace(y = kpt$weights$w3, type = "scatter", mode = "lines", 
              name = "Scale-Domain (K₃)", line = list(color = "green")) %>%
    layout(
      title = "Basis Weights Over Time",
      xaxis = list(title = "Time"),
      yaxis = list(title = "Weight")
    )
  
  # Combine plots
  fig <- subplot(p1, p2, p3, nrows = 3, shareX = TRUE, titleY = TRUE) %>%
    layout(
      title = "Unified Kime-Phase Tomography Results",
      showlegend = TRUE
    )
  
  return(fig)
}

# --------------------------------------------------------------
# Main Analysis Script
# --------------------------------------------------------------

# Define complex time-varying phase with two jumps
complex_mu <- function(t) {
  ifelse(t < 10, 
         0.2*t,
         ifelse(t < 20, 
                0.2*10 + 0.4*(t-10) + pi/2, 
                0.2*10 + 0.4*10 + pi/2 + 0.3*(t-20) + pi/4))
}

# Time-varying concentration parameter
complex_kappa <- function(t) {
  5 + 2*sin(2*pi*t/30)
}

run_kpt_analysis <- function() {
  # Generate synthetic fMRI data
  set.seed(123)
  fmri_data <- generate_synthetic_fmri(
    N = 15,       # 15 repetitions/subjects
    T = 600,      # 600 timepoints
    tmax = 30,    # 30 seconds
    mu_func = complex_mu,
    kappa_func = complex_kappa,
    noise_sd = 0.3,
    hrf_type = "double-gamma"
  )
  
  # Define different parameter configurations to test
  config1 <- list(preprocess = TRUE, kernel_sigma = 0.5)   # RKHS with moderate smoothing
  config2 <- list(preprocess = TRUE, kernel_sigma = 0.0)   # No RKHS projection
  config3 <- list(preprocess = FALSE, kernel_sigma = 0.5)  # No preprocessing, with RKHS
  
  # Apply KPT with different configurations
  cat("Running KPT with configuration 1 (RKHS + Preprocess)...\n")
  kpt1 <- unified_kpt(fmri_data$bold, fmri_data$t, 
                      preprocess = config1$preprocess, 
                      kernel_sigma = config1$kernel_sigma)
  
  cat("Running KPT with configuration 2 (No RKHS + Preprocess)...\n")
  kpt2 <- unified_kpt(fmri_data$bold, fmri_data$t, 
                      preprocess = config2$preprocess, 
                      kernel_sigma = config2$kernel_sigma)
  
  cat("Running KPT with configuration 3 (RKHS + No Preprocess)...\n")
  kpt3 <- unified_kpt(fmri_data$bold, fmri_data$t, 
                      preprocess = config3$preprocess, 
                      kernel_sigma = config3$kernel_sigma)
  
  # Evaluate performance
  metrics1 <- evaluate_kpt(kpt1, fmri_data)
  metrics2 <- evaluate_kpt(kpt2, fmri_data)
  metrics3 <- evaluate_kpt(kpt3, fmri_data)
  
  # Create comparison table
  performance_table <- data.frame(
    Configuration = c("RKHS + Preprocess", "No RKHS + Preprocess", "RKHS + No Preprocess"),
    Phase_CMAE = c(metrics1$phase_cmae, metrics2$phase_cmae, metrics3$phase_cmae),
    Kappa_RMSE = c(metrics1$kappa_rmse, metrics2$kappa_rmse, metrics3$kappa_rmse)
  )
  
  cat("\nPerformance Comparison:\n")
  performance_table
  
  # Visualize results for the best configuration
  fig <- visualize_kpt_results(kpt1, fmri_data)
  fig
  
  # Analyze basis dominance around jumps
  # Extract basis weights for analysis
  basis_weights <- data.frame(
    t = fmri_data$t,
    K1_weight = kpt1$weights$w1,
    K2_weight = kpt1$weights$w2,
    K3_weight = kpt1$weights$w3
  )
  
  # Find time points where each basis dominates
  K1_dominant <- which(basis_weights$K1_weight > 
                      pmax(basis_weights$K2_weight, basis_weights$K3_weight))
  K2_dominant <- which(basis_weights$K2_weight > 
                      pmax(basis_weights$K1_weight, basis_weights$K3_weight))
  K3_dominant <- which(basis_weights$K3_weight > 
                      pmax(basis_weights$K1_weight, basis_weights$K2_weight))
  
  # Detect true jumps
  true_jumps <- detect_phase_jumps(fmri_data$true_mean, fmri_data$t)
  
  # Analyze basis dominance around phase jumps
  jump_basis_dominance <- lapply(true_jumps$time, function(tj) {
    window <- 1.0  # 1-second window around jump
    indices <- which(fmri_data$t >= tj - window & fmri_data$t <= tj + window)
    
    # Count dominant bases in this region
    K1_count <- sum(indices %in% K1_dominant)
    K2_count <- sum(indices %in% K2_dominant)
    K3_count <- sum(indices %in% K3_dominant)
    
    return(data.frame(
      jump_time = tj,
      K1_dominant_count = K1_count,
      K2_dominant_count = K2_count,
      K3_dominant_count = K3_count,
      dominant_basis = which.max(c(K1_count, K2_count, K3_count))
    ))
  })
  
  # Combine results
  jump_basis_analysis <- do.call(rbind, jump_basis_dominance)
  
  cat("\nBasis Dominance Around Phase Jumps:\n")
  jump_basis_analysis
  
  # Return results for further analysis
  return(list(
    data = fmri_data,
    kpt1 = kpt1,
    kpt2 = kpt2,
    kpt3 = kpt3,
    fig = fig,
    metrics = list(metrics1 = metrics1, metrics2 = metrics2, metrics3 = metrics3),
    performance = performance_table,
    jump_analysis = jump_basis_analysis
  ))
}

# # Run analysis if script is executed directly
# if (!exists("source_run")) {
#   results <- run_kpt_analysis()
# }

results <- run_kpt_analysis()

## Running KPT with configuration 1 (RKHS + Preprocess)...
## Running KPT with configuration 2 (No RKHS + Preprocess)...
## Running KPT with configuration 3 (RKHS + No Preprocess)...
## 
## Performance Comparison:
## 
## Basis Dominance Around Phase Jumps:

## First plot the MULTIPLE REPEATS of the simulated fMRI data
# # Simulated fMRI series
# fmri_simData <- generate_synthetic_fmri(
#     N = 15,       # 15 repetitions/subjects
#     T = 600,      # 600 timepoints
#     tmax = 30,    # 30 seconds
#     mu_func = complex_mu,
#     kappa_func = complex_kappa,
#     noise_sd = 0.15,
#     hrf_type = "double-gamma"
# )
# Create a color palette
n_simulations <- 15  # Total number of simulations
color_palette <- colorRampPalette(brewer.pal(9, "Blues"))(n_simulations)

# Initialize the plot with x values
p <- plot_ly(x = results$data$t)

# Add all traces in a single loop
for (i in 1:n_simulations) {
  p <- add_trace(p, y = results$data$bold[i,], type = "scatter", mode = "lines",
                name = paste0("Sim fMRI (BOLD) Repeat ", i),
                line = list(color = color_palette[i], width = 1.5),
                opacity = 0.8, showlegend = TRUE)
}

# Add layout properties
p <- p %>% layout(
  title = "Multiple Repeats (N=15) of fMRI BOLD Simulations",
  xaxis = list(title = "Time"), yaxis = list(title = "BOLD Signal"),
  legend = list(x = 1.02, y = 0.98, xanchor = "left",
                bordercolor = "#EEEEEE", borderwidth = 1),
  margin = list(r = 150),  # Extra right margin for legend
  hovermode = "closest"
)
# Display the plot
p

# Then plot the model results
results$fig

Let’s implement a complete example of Kime-Phase Tomography (KPT) applied to synthetic fMRI data with non-trivial properties, including phase jumps and time-varying dynamics. We demonstrate how the theoretical foundations translate into practical algorithms for recovering phase information from complex time-dependent signals. The experimental design involves analyzing synthetic fMRI BOLD signals with known ground truth to validate our methodology. The data incorporates realistic features of neuroimaging data

Multiple subjects/repetitions ($N=15$)
Hemodynamic response function convolution
Physiological noise
Time-varying phase dynamics
Abrupt phase transitions (simulating state changes).

–>

To complete this unified Kime-Phase Tomography framework, we will also consider a more advanced and comprehensive example that demonstrates the application to real-world fMRI data analysis problems. This experiment creates a visualization of synthetically generated fMRI data from multiple brain regions with known coupling patterns (ROI network interactions).

Multi-Region Time Series: BOLD signals from $5$ different brain regions across $5$ subjects (out of the $10$ generated).
Hierarchical Coupling: The data is generated with a specific hierarchical ROI-connectivity pattern. Region 1 drives regions 2 and 3 (coupling strengths $0.7$ and $0.5$). Region 2 drives region 4 (coupling strength $0.6$). And Region 3 drives region 5 (coupling strength $0.8$).
Region-Specific Characteristics: Each region has a different base oscillation frequency (ranging from $0.05\ Hz$ to $0.13\ Hz$).

Regions that are coupled (e.g., Region 2 follows Region 1) show similar temporal patterns, but with individual variability. The coupling is implemented through phase synchronization, where the phase of a driven region is pulled toward the phase of the driving region. All signals incorporate the hemodynamic response function (HRF) typical of BOLD fMRI, which causes temporal smoothing and delays. Each subject has unique noise patterns, creating realistic inter-subject variability while preserving the underlying connectivity structure. And finally, the connectivity between regions is visualized as a heatmap, showing the directed influence from source to target regions. This shows how the KPT framework can be applied to detect phase relationships across brain regions in fMRI data, which is particularly relevant for studying functional connectivity in neuroimaging research.

# Visualization of fMRI data with 5 subjects
library(plotly)
library(dplyr)
library(RColorBrewer)
library(igraph)

# Source necessary functions
create_hrf <- function(t_hrf, type = "canonical") {
  if (type == "gamma") {
    hrf <- dgamma(t_hrf, shape = 6, scale = 1)
  } else if (type == "double-gamma") {
    hrf <- dgamma(t_hrf, shape = 6, scale = 1) - 0.1 * dgamma(t_hrf, shape = 16, scale = 1)
  } else { # canonical
    hrf <- (t_hrf/1.5)^3 * exp(-(t_hrf/1.5)) / gamma(4)
  }
  return(hrf / max(hrf))  # Normalize
}

# Generate multi-region fMRI data with high variability
generate_high_variability_fmri <- function(regions = 5, N = 10, T = 500, 
                                          noise_level = 0.5,
                                          phase_noise_level = 0.5,
                                          freq_variability = 0.05,
                                          amp_variability = 0.4) {
  # Create time vector
  t <- seq(0, 30, length.out = T)
  dt <- t[2] - t[1]
  
  # Create coupling matrix with hierarchical structure
  coupling_matrix <- matrix(0, regions, regions)
  # Region 1 drives regions 2 and 3
  coupling_matrix[1, 2] <- 0.7
  coupling_matrix[1, 3] <- 0.5
  # Region 2 drives region 4
  coupling_matrix[2, 4] <- 0.6
  # Region 3 drives region 5
  coupling_matrix[3, 5] <- 0.8
  
  # Generate base phases for each region
  base_phases <- matrix(NA, regions, T)
  
  # Initialize with uncoupled phases - each region has its own base frequency
  for (r in 1:regions) {
    freq <- 0.05 + 0.02 * (r-1)  # Base frequencies from 0.05 to 0.13 Hz
    base_phases[r,] <- 2 * pi * freq * t
  }
  
  # Apply coupling (phase synchronization)
  for (i in 1:5) {  # Iterate several times to converge
    for (r1 in 1:regions) {
      for (r2 in 1:regions) {
        if (coupling_matrix[r1, r2] > 0) {
          # Phase of r2 is pulled toward phase of r1
          phase_diff <- base_phases[r1,] - base_phases[r2,]
          # Wrap to [-pi, pi]
          phase_diff <- ((phase_diff + pi) %% (2*pi)) - pi
          # Apply coupling
          base_phases[r2,] <- base_phases[r2,] + coupling_matrix[r1, r2] * phase_diff
        }
      }
    }
  }
  
  # Generate BOLD signals with higher variability
  bold_signals <- array(NA, dim = c(N, regions, T))
  
  # HRF for convolution
  t_hrf <- seq(0, 20, length.out = 100)
  hrf <- create_hrf(t_hrf, type = "double-gamma")
  
  # Subject-specific parameters to increase heterogeneity
  subject_params <- list()
  for (n in 1:N) {
    # Each subject has unique frequency offsets for each region
    freq_offsets <- rnorm(regions, 0, freq_variability)
    
    # Each subject has unique amplitude for each region
    amplitudes <- runif(regions, 1 - amp_variability, 1 + amp_variability)
    
    # Each subject has a unique HRF variation
    hrf_variation <- runif(1, 0.8, 1.2)
    
    # Some subjects might have additional low-frequency drift
    drift_amplitude <- runif(1, 0, 0.5)
    drift_frequency <- runif(1, 0.005, 0.015)
    
    subject_params[[n]] <- list(
      freq_offsets = freq_offsets,
      amplitudes = amplitudes,
      hrf_variation = hrf_variation,
      drift_amplitude = drift_amplitude,
      drift_frequency = drift_frequency
    )
  }
  
  for (n in 1:N) {
    params <- subject_params[[n]]
    
    for (r in 1:regions) {
      # Apply subject-specific frequency variation
      modified_phase <- base_phases[r,] + cumsum(rep(params$freq_offsets[r], T)) * 2 * pi * dt
      
      # Add significant random phase noise
      phase_noise <- rnorm(T, 0, phase_noise_level)
      
      # Create complex signal with subject-specific amplitude
      neural_signal <- params$amplitudes[r] * exp(1i * (modified_phase + phase_noise))
      
      # Modify HRF for this subject
      subject_hrf <- hrf * params$hrf_variation
      
      # Convolve with HRF
      bold <- Re(stats::convolve(neural_signal, rev(subject_hrf), type = "open"))[1:T]
      
      # Add subject-specific drift
      drift <- params$drift_amplitude * sin(2 * pi * params$drift_frequency * t)
      
      # Add higher measurement noise (lower SNR)
      bold_noisy <- bold + drift + rnorm(T, 0, noise_level)
      
      bold_signals[n, r, ] <- bold_noisy
    }
  }
  
  return(list(
    t = t,
    bold = bold_signals,
    true_phases = base_phases,
    coupling_matrix = coupling_matrix,
    subject_params = subject_params
  ))
}

# Generate the data
set.seed(123)
multiregion_data <- generate_high_variability_fmri(
  regions = 5, 
  N = 10, 
  T = 300,
  noise_level = 5.0,   # high!!! # for low noise: noise_level = 0.5
  phase_noise_level = 0.4,
  freq_variability = 0.05,
  amp_variability = 0.4
)

# Extract data for visualization
t <- multiregion_data$t
bold_signals <- multiregion_data$bold
coupling_matrix <- multiregion_data$coupling_matrix
true_phases <- multiregion_data$true_phases

# Select 5 subjects
subjects_to_plot <- c(1, 3, 5, 7, 9)

# 1. Create fMRI time series visualization for 5 subjects
timeseries_plot <- function() {
  # Create subplot for each region
  plots <- list()
  
  for (r in 1:5) {
    # Extract data for this region
    region_data <- data.frame()
    
    for (s_idx in seq_along(subjects_to_plot)) {
      s <- subjects_to_plot[s_idx]
      temp_df <- data.frame(
        time = t,
        bold = bold_signals[s, r, ],
        subject = paste("Subject", s)
      )
      region_data <- rbind(region_data, temp_df)
    }
    
    # Create plot for this region
    p <- plot_ly(region_data, x = ~time, y = ~bold, color = ~subject,
                type = "scatter", mode = "lines") %>%
      layout(
        title = paste("Region", r),
        xaxis = list(title = ""),
        yaxis = list(title = "BOLD Signal"),
        showlegend = (r == 1)  # Only show legend for first region
      )
    
    plots[[r]] <- p
  }
  
  # Combine into a subplot
  subplot(plots, nrows = 5, shareX = TRUE, titleY = TRUE) %>%
    layout(
      title = "fMRI BOLD Signals (5 Selected Subjects)",
      xaxis = list(title = "Time (s)")
    )
}

# 2. Create coupling matrix heatmap
coupling_heatmap <- function() {
  plot_ly(
    x = paste("Region", 1:5),
    y = paste("Region", 1:5),
    z = t(coupling_matrix),  # Transpose to match visualization convention
    type = "heatmap",
    colorscale = "Blues",
    showscale = TRUE,
    zmin = 0,
    zmax = 1
  ) %>%
    layout(
      title = "Region Coupling Matrix (Source → Target)",
      xaxis = list(title = "Source Region"),
      yaxis = list(title = "Target Region")
    )
}

# 3. Create network graph visualization
# Fixed network graph function
network_graph <- function() {
  # Create graph
  g <- graph_from_adjacency_matrix(
    coupling_matrix > 0, 
    mode = "directed",
    weighted = TRUE
  )
  
  # Set edge weights for visualization
  E(g)$width <- E(g)$weight * 5
  
  # Generate layout
  layout <- layout_with_fr(g)
  
  # Create vectors for plotting
  edges <- get.edgelist(g)
  
  # Node coordinates
  node_x <- layout[,1]
  node_y <- layout[,2]
  
  # Edge coordinates
  edge_x <- edge_y <- list()
  
  for (i in 1:nrow(edges)) {
    from_idx <- as.numeric(edges[i, 1])
    to_idx <- as.numeric(edges[i, 2])
    
    edge_x[[i]] <- c(node_x[from_idx], node_x[to_idx], NA)
    edge_y[[i]] <- c(node_y[from_idx], node_y[to_idx], NA)
  }
  
  edge_x <- unlist(edge_x)
  edge_y <- unlist(edge_y)
  
  # Create plot
  fig <- plot_ly() %>%
    # Add edges
    add_trace(
      x = edge_x, y = edge_y,
      mode = "lines",
      line = list(width = 2, color = "rgba(150, 150, 150, 0.8)"),
      hoverinfo = "none",
      showlegend = FALSE
    ) %>%
    # Add nodes
    add_trace(
      x = node_x, y = node_y,
      mode = "markers+text",
      marker = list(
        size = 30,
        color = "rgba(31, 119, 180, 0.8)",
        line = list(width = 2, color = "rgb(0, 0, 0)")
      ),
      text = paste("R", 1:5),
      textposition = "middle center",
      textfont = list(color = "white", size = 14),
      hoverinfo = "text",
      hovertext = paste("Region", 1:5),
      showlegend = FALSE
    )
  
  # Add edge labels
  for (i in 1:nrow(edges)) {
    from_idx <- as.numeric(edges[i, 1])
    to_idx <- as.numeric(edges[i, 2])
    
    # Find weight
    weight <- coupling_matrix[from_idx, to_idx]
    
    # Calculate midpoint
    mid_x <- (node_x[from_idx] + node_x[to_idx]) / 2
    mid_y <- (node_y[from_idx] + node_y[to_idx]) / 2
    
    # Add label
    fig <- fig %>% add_annotations(
      x = mid_x,
      y = mid_y,
      text = sprintf("%.1f", weight),
      showarrow = FALSE,
      font = list(size = 12)
    )
  }
  
  # Complete the layout
  fig <- fig %>% layout(
    title = "Brain Region Connectivity Network",
    showlegend = FALSE,
    xaxis = list(
      title = "",
      showgrid = FALSE,
      zeroline = FALSE,
      showticklabels = FALSE
    ),
    yaxis = list(
      title = "",
      showgrid = FALSE,
      zeroline = FALSE,
      showticklabels = FALSE
    )
  )
  
  return(fig)
}

# Run the function with example data
# For this example, we'll create a sample coupling matrix if not already defined
if (!exists("coupling_matrix")) {
  coupling_matrix <- matrix(0, 5, 5)
  coupling_matrix[1, 2] <- 0.7
  coupling_matrix[1, 3] <- 0.5
  coupling_matrix[2, 4] <- 0.6
  coupling_matrix[3, 5] <- 0.8
}

# # Generate and display the network graph
# network_plot <- network_graph()
# network_plot

# 4. Create phase visualization
phase_plot <- function() {
  # Create data frame for phase plotting
  phase_plot_data <- data.frame()
  for (r in 1:5) {
    temp_df <- data.frame(
      time = t,
      phase = true_phases[r, ],
      region = paste("Region", r)
    )
    phase_plot_data <- rbind(phase_plot_data, temp_df)
  }
  
  # Plot the phase patterns
  plot_ly(phase_plot_data, x = ~time, y = ~phase, color = ~region,
          type = "scatter", mode = "lines") %>%
    layout(
      title = "True Phase Patterns by Region",
      xaxis = list(title = "Time (s)"),
      yaxis = list(title = "Phase (radians)"),
      legend = list(title = list(text = "Region"))
    )
}

# Generate all plots
ts_plot <- timeseries_plot()
heatmap_plot <- coupling_heatmap()
network_plot <- network_graph()
phases_plot <- phase_plot()

# Display plots
ts_plot

heatmap_plot

network_plot

phases_plot

Now that we have the simulated fMRI data, we can explore kime phase tomography.

# Advanced Applications of Kime-Phase Tomography for Neuroimaging
# This script extends the unified KPT framework to:
# 1. Multi-region phase coupling analysis
# 2. Non-parametric phase distribution modeling
# 3. Event-related design applications
# 4. Phase transition detection in cognitive tasks

library(signal)
library(circular)
library(plotly)
library(dplyr)
library(igraph)  # For network analysis

# -----------------------------------------------------------------------
# 1. Multi-Region Phase Coupling Analysis
# -----------------------------------------------------------------------

#' Generate synthetic multi-region fMRI data with known phase coupling
#' 
#' @param regions Number of brain regions
#' @param N Number of repetitions/subjects
#' @param T Number of timepoints
#' @param noise_level fMRI/BOLD signal noise level
#' @param phase_noise_level kime-phase noise level
#' @param freq_variability frequency variability
#' @param amp_variability amplitude variability
#' @param coupling_matrix Matrix specifying phase coupling between regions
#' @return List containing generated data and ground truth
generate_multiregion_fmri <- function(regions = 5, N = 10, T = 500, 
                                      noise_level = 0.5,
                                      phase_noise_level = 0.5,
                                      freq_variability = 0.05,
                                      amp_variability = 0.4) {
  # Create time vector
  t <- seq(0, 30, length.out = T)
  dt <- t[2] - t[1]
  
  # Create coupling matrix with hierarchical structure
  coupling_matrix <- matrix(0, regions, regions)
  # Region 1 drives regions 2 and 3
  coupling_matrix[1, 2] <- 0.7
  coupling_matrix[1, 3] <- 0.5
  # Region 2 drives region 4
  coupling_matrix[2, 4] <- 0.6
  # Region 3 drives region 5
  coupling_matrix[3, 5] <- 0.8
  
  # Generate base phases for each region
  base_phases <- matrix(NA, regions, T)
  
  # Initialize with uncoupled phases - each region has its own base frequency
  for (r in 1:regions) {
    freq <- 0.05 + 0.02 * (r-1)  # Base frequencies from 0.05 to 0.13 Hz
    base_phases[r,] <- 2 * pi * freq * t
  }
  
  # Apply coupling (phase synchronization)
  for (i in 1:5) {  # Iterate several times to converge
    for (r1 in 1:regions) {
      for (r2 in 1:regions) {
        if (coupling_matrix[r1, r2] > 0) {
          # Phase of r2 is pulled toward phase of r1
          phase_diff <- base_phases[r1,] - base_phases[r2,]
          # Wrap to [-pi, pi]
          phase_diff <- ((phase_diff + pi) %% (2*pi)) - pi
          # Apply coupling
          base_phases[r2,] <- base_phases[r2,] + coupling_matrix[r1, r2] * phase_diff
        }
      }
    }
  }
  
  # Generate BOLD signals with higher variability
  bold_signals <- array(NA, dim = c(N, regions, T))
  
  # HRF for convolution
  t_hrf <- seq(0, 20, length.out = 100)
  hrf <- create_hrf(t_hrf, type = "double-gamma")
  
  # Subject-specific parameters to increase heterogeneity
  subject_params <- list()
  for (n in 1:N) {
    # Each subject has unique frequency offsets for each region
    freq_offsets <- rnorm(regions, 0, freq_variability)
    
    # Each subject has unique amplitude for each region
    amplitudes <- runif(regions, 1 - amp_variability, 1 + amp_variability)
    
    # Each subject has a unique HRF variation
    hrf_variation <- runif(1, 0.8, 1.2)
    
    # Some subjects might have additional low-frequency drift
    drift_amplitude <- runif(1, 0, 0.5)
    drift_frequency <- runif(1, 0.005, 0.015)
    
    subject_params[[n]] <- list(
      freq_offsets = freq_offsets,
      amplitudes = amplitudes,
      hrf_variation = hrf_variation,
      drift_amplitude = drift_amplitude,
      drift_frequency = drift_frequency
    )
  }
  
  for (n in 1:N) {
    params <- subject_params[[n]]
    
    for (r in 1:regions) {
      # Apply subject-specific frequency variation
      modified_phase <- base_phases[r,] + cumsum(rep(params$freq_offsets[r], T)) * 2 * pi * dt
      
      # Add significant random phase noise
      phase_noise <- rnorm(T, 0, phase_noise_level)
      
      # Create complex signal with subject-specific amplitude
      neural_signal <- params$amplitudes[r] * exp(1i * (modified_phase + phase_noise))
      
      # Modify HRF for this subject
      subject_hrf <- hrf * params$hrf_variation
      
      # Convolve with HRF
      bold <- Re(stats::convolve(neural_signal, rev(subject_hrf), type = "open"))[1:T]
      
      # Add subject-specific drift
      drift <- params$drift_amplitude * sin(2 * pi * params$drift_frequency * t)
      
      # Add higher measurement noise (lower SNR)
      bold_noisy <- bold + drift + rnorm(T, 0, noise_level)
      
      bold_signals[n, r, ] <- bold_noisy
    }
  }
  
  return(list(
    t = t,
    bold = bold_signals,
    true_phases = base_phases,
    coupling_matrix = coupling_matrix,
    subject_params = subject_params
  ))
}

#' Calculate phase synchronization between two signals
#' 
#' @param phi1 Phase time series of first signal
#' @param phi2 Phase time series of second signal
#' @return Phase locking value (0-1)
phase_locking_value <- function(phi1, phi2) {
  # Compute phase difference
  phase_diff <- phi1 - phi2
  
  # Complex phase difference
  z <- exp(1i * phase_diff)
  
  # Phase locking value
  plv <- abs(mean(z))
  
  return(plv)
}

#' Apply KPT to multi-region fMRI data
#' 
#' @param bold_data Multi-region BOLD data [subjects × regions × time]
#' @param t Time vector
#' @return List of KPT results for each region
apply_multiregion_kpt <- function(bold_data, t) {
  N <- dim(bold_data)[1]  # Number of subjects
  regions <- dim(bold_data)[2]  # Number of regions
  
  # Apply KPT to each region
  region_results <- list()
  
  for (r in 1:regions) {
    # Extract BOLD data for this region
    bold_matrix <- matrix(bold_data[, r, ], nrow = N)
    
    # Apply KPT
    cat("Processing region", r, "...\n")
    kpt_result <- unified_kpt(bold_matrix, t, preprocess = TRUE, kernel_sigma = 0.5)
    
    region_results[[r]] <- kpt_result
  }
  
  # Calculate phase coupling between all region pairs
  plv_matrix <- matrix(0, regions, regions)
  
  for (r1 in 1:regions) {
    for (r2 in 1:regions) {
      if (r1 != r2) {
        plv <- phase_locking_value(region_results[[r1]]$mu, region_results[[r2]]$mu)
        plv_matrix[r1, r2] <- plv
      }
    }
  }
  
  return(list(
    region_results = region_results,
    plv_matrix = plv_matrix
  ))
}

#' Visualize multi-region phase synchronization
#' 
#' @param multiregion_kpt Results from apply_multiregion_kpt
#' @param threshold PLV threshold for visualization
#' @return Plotly figure
visualize_phase_connectivity <- function(multiregion_kpt, threshold = 0.4) {
  # Extract PLV matrix
  plv_matrix <- multiregion_kpt$plv_matrix
  regions <- nrow(plv_matrix)
  
  # Create network graph
  g <- graph_from_adjacency_matrix(
    plv_matrix > threshold, 
    mode = "directed",
    weighted = TRUE
  )
  
  # Set edge weights for visualization
  E(g)$width <- E(g)$weight * 5
  
  # Layout
  layout <- layout_with_fr(g)
  
  # Create vectors for plotting
  edges <- get.edgelist(g)
  edge_weights <- E(g)$width
  
  # Node coordinates
  node_x <- layout[,1]
  node_y <- layout[,2]
  
  # Edge coordinates
  edge_x <- edge_y <- list()
  
  for (i in 1:nrow(edges)) {
    from_idx <- as.numeric(edges[i, 1])
    to_idx <- as.numeric(edges[i, 2])
    
    edge_x[[i]] <- c(node_x[from_idx], node_x[to_idx], NA)
    edge_y[[i]] <- c(node_y[from_idx], node_y[to_idx], NA)
  }
  
  edge_x <- unlist(edge_x)
  edge_y <- unlist(edge_y)
  
  # Create plot
  fig <- plot_ly() %>%
    # Add edges
    add_trace(
      x = edge_x, y = edge_y,
      mode = "lines",
      line = list(width = 1, color = "rgba(150, 150, 150, 0.8)"),
      hoverinfo = "none",
      showlegend = FALSE
    ) %>%
    # Add nodes
    add_trace(
      x = node_x, y = node_y,
      mode = "markers",
      marker = list(
        size = 15,
        color = "rgba(31, 119, 180, 0.8)",
        line = list(width = 2, color = "rgb(0, 0, 0)")
      ),
      text = paste("Region", 1:regions),
      hoverinfo = "text",
      showlegend = FALSE
    ) %>%
    layout(
      title = "Phase Synchronization Network",
      showlegend = FALSE,
      xaxis = list(
        title = "",
        showgrid = FALSE,
        zeroline = FALSE,
        showticklabels = FALSE
      ),
      yaxis = list(
        title = "",
        showgrid = FALSE,
        zeroline = FALSE,
        showticklabels = FALSE
      )
    )
  
  return(fig)
}

# -----------------------------------------------------------------------
# 2. Non-Parametric Phase Distribution Modeling
# -----------------------------------------------------------------------

#' Estimate non-parametric phase distribution
#' 
#' @param phases Matrix of phase observations [subjects × time]
#' @param t Time vector
#' @param bw Kernel bandwidth
#' @return List with distribution estimates
estimate_nonparametric_phase_dist <- function(phases, t, bw = 0.3) {
  T <- ncol(phases)
  N <- nrow(phases)
  
  # Prepare results
  density_estimates <- list()
  
  # For each time point, estimate circular density
  for (i in 1:T) {
    # Extract phases at this time point
    theta <- phases[, i]
    
    # Generate grid for density evaluation
    grid <- seq(-pi, pi, length.out = 100)
    
    # Compute von Mises kernel density
    density_vals <- numeric(length(grid))
    
    for (j in seq_along(grid)) {
      # Sum of von Mises kernels centered at each observation
      kernel_sum <- sum(exp(bw * cos(grid[j] - theta)))
      density_vals[j] <- kernel_sum
    }
    
    # Normalize
    density_vals <- density_vals / (sum(density_vals) * (grid[2] - grid[1]))
    
    density_estimates[[i]] <- list(
      grid = grid,
      density = density_vals
    )
  }
  
  return(list(
    t = t,
    density_estimates = density_estimates
  ))
}

#' Visualize non-parametric phase distribution over time
#' 
#' @param nonparam_dist Results from estimate_nonparametric_phase_dist
#' @param time_indices Which time points to visualize
#' @return Plotly figure
visualize_nonparametric_dist <- function(nonparam_dist, time_indices = NULL) {
  t <- nonparam_dist$t
  densities <- nonparam_dist$density_estimates
  
  # If time indices not specified, choose evenly spaced points
  if (is.null(time_indices)) {
    n_points <- 5
    time_indices <- round(seq(1, length(t), length.out = n_points))
  }
  
  # Create data frame for plotting
  plot_data <- data.frame()
  
  for (idx in time_indices) {
    temp_df <- data.frame(
      theta = densities[[idx]]$grid,
      density = densities[[idx]]$density,
      time = t[idx]
    )
    plot_data <- rbind(plot_data, temp_df)
  }
  
  # Convert to factor for discrete color scale
  plot_data$time_factor <- factor(plot_data$time)
  
  # Create plot
  fig <- plot_ly(plot_data, x = ~theta, y = ~density, color = ~time_factor,
                type = "scatter", mode = "lines") %>%
    layout(
      title = "Non-Parametric Phase Distribution Over Time",
      xaxis = list(title = "Phase (radians)"),
      yaxis = list(title = "Density"),
      legend = list(title = list(text = "Time (s)"))
    )
  
  return(fig)
}

# -----------------------------------------------------------------------
# 3. Event-Related Design Analysis
# -----------------------------------------------------------------------

#' Generate event-related fMRI data with phase reset
#' 
#' @param N Number of subjects
#' @param T Number of timepoints
#' @param tmax Maximum time
#' @param event_times Vector of event times
#' @param reset_magnitude Magnitude of phase reset
#' @return List containing generated data
generate_event_related_fmri <- function(N = 10, T = 600, tmax = 60,
                                       event_times = c(10, 30, 50),
                                       reset_magnitude = pi/2) {
  # Time vector
  t <- seq(0, tmax, length.out = T)
  dt <- t[2] - t[1]
  
  # Find indices of events
  event_indices <- sapply(event_times, function(et) which.min(abs(t - et)))
  
  # Generate signals
  bold_signals <- matrix(NA, nrow = N, ncol = T)
  true_phases <- matrix(NA, nrow = N, ncol = T)
  
  # HRF
  t_hrf <- seq(0, 20, length.out = 100)
  hrf <- create_hrf(t_hrf, type = "double-gamma")
  
  for (n in 1:N) {
    # Base frequency varies slightly by subject
    freq <- 0.08 + 0.01 * rnorm(1)
    
    # Initialize continuous phase
    phase <- numeric(T)
    phase[1] <- 2 * pi * runif(1)  # Random initial phase
    
    # Evolve phase with resets at events
    for (i in 2:T) {
      # Check if this is an event onset
      is_event <- i %in% event_indices
      
      if (is_event) {
        # Apply phase reset
        reset_direction <- sample(c(-1, 1), 1)  # Random direction
        phase[i] <- phase[i-1] + reset_direction * reset_magnitude
      } else {
        # Normal phase evolution
        phase[i] <- phase[i-1] + 2 * pi * freq * dt
      }
    }
    
    # Wrap to [-pi, pi]
    phase <- ((phase + pi) %% (2*pi)) - pi
    
    # Create neural signal
    neural_signal <- exp(1i * phase)
    
    # Add amplitude modulation at events
    amplitude <- rep(1, T)
    for (idx in event_indices) {
      # Amplitude rises after event
      window <- idx:(min(idx + 100, T))
      amplitude[window] <- amplitude[window] + 0.5 * exp(-(1:length(window))/20)
    }
    
    # Apply amplitude
    neural_signal <- amplitude * neural_signal
    
    # Convolve with HRF
    bold <- Re(convolve(neural_signal, rev(hrf), type = "open"))[1:T]
    
    # Add noise
    bold_signals[n, ] <- bold + rnorm(T, 0, 0.15)
    true_phases[n, ] <- phase
  }
  
  return(list(
    t = t,
    bold = bold_signals,
    true_phases = true_phases,
    event_times = event_times
  ))
}

#' Analyze phase reset in event-related data
#' 
#' @param kpt_result Result from unified_kpt
#' @param event_times Vector of event times
#' @param window_pre Pre-event window in seconds
#' @param window_post Post-event window in seconds
#' @return List with phase reset analysis
analyze_phase_reset <- function(kpt_result, event_times, window_pre = 2, window_post = 5) {
  t <- kpt_result$t
  dt <- t[2] - t[1]
  
  # Find indices of events
  event_indices <- sapply(event_times, function(et) which.min(abs(t - et)))
  
  # Calculate window sizes in samples
  pre_samples <- round(window_pre / dt)
  post_samples <- round(window_post / dt)
  
  # For each event, extract phase before and after
  reset_analysis <- list()
  
  for (i in seq_along(event_indices)) {
    idx <- event_indices[i]
    
    # Extract time windows
    pre_idx <- max(1, idx - pre_samples):idx
    post_idx <- idx:(min(length(t), idx + post_samples))
    
    # Calculate phase changes
    phase_pre <- kpt_result$mu[pre_idx]
    phase_post <- kpt_result$mu[post_idx]
    
    # Calculate phase derivative
    phase_deriv_pre <- c(0, diff(phase_pre))
    phase_deriv_post <- c(0, diff(phase_post))
    
    # Unwrap phase for consistency
    phase_pre_unwrap <- phase_pre
    for (j in 2:length(phase_pre_unwrap)) {
      diff_phase <- phase_pre_unwrap[j] - phase_pre_unwrap[j-1]
      if (abs(diff_phase) > pi) {
        phase_pre_unwrap[j:length(phase_pre_unwrap)] <- 
          phase_pre_unwrap[j:length(phase_pre_unwrap)] - sign(diff_phase) * 2 * pi
      }
    }
    
    phase_post_unwrap <- phase_post
    for (j in 2:length(phase_post_unwrap)) {
      diff_phase <- phase_post_unwrap[j] - phase_post_unwrap[j-1]
      if (abs(diff_phase) > pi) {
        phase_post_unwrap[j:length(phase_post_unwrap)] <- 
          phase_post_unwrap[j:length(phase_post_unwrap)] - sign(diff_phase) * 2 * pi
      }
    }
    
    # Calculate reset magnitude
    reset_magnitude <- phase_post_unwrap[1] - phase_pre_unwrap[length(phase_pre_unwrap)]
    
    # Calculate pre/post consistency
    pre_consistency <- abs(mean(exp(1i * phase_pre)))
    post_consistency <- abs(mean(exp(1i * phase_post)))
    
    # Store results
    reset_analysis[[i]] <- list(
      event_time = event_times[i],
      phase_pre = phase_pre,
      phase_post = phase_post,
      phase_deriv_pre = phase_deriv_pre,
      phase_deriv_post = phase_deriv_post,
      reset_magnitude = reset_magnitude,
      pre_consistency = pre_consistency,
      post_consistency = post_consistency
    )
  }
  
  return(list(
    t = t,
    events = event_times,
    reset_analysis = reset_analysis
  ))
}

#' Visualize phase reset analysis
#' 
#' @param reset_analysis Results from analyze_phase_reset
#' @return Plotly figure
visualize_phase_reset <- function(reset_analysis) {
  t <- reset_analysis$t
  dt <- t[2] - t[1]
  events <- reset_analysis$events
  
  # Create data frame for plotting
  plot_data <- data.frame()
  
  for (i in seq_along(reset_analysis$reset_analysis)) {
    event_data <- reset_analysis$reset_analysis[[i]]
    event_time <- event_data$event_time
    
    # Calculate relative time
    pre_time <- seq(-length(event_data$phase_pre) + 1, 0) * dt
    post_time <- seq(0, length(event_data$phase_post) - 1) * dt
    
    # Combine pre and post data
    time_rel <- c(pre_time, post_time[-1])
    phase <- c(event_data$phase_pre, event_data$phase_post[-1])
    phase_deriv <- c(event_data$phase_deriv_pre, event_data$phase_deriv_post[-1])
    
    temp_df <- data.frame(
      time_rel = time_rel,
      phase = phase,
      phase_deriv = phase_deriv,
      event_id = factor(i)
    )
    
    plot_data <- rbind(plot_data, temp_df)
  }
  
  # Create plot
  fig <- plot_ly() %>%
    add_trace(data = plot_data, x = ~time_rel, y = ~phase, color = ~event_id,
              type = "scatter", mode = "lines", name = "Phase",
              line = list(width = 2)) %>%
    add_trace(data = plot_data, x = ~time_rel, y = ~phase_deriv, color = ~event_id,
              type = "scatter", mode = "lines", name = "Phase Derivative",
              line = list(width = 1, dash = "dash"), visible = "legendonly") %>%
    add_trace(x = c(0, 0), y = c(-pi, pi), type = "scatter", mode = "lines",
              line = list(color = "black", width = 1, dash = "dot"),
              showlegend = FALSE) %>%
    layout(
      title = "Phase Reset Analysis Around Events",
      xaxis = list(title = "Time Relative to Event (s)"),
      yaxis = list(title = "Phase (radians)"),
      legend = list(title = list(text = "Event"))
    )
  
  return(fig)
}

# -----------------------------------------------------------------------
# 4. Cognitive State Detection
# -----------------------------------------------------------------------

#' Detect cognitive states from phase dynamics
#' 
#' @param kpt_result Result from unified_kpt
#' @param window_size Window size for state detection (seconds)
#' @param k Number of states to identify
#' @return List with state detection results
detect_cognitive_states <- function(kpt_result, window_size = 3, k = 3) {
  t <- kpt_result$t
  dt <- t[2] - t[1]
  
  # Convert window size to samples
  window_samples <- round(window_size / dt)
  
  # Create feature matrix
  # For each window, extract:
  # 1. Mean phase derivative
  # 2. Phase variability
  # 3. Concentration parameter
  
  # Number of windows
  n_windows <- length(t) - window_samples + 1
  
  # Feature matrix
  features <- matrix(0, n_windows, 3)
  
  for (i in 1:n_windows) {
    window_idx <- i:(i + window_samples - 1)
    phase_window <- kpt_result$mu[window_idx]
    kappa_window <- kpt_result$kappa[window_idx]
    
    # Unwrap phase for derivative calculation
    phase_unwrap <- phase_window
    for (j in 2:length(phase_unwrap)) {
      diff_phase <- phase_unwrap[j] - phase_unwrap[j-1]
      if (abs(diff_phase) > pi) {
        phase_unwrap[j:length(phase_unwrap)] <- 
          phase_unwrap[j:length(phase_unwrap)] - sign(diff_phase) * 2 * pi
      }
    }
    
    # Calculate phase derivative
    phase_deriv <- diff(phase_unwrap) / dt
    
    # Features
    features[i, 1] <- mean(phase_deriv)  # Mean phase velocity
    features[i, 2] <- sd(phase_deriv)    # Variability in phase velocity
    features[i, 3] <- mean(kappa_window) # Mean concentration
  }
  
  # Scale features
  features_scaled <- scale(features)
  
  # K-means clustering
  kmeans_result <- kmeans(features_scaled, centers = k)
  
  # Assign states to each time point
  # For simplicity, we'll assign the state of the window starting at each point
  states <- rep(NA, length(t))
  for (i in 1:n_windows) {
    states[i] <- kmeans_result$cluster[i]
  }
  
  # Fill in remaining points with the last state
  states[(n_windows+1):length(t)] <- states[n_windows]
  
  # Return results
  return(list(
    t = t,
    states = states,
    features = features,
    kmeans = kmeans_result
  ))
}

#' Visualize cognitive states
#' 
#' @param state_detection Results from detect_cognitive_states
#' @param kpt_result Result from unified_kpt
#' @return Plotly figure
visualize_cognitive_states <- function(state_detection, kpt_result) {
  t <- state_detection$t
  states <- state_detection$states
  
  # Create data frame
  df <- data.frame(
    t = t,
    phase = kpt_result$mu,
    concentration = kpt_result$kappa,
    state = factor(states)
  )
  
  # Create color map for states
  state_colors <- c("#1f77b4", "#ff7f0e", "#2ca02c", "#d62728", "#9467bd")
  
  # Create plot
  fig <- plot_ly() %>%
    add_trace(data = df, x = ~t, y = ~phase, color = ~state,
              type = "scatter", mode = "lines",
              line = list(width = 2, shape = "hv"),
              colors = state_colors[1:length(unique(states))]) %>%
    layout(
      title = "Cognitive State Detection from Phase Dynamics",
      xaxis = list(title = "Time (s)"),
      yaxis = list(title = "Phase (radians)"),
      legend = list(title = list(text = "State"))
    )
  
  return(fig)
}

# -----------------------------------------------------------------------
# Run Advanced Analysis Example
# -----------------------------------------------------------------------

run_advanced_analysis <- function() {
  # 1. Multi-region analysis
  cat("Generating multi-region fMRI data...\n")
  multiregion_data <- generate_multiregion_fmri(regions = 5, N = 10, T = 300, noise_level = 5.0)
  
  cat("Applying KPT to multi-region data...\n")
  multiregion_kpt <- apply_multiregion_kpt(multiregion_data$bold, multiregion_data$t)
  
  cat("Visualizing phase connectivity...\n")
  connectivity_plot <- visualize_phase_connectivity(multiregion_kpt, threshold = 0.4)
  connectivity_plot
  
  # 2. Non-parametric phase distribution
  cat("Estimating non-parametric phase distribution...\n")
  # Extract phases from first region
  phases_matrix <- matrix(0, nrow = 10, ncol = 300)
  for (n in 1:10) {
    phases_matrix[n,] <- multiregion_data$true_phases[1,]
  }
  
  nonparam_dist <- estimate_nonparametric_phase_dist(phases_matrix, multiregion_data$t)
  
  cat("Visualizing non-parametric distribution...\n")
  nonparam_plot <- visualize_nonparametric_dist(nonparam_dist)
  nonparam_plot
  
  # 3. Event-related analysis
  cat("Generating event-related fMRI data...\n")
  event_data <- generate_event_related_fmri(N = 15, T = 600, tmax = 60,
                                           event_times = c(10, 30, 50))
  
  cat("Applying KPT to event-related data...\n")
  event_kpt <- unified_kpt(event_data$bold, event_data$t, preprocess = TRUE, kernel_sigma = 0.5)
  
  cat("Analyzing phase reset...\n")
  reset_analysis <- analyze_phase_reset(event_kpt, event_data$event_times)
  
  cat("Visualizing phase reset...\n")
  reset_plot <- visualize_phase_reset(reset_analysis)
  reset_plot
  
  # 4. Cognitive state detection
  cat("Detecting cognitive states...\n")
  state_detection <- detect_cognitive_states(event_kpt, window_size = 3, k = 3)
  
  cat("Visualizing cognitive states...\n")
  state_plot <- visualize_cognitive_states(state_detection, event_kpt)
  state_plot
  
  # Return results
  return(list(
    multiregion = list(
      data = multiregion_data,
      kpt = multiregion_kpt,
      plot = connectivity_plot
    ),
    nonparametric = list(
      dist = nonparam_dist,
      plot = nonparam_plot
    ),
    event_related = list(
      data = event_data,
      kpt = event_kpt,
      reset_analysis = reset_analysis,
      plot = reset_plot
    ),
    cognitive_states = list(
      detection = state_detection,
      plot = state_plot
    )
  ))
}

# # Run if script is executed directly
# if (!exists("source_run")) {
#   results <- run_advanced_analysis()
# }

#### Report and PLOT results ....
cat("Generating multi-region fMRI data...\n")

## Generating multi-region fMRI data...

  multiregion_data <- generate_multiregion_fmri(regions = 5, N = 10, T = 300)
  
  cat("Applying KPT to multi-region data...\n")

## Applying KPT to multi-region data...

  multiregion_kpt <- apply_multiregion_kpt(multiregion_data$bold, multiregion_data$t)

## Processing region 1 ...
## Processing region 2 ...
## Processing region 3 ...
## Processing region 4 ...
## Processing region 5 ...

  cat("Visualizing phase connectivity...\n")

## Visualizing phase connectivity...

  connectivity_plot <- visualize_phase_connectivity(multiregion_kpt, threshold = 0.4)
  connectivity_plot

  # 2. Non-parametric phase distribution
  cat("Estimating non-parametric phase distribution...\n")

## Estimating non-parametric phase distribution...

  # Extract phases from first region
  phases_matrix <- matrix(0, nrow = 10, ncol = 300)
  for (n in 1:10) {
    phases_matrix[n,] <- multiregion_data$true_phases[1,]
  }
  
  nonparam_dist <- estimate_nonparametric_phase_dist(phases_matrix, multiregion_data$t)
  
  cat("Visualizing non-parametric distribution...\n")

## Visualizing non-parametric distribution...

  nonparam_plot <- visualize_nonparametric_dist(nonparam_dist)
  nonparam_plot

  # 3. Event-related analysis
  cat("Generating event-related fMRI data...\n")

## Generating event-related fMRI data...

  event_data <- generate_event_related_fmri(N = 15, T = 600, tmax = 60,
                                           event_times = c(10, 30, 50))
  
  cat("Applying KPT to event-related data...\n")

## Applying KPT to event-related data...

  event_kpt <- unified_kpt(event_data$bold, event_data$t, preprocess = TRUE, kernel_sigma = 0.5)
  
  cat("Analyzing phase reset...\n")

## Analyzing phase reset...

  reset_analysis <- analyze_phase_reset(event_kpt, event_data$event_times)
  
  cat("Visualizing phase reset...\n")

## Visualizing phase reset...

  reset_plot <- visualize_phase_reset(reset_analysis)
  reset_plot

  # 4. Cognitive state detection
  cat("Detecting cognitive states...\n")

## Detecting cognitive states...

  state_detection <- detect_cognitive_states(event_kpt, window_size = 3, k = 3)
  
  cat("Visualizing cognitive states...\n")

## Visualizing cognitive states...

  state_plot <- visualize_cognitive_states(state_detection, event_kpt)
  state_plot

library(htmltools)
str_output <- capture.output(str(event_kpt))
html_output <- tags$pre(paste(str_output, collapse = "\n"))
html_output

List of 9
 $ t          : num [1:600] 0 0.1 0.2 0.301 0.401 ...
 $ mu         : num [1:600] -2.48e-12 -1.46 -1.74 -1.93 -2.12 ...
 $ kappa      : num [1:600] 1.00e+02 9.14e-03 1.08e-02 1.08e-02 8.40e-03 ...
 $ phi_K1     : num [1:15, 1:600] 0 3.14 0 3.14 3.14 ...
 $ phi_K2     : num [1:15, 1:600] 0 0 0 0 0 0 0 0 0 0 ...
 $ phi_K3     : num [1:15, 1:600] 1.05 -2.17 -2.34 -2.68 -2.41 ...
 $ weights    :List of 3
  ..$ w1: num [1:600] 1.50e-10 3.32e-01 3.32e-01 3.31e-01 3.30e-01 ...
  ..$ w2: num [1:600] 1 0.332 0.332 0.333 0.334 ...
  ..$ w3: num [1:600] 1.03e-10 3.37e-01 3.37e-01 3.36e-01 3.36e-01 ...
 $ variances  :List of 3
  ..$ v_K1: num [1:600] 0.667 0.984 0.985 0.985 0.986 ...
  ..$ v_K2: num [1:600] 0 0.985 0.984 0.98 0.975 ...
  ..$ v_K3: num [1:600] 0.97 0.97 0.97 0.97 0.969 ...
 $ phase_jumps:'data.frame':    15 obs. of  2 variables:
  ..$ time     : num [1:15] 0.1 2.4 4.41 6.41 7.81 ...
  ..$ magnitude: num [1:15] -14.56 1.49 1.4 14.84 1.53 ...

# str(event_kpt)

Notice the object structures of the result of the KPT model of the event-related fMRI data, which is an object event_kpt <- unified_kpt(event_data$bold, event_data$t, preprocess = TRUE, kernel_sigma = 0.5).

Basis	MSE (Phase)	Uncertainty
Time (\(K_1\))	\(0.12 \pm 0.03\)	\(\Delta K_1 = 0.15\)
Frequency (\(K_2\))	\(0.25 \pm 0.07\)	\(\Delta K_2 = 0.31\)
Scale (\(K_3\))	\(0.18 \pm 0.05\)	\(\Delta K_3 = 0.22\)

The Kime-Phase Problem

Kime-phase Estimation and Kime-Operators in Spacekime Representation

SOCR Team

02/25/2025