| SOCR ≫ | TCIU Website ≫ | TCIU GitHub ≫ |
A schematic of the 5D spacekime manifold, two cones representing space (\(\mathbb{R}^3\)) - kime (\(\mathbb{R}^2\))
Complex-time (kime) can be defined using polar coordinates, \(\kappa = t\ e^{i \varphi}\).
Kime naturally extends time, \(\kappa = t\ e^{i \varphi}\), i.e., time is just the magnitude of kime, \(t=|\kappa|\). The time domain \((t\in\mathbb{R}^+)\) is a subgroup of the multiplicative group of the reals, whereas kime \((\kappa\in\mathbb{C})\) is the smallest algebraically closed prime field that naturally extends the time domain. The time domain of the positive reals is ordered, but its kime extension is not. The kime domain, \(\mathbb{C}\), represents the smallest natural extension of time, as a complete filed that covers time.
This Figure shows the spacekime representation of observable processes indexed by space, reduced to 1D, and kime (2D). At a given spatial location (\(x\)), the red balls scattered along the circle of fixed radius (time) represent the repeated process measurements from the experimentally controlled trials colocalized in spacetime.
# parameter space sweep for the spherical coordinates
phi <- seq(from = 0, to = 2*pi, by = ((2*pi - 0)/(200 - 1)))
psi <- seq(from = 0, to = pi, by = ((pi - 0)/(200 - 1)))
# shape=="cone1")
# rendering (u,v) parametric surfaces requires x,y,z arguments to be 2D arrays
# In out case, the three coordinates have to be 200*200 parameterized tensors/arrays
h1= 10 # cone height
r1 = seq(from = 0, to = h1, by = ((h1 - 0)/(200 - 1))) # r = radius
x1 = 20* ((h1 - r1)/h1 ) %o% rep(1, 200) # x = 3*r
y1 = 3* ((h1 - r1)/h1 ) %o% sin(phi) # y = r*sin(phi)
z1 = 3* ((h1 - r1)/h1 ) %o% cos(phi) # z = r*cos(phi)
# circle1 boundary
x11 = rep(20, 200) %o% rep(1, 200) # x = 20
y11 = 3* ((h1 - r1)/h1 ) %o% sin(phi) # y = r*sin(phi)
z11 = 3* ((h1 - r1)/h1 ) %o% cos(phi) # z = r*cos(phi)
# randomly kime-phase sample points on cone3
randX1 <- sample((dim(x1))[2], 10)
# shape=="cone2")
h2= 10 # cone height
r2 = seq(from = 0, to = h2, by = ((h2 - 0)/(200 - 1))) # r = radius
x2 = 20* ((h2 - r2)/h2 ) %o% rep(1, 200) # x = 3*r
y2 = 2* ((h2 - r2)/h2 ) %o% sin(phi) # y = r*sin(phi)
z2 = 2* ((h2 - r2)/h2 ) %o% cos(phi) # z = r*cos(phi)
# circle2 boundary
x21 = rep(20, 200) %o% rep(1, 200) # x = 20
y21 = 2* ((h2 - r2)/h2 ) %o% sin(phi) # y = r*sin(phi)
z21 = 2* ((h2 - r2)/h2 ) %o% cos(phi) # z = r*cos(phi)
# shape=="cone3")
h3= 10 # cone height
r3 = seq(from = 0, to = h3, by = ((h3 - 0)/(200 - 1))) # r = radius
x3 = 15* ((h3 - r3)/h3 ) %o% rep(1, 200) # x = 3*r
y3 = 3* ((h3 - r3)/h3 ) %o% sin(phi) # y = r*sin(phi)
z3 = 3* ((h3 - r3)/h3 ) %o% cos(phi) # z = r*cos(phi)
# circle3 boundary
x31 = rep(15, 200) %o% rep(1, 200) # x = 15
y31 = 3* ((h3 - r3)/h3) %o% sin(phi) # y = r*sin(phi)
z31 = 3* ((h3 - r3)/h3) %o% cos(phi) # z = r*cos(phi)
shape_names <- c("all", "cone1", "cone2", "cone3")
# https://plot.ly/r/custom-buttons/
# updatemenus component
updatemenus <- list(
list(
active = -1,
type = 'buttons',
buttons = list(
list(
label = shape_names[1],
method = "update",
args = list(list(visible = c(TRUE, TRUE, TRUE, TRUE)),
list(title = shape_names[1]))),
list(
label = shape_names[2],
method = "update",
args = list(list(visible = c(TRUE, FALSE, FALSE, FALSE)),
list(title = shape_names[2]))),
list(
label = shape_names[3],
method = "update",
args = list(list(visible = c(TRUE, TRUE, FALSE, FALSE)),
list(title = shape_names[3]))),
list(
label = shape_names[4],
method = "update",
args = list(list(visible = c(TRUE, FALSE, FALSE, TRUE)),
list(title = shape_names[4])))
)
)
)
p <-
plot_ly(showscale = FALSE) %>%
# add cone1
# Randomly sample points (kime-phase sampling) the boundary of cone1 surface
add_trace(x=~x1[1,randX1], y=~y11[1,randX1], z=~z11[1,randX1], type="scatter3d",
mode="markers", marker = list(size = 10, color="red"), name="Phase-Samples",
text = paste0("Kime-Phase:\n", " space=", 20, "\n time=|kime|=", h1,
"\n kime-phase=", round((phi[randX1])-pi,2))) %>%
add_trace(x = ~x1, y = ~y1, z = ~z1, type = 'surface', opacity=0.3, visible=T,
contour=list(show=F, color="#000", width=15, lwd=10,
opacity=0.5, hoverinfo="none", legendshow=F)) %>%
# add cone2
add_trace(x = ~x2, y = ~y2, z = ~z2, type='surface', opacity=0.4,visible=T,
contour=list(show=F, color="#000", width=15, lwd=10,
opacity=0.5, hoverinfo="none", legendshow=F)) %>%
# add cone3
add_trace(x = ~x3, y = ~y3, z = ~z3, type='surface', opacity=0.5,visible=T,
contour=list(show=F, color="#000", width=15, lwd=10,
opacity=0.5, hoverinfo="none", legendshow=F)) %>%
#
#
# trace the x-axis
add_trace(x=~1.1*x1[,1], y=0, z=0, type="scatter3d", mode="lines",
line = list(width = 10, color="light blue"), name="Z",
hoverinfo="none", legendshow=F) %>%
#
#
# trace the boundary of cone1 surface
add_trace(x=~x1[1,], y=~y11[1,], z=~z11[1,], type="scatter3d", mode="lines",
line = list(width = 10, color="red"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# add center for kime circle1 at location x1
add_trace(x=~x1[1,1], y=0, z=0, type="scatter3d", mode="markers",
marker = list(size = 10, color="red"), name="Z",
hoverinfo="none", legendshow=F) %>%
# trace the boundary of cone2 surface
add_trace(x=~x2[1,], y=~y21[1,], z=~z21[1,], type="scatter3d", mode="lines",
line = list(width = 10, color="green"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# trace the boundary of cone3 surface
add_trace(x=~x3[1,], y=~y31[1,], z=~z31[1,], type="scatter3d", mode="lines",
line = list(width = 10, color="blue"), name="Surface Boundary",
hoverinfo="none", legendshow=F) %>%
# add center for cime circle3 at location x3
add_trace(x=~x3[1,1], y=0, z=0, type="scatter3d", mode="markers",
line = list(width = 10, color="navy blue"), name="Z",
hoverinfo="none", legendshow=F) %>%
# layout
layout(title = "Schematic of Space (1D) and Kime (2D) Representaiton", showlegend = FALSE,
scene = list(xaxis=list(title="space"), yaxis=list(title="kappa1"),
zaxis=list(title="kappa2")),
updatemenus = updatemenus)
pSee this kime-phase representation GIF animation.
library(animation)
library(plotly)
library(circular)
epsilon <- 0.1
sampleSize <- 1000 # total number of phases to sample for 3 different processes (x, y, z)
sizePerTime <- 100 # number of phases to use for each fixed time (must divide sampleSize)
circleUniformPhi <- seq(from=-pi, to=pi, length.out=sizePerTime)
oopt = ani.options(interval = 0.2)
set.seed(1234)
# sample the the kime-phases for all 3 different processes and the r time points
x <- rvonmises(n=sampleSize, mu=circular(pi/5), kappa=3)
y <- rvonmises(n=sampleSize, mu=circular(-pi/3), kappa=5)
z <- rvonmises(n=sampleSize, mu=circular(0), kappa=10)
r <- seq(from=1, to=sampleSize/sizePerTime, length.out=10)
# Define a function that renormalizes the kime-phase to [-pi, pi)
pheRenormalize <- function (x) {
out <- ifelse(as.numeric(x) <= pi, as.numeric(x)+pi, as.numeric(x)-pi)
return (out)
}
# transform Von Mises samples from [0, 2*pi) to [-pi, pi)
x <- pheRenormalize(x)
y <- pheRenormalize(y)
z <- pheRenormalize(z)
# vectorize the samples
vectorX = as.vector(x)
vectorY = as.vector(y)
vectorZ = as.vector(z)
# Starting phases, set the first phase index=1
plotX = c(vectorX[1])
plotY = c(vectorY[1])
plotZ = c(vectorZ[1])
pl_scene <- plot_ly(type='scatter3d', mode="markers")
plotX <- list()
plotY <- list()
plotZ <- list()
plotX_df <- list() # need separate dataframes to store all time foliations
plotY_df <- list()
plotZ_df <- list()
for (t in 1:length(r)) { # loop over time
# loop over kime-phases
plotX[[t]] <- as.numeric(x[c(( (t-1)*length(r) + 1):((t-1)*length(r) + sizePerTime))])
plotY[[t]] <- as.numeric(y[c(( (t-1)*length(r) + 1):((t-1)*length(r) + sizePerTime))])
plotZ[[t]] <- as.numeric(z[c(( (t-1)*length(r) + 1):((t-1)*length(r) + sizePerTime))])
# Try to "stack=T the points ....
#r1 = sqrt((resx$x)^2+(resx$y)^2)/2;
#resx$x = r1*cos(resx$data)
#resx$x = r1*cos(resx$data)
tempX = circular(unlist(plotX[[t]]))
tempY = circular(unlist(plotY[[t]]))
tempZ = circular(unlist(plotZ[[t]]))
resx <- density(tempX, bw=25, xaxt='n', yaxt='n')
resy <- density(tempY, bw=25, xaxt='n', yaxt='n')
resz <- density(tempZ, bw=25, xaxt='n', yaxt='n')
# res <- plot(resx, points.plot=TRUE, xlim=c(-1.1,1.5), ylim=c(-1.5, 1.5),
# main="Trivariate random sampling of\n kime-magnitudes (times) and kime-directions (phases)",
# offset=0.9, shrink=1.0, ticks=T, lwd=3, axes=F, stack=TRUE, bins=150)
# pl_list[[t]]
unifPhi_df <- as.data.frame(cbind(t=t, circleUniformPhi=circleUniformPhi))
plotX_df[[t]] <- as.data.frame(cbind(t=t, plotX=unlist(plotX[[t]])))
plotY_df[[t]] <- as.data.frame(cbind(t=t, plotY=unlist(plotY[[t]])))
plotZ_df[[t]] <- as.data.frame(cbind(t=t, plotZ=unlist(plotZ[[t]])))
pl_scene <- pl_scene %>% add_trace(data=unifPhi_df, showlegend=FALSE,
x = ~((t-epsilon)*cos(circleUniformPhi)),
y = ~((t-epsilon)*sin(circleUniformPhi)), z=0,
name=paste0("Time=",t), line=list(color='gray'),
mode = 'lines', opacity=0.3) %>%
add_markers(data=plotX_df[[t]], x=~(t*cos(plotX)), y=~(t*sin(plotX)), z=0,
type='scatter3d', name=paste0("X: t=",t),
marker=list(color='green'), showlegend=FALSE,
mode = 'markers', opacity=0.3) %>%
add_markers(data=plotY_df[[t]], x=~((t+epsilon)*cos(plotY)),
y=~((t+epsilon)*sin(plotY)), z=0-epsilon, showlegend=FALSE,
type='scatter3d', name=paste0("Y: t=",t),
marker=list(color='blue'),
mode = 'markers', opacity=0.3) %>%
add_markers(data=plotZ_df[[t]], x=~((t+2*epsilon)*cos(plotZ)),
y=~((t+2*epsilon)*sin(plotZ)), z=0+epsilon, showlegend=FALSE,
type='scatter3d', name=paste0("Z: t=",t),
marker=list(color='red'),
mode = 'markers', opacity=0.3)
}
means_df <- as.data.frame(cbind(t = c(1:length(r)),
plotX_means=unlist(lapply(plotX, mean)),
plotY_means=unlist(lapply(plotY, mean)),
plotZ_means=unlist(lapply(plotZ, mean))))
pl_scene <- pl_scene %>%
# add averaged (donoised) phase trajectories
add_trace(data=means_df, x=~(t*cos(plotX_means)),
y=~(t*sin(plotX_means)), z=0,
type='scatter3d', showlegend=FALSE, mode='lines', name="Expected Obs X",
line=list(color='green', width=15), opacity=0.8) %>%
add_trace(data=means_df, x=~(t*cos(plotY_means)),
y=~(t*sin(plotY_means)), z=0-epsilon,
type='scatter3d', showlegend=FALSE, mode='lines', name="Expected Obs X",
line=list(color='blue', width=15), opacity=0.8) %>%
add_trace(data=means_df, x=~(t*cos(plotZ_means)),
y=~(t*sin(plotZ_means)), z=0+epsilon,
type='scatter3d', showlegend=FALSE, mode='lines', name="Expected Obs X",
line=list(color='red', width=15), opacity=0.8) %>%
add_trace(x=0, y=0, z=c(-2,2), name="Space", showlegend=FALSE,
line=list(color='gray', width=15), opacity=0.8) %>%
layout(title="Pseudo Spacekime (1D Space, 2D Kime) Kime-Phase Sampling and Foliation",
scene = list(xaxis=list(title="Kappa1"), yaxis=list(title="Kappa2"),
zaxis=list(title="Space"))) %>% hide_colorbar()
pl_scene