--- title: "Kime Applications in Data Science" subtitle: "[Back To TCIU Contents](https://tciu.predictive.space/)" author: "SOCR Team " date: "`r format(Sys.time(),'%m/%d/%Y')`" output: html_document: theme: spacelab highlight: tango includes: before_body: TCIU_header.html toc: true number_sections: true toc_depth: 2 toc_float: collapsed: false smooth_scroll: true code_folding: hide --- ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE, warings = FALSE) ``` # Econometrics, Business and Market Analysis Example(s) ```{r message=F, warning=F} # 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) ``` ## Data Source Type ### X1 ```{r, eval=FALSE} # 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) ``` ### img1 ```{r, eval = FALSE} 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))] ``` ## Figure 3.18A ```{r eval = TRUE} # 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) # Display scene rglwidget(width = 800, height = 600, elementId = "model1") %>% toggleWidget(ids = display1, label = "Show") ``` ## Figure 3.18B ```{r eval = FALSE} # Show the Phases # Opening rgl window to display in html page invisible(open3d(useNULL = T, windowRect = c(0,0,800,800), zoom = 1)) X1_phase_nill <- atan2(0, Re(X1)) display1 <- contour3d(X1_phase_nill, level = c(0, 2), alpha = c(0.3, 0.5), add = TRUE, color=c("yellow", "red")) # Aspect ratio and axes aspect3d(1.0, 1.0, 1.0) axes3d() # Display scene rglwidget(width = 800, height = 600, elementId = "model1") %>% toggleWidget(ids = display1, label = "Show") ``` Running the above chunk may require a substantial amount of memory, the chunk below is a sub-sample of X1_phase_nill used to display a similar cuboid: ```{r} # Show the Phases # Opening rgl window to display in html page invisible(open3d(useNULL = T, windowRect = c(0,0,800,800), zoom = 1)) X1_phase_nill <- atan2(0, Re(X1)) X1_phase_nill_subsample = X1_phase_nill[ sample( length(X1_phase_nill[,1,1]), length(X1_phase_nill[,1,1])*0.5, replace = TRUE), sample( length(X1_phase_nill[1,,1]), length(X1_phase_nill[1,,1])*0.5, replace = TRUE), sample( length(X1_phase_nill[1,1,]), length(X1_phase_nill[1,1,])*0.5, replace = TRUE)] display2 <- contour3d(X1_phase_nill_subsample, level = c(0, 2), alpha = c(0.3, 0.5), add = TRUE, color=c("yellow", "red")) # Aspect ratio and axes aspect3d(1.0, 1.0, 1.0) axes3d() # Display scene rglwidget(width = 800, height = 600, elementId = "model2") %>% toggleWidget(ids = display2, label = "Show") ```