boundX = c(55,205)  #(0,20)
boundY = c(40, 125) #range temp 0, 50
station = blood.df
station = na.omit(station)
ageGroup = sort(unique(station$age_groups))
df = lapply(ageGroup, function(y){
station %>% dplyr::filter(age_groups == y,
Systolic <= boundX[2],
Systolic >= boundX[1],
Diastolic <= boundY[2],
Diastolic >= boundY[1]) %>% dplyr::select(Systolic, Diastolic)
})
boundCenter = c(mean(boundX), mean(boundY))
boundScale = c((boundX[2]-boundX[1])/2, (boundY[2]-boundY[1])/2 )
df = lapply(df, function(obs_mat){
return(t(apply(obs_mat, 1, function(x) (x-boundCenter) / boundScale * 10 )))
})
set.seed(2)
mat1 = as.matrix(df[[1]])
mat2 = as.matrix(df[[26]])
N=51
geodRatio = round(seq(0, 1, length.out=20), 2)
thetaGrid = (90+seq(0,180,length.out = N+1)[1:N])/180*pi
eps=0.0001
qSup = seq(eps, 1-eps, length.out=N)
rho_grid = seq(-15, 15, length.out=N)
geoRatioList = lapply(geodRatio, function(r){
sapply(thetaGrid, function(theta){
vT = matrix(c(cos(theta), sin(theta)), nrow=2)
proj1= mat1 %*% vT
proj2= mat2 %*% vT
# q1 = fdapace::Lwls1D(bw=0.01, kernel_type='epan', xin=seq(0+1/(2*length(proj1)), 1-1/(2*length(proj1)), length=length(proj1)), yin=sort(proj1), xout=qSup)
# q2 = fdapace::Lwls1D(bw=0.01, kernel_type='epan', xin=seq(0+1/(2*length(proj1)), 1-1/(2*length(proj1)), length=length(proj2)), yin=sort(proj2), xout=qSup)
q1=approx(x = seq(0+1/(2*length(proj1)), 1-1/(2*length(proj1)), length=length(proj1)), y = sort(proj1), xout = qSup, rule = c(2,2))[[2]]
q2=approx(x = seq(0+1/(2*length(proj2)), 1-1/(2*length(proj2)), length=length(proj2)), y = sort(proj2), xout = qSup, rule = c(2,2))[[2]]
return(q1*(1-r) + q2*r)
})
})
#quantile to density
quantile2dens <- function(qt, qSup, dSup){
cdf = splinefun(qt, qSup, method = 'natural')
# get grid and function for density space
dSupTemp = qt
densTemp = cdf(qt, deriv=1)
# Remove duplicates
ind = (dSupTemp>rho_grid[1]) & (dSupTemp<rho_grid[length(rho_grid)])
#dSupTemp = unique(dSupTemp)
dSupTemp = dSupTemp[ind]
densTemp = densTemp[ind]
ind2 = order(dSupTemp)
# Interpolate to dSup and normalize
#dens = approx(x = dSupTemp, y = densTemp[!ind], xout = dSup, rule = c(2,2))[[2]]
#plot(dSupTemp[ind], densTemp[ind])
dens = fdapace::Lwls1D(bw=2, kernel_type='gauss', xin=dSupTemp[ind2], yin=densTemp[ind2], xout=dSup)
dens[dens<0]=0
dens[is.nan(dens)] = 0
dens = dens/fdapace::trapzRcpp(X = dSup,Y = dens); # Normalize
return(dens)
}
# density map back
density_rec = function(geoRatioList, nout, qSup, rho_grid, fileSurfix=''){
#reconstruct density function from the sliced Frechet regression
#input: df_frechet: list of frechet regression fitted density for each slice, each of dimension n X N
#       n: dimension of random samples
#output: a list of a sample of reconstructed density functions
py_file_sliced = paste("../data/station_radon_rec", fileSurfix, ".npy", sep='')
py_file_rec = py_file_sliced
py_code = 'InverseRadonTransform.py'
py_version = '/usr/local/bin/python3.9'
np = reticulate::import("numpy")
## Part1: sliced density reconstruction
df_radon_rec = lapply(1:nout, function(i){
# densmat = t(sapply(df_frechet, function(mat){
#   mat$dens[i,]
# })) # Each row correpsonds to a theta value
qtMat = geoRatioList[[i]] # N(grid) X N(theta)
densmat = apply(qtMat, 2, function(qt) quantile2dens(qt, qSup, rho_grid))
return(densmat)
})
print(1)
## Part2: output data to Python process Radon transform
np$save(py_file_sliced, reticulate::r_to_py(df_radon_rec))
Sys.sleep(20)  # system need some time to store the data
print(2)
## Part3: Inverse radon transform
#call Python file to enable inverse radon transform and output to station_rec.npy
#rstudioapi::terminalExecute("/usr/local/bin/python3 /Users/hango/Desktop/UCDavis/research/SlicedWas/code/InverseRadonTransform.py")
py_cmd = paste(py_version, py_code, py_file_sliced, sep=' ')
system(py_cmd)
Sys.sleep(20)  # system need some time to store the data
print(3)
df_rec = np$load(py_file_rec)
return(df_rec)
}
geoOut = density_rec(geoRatioList, length(geodRatio), qSup, rho_grid)
X_grid = rho_grid / 10 * boundScale[1] + boundCenter[1]
Y_grid = rho_grid / 10 * boundScale[2] + boundCenter[2]
geoOut = lapply(1:length(geodRatio), function(i){
dens = geoOut[i,,]
dens[dens<0] = 0
dens = dens / trapz2DRcpp(X_grid, Y_grid, dens)
return(dens)
})
(x-boundCenter) / boundScale * 10
# plot
dens_min = 0
dens_max = 0.0005
fig_geo = VisDens2(list(kron(X_grid, ones(1,N))),
list(kron(ones(N,1), t(Y_grid))),
geoOut[1:20],
label = geodRatio[1:20],
min = dens_min,
max = dens_max,
ncol = 6,
title = "",
xlab = "",
ylab = "")
fig_geo
fig_geo = VisDens2_sm(list(kron(X_grid, ones(1,N))),
list(kron(ones(N,1), t(Y_grid))),
geoOut[1:20],
bandw = c(40,40),
label = geodRatio[1:20],
min = dens_min,
max = dens_max,
ncol = 6,
title = "",
xlab = "",
ylab = "")
fig_geo
### Frechet regression for 2D distributional data
# predictor: t
# response : density along rho for each theta
# note that: regression for each theta
rm(list = ls())
setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
library(pracma)
library(dplyr)
library(fdapace)
library(tidyverse)
library(fdadensity)
library(plotly)
library(parallel)
library(plyr)
library(ks)
library('plot.matrix')
source('Radon_regression.R')
source("trapz2DRcpp.R")
source("VisDens.R")
source("GetFVE2D.R")
source('utils.R')
reticulate::use_python("~/virtualenvs/bin/python3", required = T)
py_config()
#load the data
load("../data/blood.Rda")
boundX = c(55,205)  #(0,20)
boundY = c(40, 125) #range temp 0, 50
station = blood.df
station = na.omit(station)
ageGroup = sort(unique(station$age_groups))
df = lapply(ageGroup, function(y){
station %>% dplyr::filter(age_groups == y,
Systolic <= boundX[2],
Systolic >= boundX[1],
Diastolic <= boundY[2],
Diastolic >= boundY[1]) %>% dplyr::select(Systolic, Diastolic)
})
boundCenter = c(mean(boundX), mean(boundY))
boundScale = c((boundX[2]-boundX[1])/2, (boundY[2]-boundY[1])/2 )
df = lapply(df, function(obs_mat){
return(t(apply(obs_mat, 1, function(x) (x-boundCenter) / boundScale * 10 )))
})
set.seed(2)
mat1 = as.matrix(df[[1]])
mat2 = as.matrix(df[[26]])
N=51
geodRatio = round(seq(0, 1, length.out=20), 2)
thetaGrid = (90+seq(0,180,length.out = N+1)[1:N])/180*pi
eps=0.0001
qSup = seq(eps, 1-eps, length.out=N)
rho_grid = seq(-15, 15, length.out=N)
geoRatioList = lapply(geodRatio, function(r){
sapply(thetaGrid, function(theta){
vT = matrix(c(cos(theta), sin(theta)), nrow=2)
proj1= mat1 %*% vT
proj2= mat2 %*% vT
# q1 = fdapace::Lwls1D(bw=0.01, kernel_type='epan', xin=seq(0+1/(2*length(proj1)), 1-1/(2*length(proj1)), length=length(proj1)), yin=sort(proj1), xout=qSup)
# q2 = fdapace::Lwls1D(bw=0.01, kernel_type='epan', xin=seq(0+1/(2*length(proj1)), 1-1/(2*length(proj1)), length=length(proj2)), yin=sort(proj2), xout=qSup)
q1=approx(x = seq(0+1/(2*length(proj1)), 1-1/(2*length(proj1)), length=length(proj1)), y = sort(proj1), xout = qSup, rule = c(2,2))[[2]]
q2=approx(x = seq(0+1/(2*length(proj2)), 1-1/(2*length(proj2)), length=length(proj2)), y = sort(proj2), xout = qSup, rule = c(2,2))[[2]]
return(q1*(1-r) + q2*r)
})
})
#quantile to density
quantile2dens <- function(qt, qSup, dSup){
cdf = splinefun(qt, qSup, method = 'natural')
# get grid and function for density space
dSupTemp = qt
densTemp = cdf(qt, deriv=1)
# Remove duplicates
ind = (dSupTemp>rho_grid[1]) & (dSupTemp<rho_grid[length(rho_grid)])
#dSupTemp = unique(dSupTemp)
dSupTemp = dSupTemp[ind]
densTemp = densTemp[ind]
ind2 = order(dSupTemp)
# Interpolate to dSup and normalize
#dens = approx(x = dSupTemp, y = densTemp[!ind], xout = dSup, rule = c(2,2))[[2]]
#plot(dSupTemp[ind], densTemp[ind])
dens = fdapace::Lwls1D(bw=2, kernel_type='gauss', xin=dSupTemp[ind2], yin=densTemp[ind2], xout=dSup)
dens[dens<0]=0
dens[is.nan(dens)] = 0
dens = dens/fdapace::trapzRcpp(X = dSup,Y = dens); # Normalize
return(dens)
}
# density map back
density_rec = function(geoRatioList, nout, qSup, rho_grid, fileSurfix=''){
#reconstruct density function from the sliced Frechet regression
#input: df_frechet: list of frechet regression fitted density for each slice, each of dimension n X N
#       n: dimension of random samples
#output: a list of a sample of reconstructed density functions
py_file_sliced = paste("../data/station_radon_rec", fileSurfix, ".npy", sep='')
py_file_rec = py_file_sliced
py_code = 'InverseRadonTransform.py'
py_version = '/usr/local/bin/python3.9'
np = reticulate::import("numpy")
## Part1: sliced density reconstruction
df_radon_rec = lapply(1:nout, function(i){
# densmat = t(sapply(df_frechet, function(mat){
#   mat$dens[i,]
# })) # Each row correpsonds to a theta value
qtMat = geoRatioList[[i]] # N(grid) X N(theta)
densmat = apply(qtMat, 2, function(qt) quantile2dens(qt, qSup, rho_grid))
return(densmat)
})
print(1)
## Part2: output data to Python process Radon transform
np$save(py_file_sliced, reticulate::r_to_py(df_radon_rec))
Sys.sleep(20)  # system need some time to store the data
print(2)
## Part3: Inverse radon transform
#call Python file to enable inverse radon transform and output to station_rec.npy
#rstudioapi::terminalExecute("/usr/local/bin/python3 /Users/hango/Desktop/UCDavis/research/SlicedWas/code/InverseRadonTransform.py")
py_cmd = paste(py_version, py_code, py_file_sliced, sep=' ')
system(py_cmd)
Sys.sleep(20)  # system need some time to store the data
print(3)
df_rec = np$load(py_file_rec)
return(df_rec)
}
geoOut = density_rec(geoRatioList, length(geodRatio), qSup, rho_grid)
X_grid = rho_grid / 10 * boundScale[1] + boundCenter[1]
Y_grid = rho_grid / 10 * boundScale[2] + boundCenter[2]
geoOut = lapply(1:length(geodRatio), function(i){
dens = geoOut[i,,]
dens[dens<0] = 0
dens = dens / trapz2DRcpp(X_grid, Y_grid, dens)
return(dens)
})
# plot
dens_min = 0
dens_max = 0.0005
fig_geo = VisDens2(list(kron(X_grid, ones(1,N))),
list(kron(ones(N,1), t(Y_grid))),
geoOut[1:20],
label = geodRatio[1:20],
min = dens_min,
max = dens_max,
ncol = 6,
title = "",
xlab = "",
ylab = "")
fig_geo
return(t(apply(obs_mat, 1, function(x) (x-boundCenter) / boundScale * 10 )))
fig_geo = VisDens2_sm(list(kron(X_grid, ones(1,N))),
list(kron(ones(N,1), t(Y_grid))),
geoOut[1:20],
bandw = c(40,40),
label = geodRatio[1:20],
min = dens_min,
max = dens_max,
ncol = 6,
title = "",
xlab = "",
ylab = "")
fig_geo
fig_geo = VisDens2_sm(list(kron(X_grid, ones(1,N))),
list(kron(ones(N,1), t(Y_grid))),
geoOut[1:20],
bandw = c(20,20),
label = geodRatio[1:20],
min = dens_min,
max = dens_max,
ncol = 6,
title = "",
xlab = "",
ylab = "")
fig_geo
dens_max = 0.0008
fig_geo = VisDens2(list(kron(X_grid, ones(1,N))),
list(kron(ones(N,1), t(Y_grid))),
geoOut[1:20],
label = geodRatio[1:20],
min = dens_min,
max = dens_max,
ncol = 6,
title = "",
xlab = "",
ylab = "")
fig_geo
fig_geo = VisDens2_sm(list(kron(X_grid, ones(1,N))),
list(kron(ones(N,1), t(Y_grid))),
geoOut[1:20],
bandw = c(20,20),
label = geodRatio[1:20],
min = dens_min,
max = dens_max,
ncol = 6,
title = "",
xlab = "",
ylab = "")
fig_geo
rm(list = ls())
setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
library(pracma)
library(dplyr)
library(tidyverse)
library(fdapace)
library(fdadensity)
library(plotly)
library(parallel)
library(plyr)
library(ks)
library('plot.matrix')
source('Radon_regression.R')
source("trapz2DRcpp.R")
source("VisDens.R")
source("GetFVE2D.R")
source('utils.R')
reticulate::use_python("~/virtualenvs/bin/python3", required = T)
py_config()
#load the data
load("../data/blood.Rda")
boundX = c(55,205)  #(0,20)
boundY = c(40, 125) #range temp 0, 50
station = blood.df
station = na.omit(station)
ageGroup = sort(unique(station$age_groups))
df = lapply(ageGroup, function(y){
station %>% dplyr::filter(age_groups == y,
Systolic <= boundX[2],
Systolic >= boundX[1],
Diastolic <= boundY[2],
Diastolic >= boundY[1]) %>% dplyr::select(Systolic, Diastolic)
})
boundCenter = c(mean(boundX), mean(boundY))
boundScale = c((boundX[2]-boundX[1])/2, (boundY[2]-boundY[1])/2 )
df = lapply(df, function(obs_mat){
return(t(apply(obs_mat, 1, function(x) (x-boundCenter) / boundScale * 10 )))
})
set.seed(2)
mat1 = as.matrix(df[[1]])
mat2 = as.matrix(df[[26]])
# sample_size = min(dim(mat1)[1], dim(mat2)[1])
# mat1 = mat1[sample(dim(mat1)[1], sample_size),]
# mat2 = mat2[sample(dim(mat2)[1], sample_size),]
### univariate geodesic
N=51
geodRatio = round(seq(0, 1, length.out=20), 2)
thetaGrid = (90+seq(0,180,length.out = N+1)[1:N])/180*pi
eps=0.0001
qSup = seq(eps, 1-eps, length.out=N)
rho_grid = seq(-20, 20, length.out=N)
geoRatioList = lapply(geodRatio, function(r){
sapply(thetaGrid, function(theta){
vT = matrix(c(cos(theta), sin(theta)), nrow=2)
proj1= mat1 %*% vT
proj2= mat2 %*% vT
# q1 = fdapace::Lwls1D(bw=0.01, kernel_type='epan', xin=seq(0+1/(2*length(proj1)), 1-1/(2*length(proj1)), length=length(proj1)), yin=sort(proj1), xout=qSup)
# q2 = fdapace::Lwls1D(bw=0.01, kernel_type='epan', xin=seq(0+1/(2*length(proj1)), 1-1/(2*length(proj1)), length=length(proj2)), yin=sort(proj2), xout=qSup)
q1=approx(x = seq(0+1/(2*length(proj1)), 1-1/(2*length(proj1)), length=length(proj1)), y = sort(proj1), xout = qSup, rule = c(2,2))[[2]]
q2=approx(x = seq(0+1/(2*length(proj2)), 1-1/(2*length(proj2)), length=length(proj2)), y = sort(proj2), xout = qSup, rule = c(2,2))[[2]]
return(q1*(1-r) + q2*r)
})
})
#quantile to density
quantile2dens <- function(qt, qSup, dSup){
cdf = splinefun(qt, qSup, method = 'natural')
# get grid and function for density space
dSupTemp = qt
densTemp = cdf(qt, deriv=1)
# Remove duplicates
ind = (dSupTemp>rho_grid[1]) & (dSupTemp<rho_grid[length(rho_grid)])
#dSupTemp = unique(dSupTemp)
dSupTemp = dSupTemp[ind]
densTemp = densTemp[ind]
ind2 = order(dSupTemp)
# Interpolate to dSup and normalize
#dens = approx(x = dSupTemp, y = densTemp[!ind], xout = dSup, rule = c(2,2))[[2]]
#plot(dSupTemp[ind], densTemp[ind])
dens = fdapace::Lwls1D(bw=2, kernel_type='gauss', xin=dSupTemp[ind2], yin=densTemp[ind2], xout=dSup)
dens[dens<0]=0
dens[is.nan(dens)] = 0
dens = dens/fdapace::trapzRcpp(X = dSup,Y = dens); # Normalize
return(dens)
}
# density map back
density_rec = function(geoRatioList, nout, qSup, rho_grid, fileSurfix=''){
#reconstruct density function from the sliced Frechet regression
#input: df_frechet: list of frechet regression fitted density for each slice, each of dimension n X N
#       n: dimension of random samples
#output: a list of a sample of reconstructed density functions
py_file_sliced = paste("../data/station_radon_rec", fileSurfix, ".npy", sep='')
py_file_rec = py_file_sliced
py_code = 'InverseRadonTransform.py'
py_version = '/usr/local/bin/python3.9'
np = reticulate::import("numpy")
## Part1: sliced density reconstruction
df_radon_rec = lapply(1:nout, function(i){
# densmat = t(sapply(df_frechet, function(mat){
#   mat$dens[i,]
# })) # Each row correpsonds to a theta value
qtMat = geoRatioList[[i]] # N(grid) X N(theta)
densmat = apply(qtMat, 2, function(qt) quantile2dens(qt, qSup, rho_grid))
return(densmat)
})
print(1)
## Part2: output data to Python process Radon transform
np$save(py_file_sliced, reticulate::r_to_py(df_radon_rec))
Sys.sleep(20)  # system need some time to store the data
print(2)
## Part3: Inverse radon transform
#call Python file to enable inverse radon transform and output to station_rec.npy
#rstudioapi::terminalExecute("/usr/local/bin/python3 /Users/hango/Desktop/UCDavis/research/SlicedWas/code/InverseRadonTransform.py")
py_cmd = paste(py_version, py_code, py_file_sliced, sep=' ')
system(py_cmd)
Sys.sleep(20)  # system need some time to store the data
print(3)
df_rec = np$load(py_file_rec)
return(df_rec)
}
geoOut = density_rec(geoRatioList, length(geodRatio), qSup, rho_grid)
X_grid = rho_grid / 10 * boundScale[1] + boundCenter[1]
Y_grid = rho_grid / 10 * boundScale[2] + boundCenter[2]
geoOut = lapply(1:length(geodRatio), function(i){
dens = geoOut[i,,]
dens[dens<0] = 0
dens = dens / trapz2DRcpp(X_grid, Y_grid, dens)
return(dens)
})
# plot
dens_min = 0
dens_max = 0.0008
fig_geo = VisDens2(list(kron(X_grid, ones(1,N))),
list(kron(ones(N,1), t(Y_grid))),
geoOut[1:20],
label = geodRatio[1:20],
min = dens_min,
max = dens_max,
ncol = 6,
title = "",
xlab = "",
ylab = "")
fig_geo
fig_geo = VisDens2_sm(list(kron(X_grid, ones(1,N))),
list(kron(ones(N,1), t(Y_grid))),
geoOut[1:20],
bandw = c(20,20),
label = geodRatio[1:20],
min = dens_min,
max = dens_max,
ncol = 6,
title = "",
xlab = "",
ylab = "")
fig_geo
dens_max = 0.0006
fig_geo = VisDens2_sm(list(kron(X_grid, ones(1,N))),
list(kron(ones(N,1), t(Y_grid))),
geoOut[1:20],
bandw = c(20,20),
label = geodRatio[1:20],
min = dens_min,
max = dens_max,
ncol = 6,
title = "",
xlab = "",
ylab = "")
fig_geo
fig_geo = VisDens2_sm(list(kron(X_grid, ones(1,N))),
list(kron(ones(N,1), t(Y_grid))),
geoOut[1:20],
bandw = c(25,25),
label = geodRatio[1:20],
min = dens_min,
max = dens_max,
ncol = 6,
title = "",
xlab = "",
ylab = "")
fig_geo
fig_geo = VisDens2_sm(list(kron(X_grid, ones(1,N))),
list(kron(ones(N,1), t(Y_grid))),
geoOut[1:20],
bandw = c(30,30),
label = geodRatio[1:20],
min = dens_min,
max = dens_max,
ncol = 6,
title = "",
xlab = "",
ylab = "")
fig_geo
