In jbrabazon13/profilr: Identifies significant changes in a changing data set with time

knitr::opts_chunk$set(fig.width=6, fig.height=4, fig.path='figs/',
                      warning=FALSE, message=FALSE)

library(devtools)
library(knitr)
load_all(pkg = "./../../profilr")

Introduction

The profilr package was created to help analyze stacked image data sets and detect significant changes in the image data, whether at a region of interest (within a box or segmented line) or over the entire image itself. While this package was originally made for analyzing images, it can be used for virtually any changing dataset with time, provided the length of the dataset is constant and that you desire to know the location of the change/changes. The changes within the datasets are detected using change point analysis. See R Killick's R package 'changepoint' and relevent publications (referenced at end of document) for more information about this process. This package merely provides an easy way to implement the changepoint package in a more batch model like way. The profilr package contains two major functions 1) lineprof and 2) imageprof.

Delineate the height of fluid wetting within a fracture with respect to time

A recent study of mine required delineating the height of wetting of water with respect to time within a rock fracture. We used neutron radiography to visualize the movement of water within the fractures. This process yielded a stack of neutron radiographs (essentially gray scale TIFFs) that had time stamps associated with each image. It would be an extremely tedious task to manually measure the distance the water had traveled for each individual image. Thus, I created this package to help automate the R Killick's 'changepoint' package to allow changepoint analysis to delineate the height for me. Change point analysis detects significant changes within data. For this study, I wanted to detect significant changes in the pixel values along the path of the fracture in the image.

knitr::include_graphics("./figs/changepoint.JPG")

The first step was to obtain the pixel values along the fracture. This was done using the free software ImageJ. I opened the stack of images as an image sequence in ImageJ.

knitr::include_graphics("figs/limestone_core.JPG")

I then drew a segmented line over the pathway of the fracture. It is to be noted that if you increase the width of the drawn line, an average pixel value is given over the width of the line. I then used a macro in ImageJ (ImageJ macro code shown below) to extract the pixel values along the length of the drawn segment for each image in the stack.

knitr::include_graphics("figs/transect_macro.JPG")

print(read.delim("figs/imageprofile_stack.ijm"))

You can then save the results of the macro as a .csv file.

knitr::include_graphics("figs/sasvemacro.JPG")

By running the macro code, you are prompted to save the results. Doing this, being sure to save as a .csv allows for a dataframe of the picture pixel values over the fracture as shown below. (Note, if you do not use the macro, or are not analyzing image/pixel data, the lineprof function will still work for you. Just be sure to put your data in a similar format as shown below - including an 'X' column and then subsequent columns representing each image). This dataset is much larger, however, I have only shown the first 15 rows and 5 columns to save space.

kable(head(limestone[1:5], 15), align=rep('c', 6))

Now that I have my pixel data for all images in the stack. I want to see where the significant shifts are for each image (each image is a column of pixel values in the dataframe). Now depending on the type of data I have, I may want to detect significant shifts in the mean, variance, or both the mean and variance. Here, for these particular images, I want to detect significant shifts in the mean and the variance of the pixel values. With my data in the above format (note that limestone is a dataset included with this package), I can now use the lineprof function to get the changepoints for each image. In my case, I want the significant changes of the mean and variance. So I use the below code.

meanvar_results <- lineprof(data = limestone, L_per_pix = 1, type = "meanvar")
kable(head(meanvar_results), align=rep('c', 6))

Say for example, that I knew that the pixel length was 0.0124 mm. I could use this conversion within the function to get my results in mm as shown below.

converted_meanvar_results <- lineprof(data = limestone, L_per_pix = 0.0124, type = "meanvar")
kable(head(converted_meanvar_results), align=rep('c', 6))

If I wanted to detect changes in the mean, I would use the below code.

mean_results <- lineprof(data = limestone, L_per_pix = 1, type = "mean")
kable(head(mean_results), align=rep('c', 6))

If I wanted to detect changes in the variance, I would use the below code.

var_results <- lineprof(data = limestone, L_per_pix = 1, type = "variance")
kable(head(var_results), align=rep('c', 6))

If I want to compare all of the types of change point analysis, I can simply use type ="all" as shown below.

all_results <- lineprof(data = limestone, L_per_pix = 0.0124, type = "all")
kable(head(all_results), align=rep('c', 6))

The great thing is that we can easily plot the results and see the change in wetting height with time.

ggplot(data = converted_meanvar_results, aes(x = time.interval, y = unit.length))+
  geom_point()+
  xlab("Time")+
  ylab("Height (mm)")

Delineate the height of fluid over an entire image (not just fracture)

Say we now want to understand how fluids move over or along a surface and we want to delineate the moving front with respect to time. This can be difficult as there may be great variation along this interface. The imageprof function is a great way to delineate the change over the entire wetting front with time.

To use this tool, we need to have matrix images (.txt files) portraying the fluid movement saved in a folder. For this example I have generated a fake wetting front shown in these five .txt files.

knitr::include_graphics("figs/fake_wetting.JPG")

To visualize the movement of water, and detect the height of wetting at each point across the wetting front, I can use imageprof function as shown below. Here I am using changepoint analysis on each of the images, specifically looking at shifts in the mean and the variance for each column of the matrix as denoted by type = "meanvar". As samplename = NULL the base folder name, in this case 'extdata,' will be used. L_per_pix = 1 so no unit conversion will take place. Lastly, filetail = NULL will give a general automated output ending name of the file. In this case, my saved file would appear as 'extdata_meanvar.csv' in my designated savepath folder.

df <- imageprof(basepath = "./../inst/extdata/", savepath = "./../inst/extdata/", samplename = NULL, L_per_pix = 1, stats = FALSE, type = "meanvar", filetail = NULL)

kable(head(df), align=rep('c', 6))

if (file.exists("./../inst/extdata/extdata_meanvar.csv")) file.remove("./../inst/extdata/extdata_meanvar.csv")

To override the default samplename and filetail, I can make the below changes resulting in a file saved as 'myfile_todaysdate.csv' in my designated save folder. In this example, say I knew that the pixel length of the images was 0.0124 mm in length. Here I input L_per_pix = 0.0124 and the resulting change points are converted to mm.

df <- imageprof(basepath = "./../inst/extdata/", savepath = "./../inst/extdata/", samplename = "myfile", L_per_pix = 0.0124, stats = FALSE, type = "meanvar", filetail = "todaysdate")

kable(head(df), align=rep('c', 6))

if (file.exists("./../inst/extdata/myfile_todaysdate.csv")) file.remove("./../inst/extdata/myfile_todaysdate.csv")

Perhaps I would like to know the statistics of all of the wetting heights in the image. This can be done by allowing stats = TRUE as shown below. This saves a new file with only the statistics. So here we would have a file saved as wettingfront_meavar_stats.csv in the designated save folder.

stats_df <- imageprof(basepath = "./../inst/extdata/", savepath = "./../inst/extdata/", samplename = "wettingfront", L_per_pix = 1, stats = TRUE, type = "meanvar", filetail = NULL)

kable(head(stats_df), align=rep('c', 6))

if (file.exists("./../inst/extdata/wettingfront_meanvar_stats.csv")) file.remove("./../inst/extdata/wettingfront_meanvar_stats.csv")

The same steps as shown above can also be applied to type = "mean" and type = "variance"

df <- imageprof(basepath = "./../inst/extdata/", savepath = "./../inst/extdata/", samplename = "wettingfront", L_per_pix = 1, stats = FALSE, type = "mean", filetail = NULL)

kable(head(df), align=rep('c', 6))

if (file.exists("./../inst/extdata/wettingfront_mean.csv")) file.remove("./../inst/extdata/wettingfront_mean.csv")

df <- imageprof(basepath = "./../inst/extdata/", savepath = "./../inst/extdata/", samplename = "wettingfront", L_per_pix = 1, stats = FALSE, type = "variance", filetail = NULL)

kable(head(df), align=rep('c', 6))

if (file.exists("./../inst/extdata/wettingfront_variance.csv")) file.remove("./../inst/extdata/wettingfront_variance.csv")

We can easily plot the results to see the wetting front or plot the stats.

ggplot(data = df, aes(x = matrix.column.number, y = fake_wetting0002.txt))+
  geom_point()+
  xlab("Column Number of Matrix")+
  ylab("Pixel Height of Wetting Front")

ggplot(data = stats_df)+
  geom_line(aes(x = image.order, y = mean, color = "mean"))+
  geom_line(aes(x = image.order, y = median, color = "median"))+
  geom_line(aes(x = image.order, y = standard.deviation, color = "sdev"))+
  geom_line(aes(x = image.order, y = variance, color = "variance"))+
  xlab("Column Number of Matrix")+
  ylab("Data Units")+
  xlim(0, 5)+
  ylim(0,200)

jbrabazon13/profilr documentation built on May 20, 2019, 2:58 p.m.