SOCR ≫

TCIU Website ≫

TCIU GitHub ≫

Kime Applications in Data Science

Back To TCIU Contents

1 Econometrics, Business and Market Analysis Example(s)

# To Render the rgl/contour3d window in the DOCX/HTML output via knitter, we can use the following protocol:
library(misc3d)
library(rgl)
library(DT)
load("Application.Rdata")
# dim(X1)
# dim(img1)

1.1 Data Source Type

1.1.1 X1

# 1. download the 4D fMRI data
fMRIURL <- "https://socr.umich.edu/HTML5/BrainViewer/data/fMRI_FilteredData_4D.nii.gz"
fMRIFile <- file.path(tempdir(), "fMRI_FilteredData_4D.nii.gz")
(fMRIVolume <- readNIfTI(fMRIFile, reorient=FALSE))

# 2. extract the time-course of 2D mid-axial slice (3D) hypervolume
fMRI_2D_z11 <- fMRIVolume[ , , 11, ]
X1 = fft(fMRI_2D_z11)

1.1.2 img1

planes_half <- ceiling(dim(fMRI_2D_z11)[3]/2)
# apply log transform to temper the intensity range
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")
  }
}
img1 <- fftshift(Re(log(1+X1)),3)[ , , (1:(planes_half+1))]

1.2 Figure 3.18A

# Opening rgl window to display in html page
invisible(open3d(useNULL = T, windowRect = c(0,0,800,800), zoom = 1))
display1 <- 
  contour3d(img1, level = c(7, 12), alpha = c(0.3, 0.5), add = TRUE,
            color=c("yellow", "red"), perspective=T, distance=0.8)

# Aspect ratio and axes
aspect3d(1.0, 1.0, 1.0)
axes3d()

# install.packages("manipulateWidget")
library(manipulateWidget)

## Warning: package 'manipulateWidget' was built under R version 4.1.2

# Display scene
rglwidget(width = 800, height = 600, elementId = "model1") %>% 
  toggleWidget(ids = display1, label = "Show")