R/SEQ_Move_function.r
In joshuakrobertson/R-Package_ReVuePro: ReVuePro: Enabling analysis of thermal images captured by FLIRs VuePro R
Defines functions
SEQ_Move
Documented in
SEQ_Move
#' ReVuePro: SEQ_Move
#'
#' A function used to assess the amount of movement observed across a FLIR thermal image, captured in .SEQ format.
#' @details This function partitions TIFF stacks into FITS videos, of one second length. These FITS files contain temperature values (in degrees Celcius), knitten to each pixel. Note that FITS files will be written such that their creation date matches that of capture time (so long as the creation date of the parent TIFF has not been modified since capture). Furthermore, this function calls upon Microsoft Powershell, and is therefore currently limited to Windows users.
#' @param input_video A path to the SEQ file within which motion is to be assessed. There is no default input.
#' @param sample_output The path to a folder where a sample FITS file of a thermal image frame will be saved. Default is your current working directory.
#' @param temp_cut A cutoff value that is used to assess whether movement has occurred at a given pixel. If a change in temperature at a given pixel exceeds this value, movement at this pixel is assumed. This value is expressed in degrees Celsius and has a default of 1.0.
#' @param move_cut Another cutoff value that is used to assess whether movement has occurred at a given pixel. If the total proportion of pixels in a given frame that have changed temperature exceeds this value, movement is assumed. Default is 0.01.
#' @param iwidth The width, in pixels, of the thermal image. Default is 640.
#' @param iheight The height, in pixels, of the thermal image Default is 480.
#' @param gapsize The number of bytes between each image frame, within the SEQ stack. Default is 1424.
#' @param voffset The number of byted between the start of the SEQ, and the beginning of the fist image frame. Default is 1372.
#' @param fps The frames per second of the TIFF stack. Default is 1/15.
#' @param P_R1 Planck_R1 from function "Rad_Temp" in package "ReVuePro". A callibration constant, specific per FLIR camera. This can be determined using 'exiftool.exe', produced by Phil Harvey. Default is 20939.062.
#' @param P_R2 Planck_R2 from function "Rad_Temp" in package "ReVuePro". A callibration constant, specific per FLIR camera. This can be determined using 'exiftool.exe', produced by Phil Harvey. Default is 0.012890106.
#' @param P_B Planck_B from function "Rad_Temp" in package "ReVuePro". A callibration constant, specific per FLIR camera. This can be determined using 'exiftool.exe', produced by Phil Harvey. Default is 1498.6.
#' @param P_F Planck_F from function "Rad_Temp" in package "ReVuePro". A callibration constant, specific per FLIR camera. This can be determined using 'exiftool.exe', produced by Phil Harvey. Default is 1.0.
#' @param P_O Planck_O from function "Rad_Temp" in package "ReVuePro". A callibration constant, specific per FLIR camera. This can be determined using 'exiftool.exe', produced by Phil Harvey. Default is -7658.
#' @param emiss Emmissivity from function "Rad_Temp" in package "ReVuePro". The relative energy that is emitted (or radiated) from the surface of the object in the image, compared to that emitted from a blackbody in equivalent conditions. This value must lay between 0 and 1. Default is 0.98.
#' @param OD obj_distance from function "Rad_Temp" in package "ReVuePro". The distance between the thermal imaging camera and object to be measured within the image. This value is expressed in metres. Default is 1.0 metres.
#' @param AT Ambient temperature during capture of SEQ file. There is no default value.
#' @param transmit wind_transmittance from function "Rad_Temp" in package "ReVuePro". The relative amount of light transmitted though a window between the thermal imaging camera and object in question. This value must lay between 0 and 1, with a default value of 1.
#' @param hum humidity from function "Rad_Temp" in package "ReVuePro". Relative, atmospheric humidity at the time if image character. This value is expressed as a percentage, and therefore should lay between 0 and 100. Default is 40.
#' @param parallel A binary 'TRUE/FALSE' parameter dictating whether conversions will be completed with parallel processing or not. Default is TRUE.
#' @param summarise A binary 'TRUE/FALSE' parameter dictating whether movement data is to be summarised across the video length or provided in raw format (per frame). Default is TRUE.
#' @keywords VuePro, Thermal
#' @import FITSio doParallel dplyr foreach ggplot2
#' @examples
#' source = "C:/MyJPGs"
#' destination = "C:/MyFITS"
#' tempdata = "C:/Temperature_Data/ExperimentTemp.xlsx"
#' SEQ_Move(input_video = source, sample_output = destination, temp_cut = 0.5, move_cut = 0.1, fps = 10, AT = 22, hum = 30)
#' @export
SEQ_Move <-function(input_video, sample_output = getwd(), temp_cut = 1, move_cut = 0.01, iwidth = 640, iheight = 480,
gapsize = 1424, P_R1 = 20939.062, voffset = 1372, fps=(1/15), P_R2 = 0.012890106,
P_B = 1498.6, P_F = 1, P_O = -7658, emiss = 0.98, OD = 1.0, AT, transmit = 1, hum = 40,
parallel = TRUE, summarise = TRUE){
require('doParallel')
require('dplyr')
require('foreach')
require('FITSio')
require('ggplot2')
# Assessing input variables
if (is.character(input_video) == "FALSE"){
return("input_video must be a path to the video you wish to assess")
}
if (is.numeric(temp_cut) == "FALSE" & is.integer(temp_cut) == "FALSE"){
return("temp_cut must be numeric or integerial")
}
if (is.numeric(move_cut) == "FALSE"){
return("move_cut must be numeric")
}
if (move_cut <= 0 | move_cut > 1){
return("move_cut must fall between 0 and 1")
}
if (is.numeric(iwidth) == "FALSE" & is.integer(iwidth) == "FALSE"){
return("iwidth must be numeric or integerial")
}
if (is.numeric(iheight) == "FALSE" & is.integer(iheight) == "FALSE"){
return("iheight must be numeric or integerial")
}
if (is.numeric(gapsize) == "FALSE" & is.integer(gapsize) == "FALSE"){
return("gapsize must be numeric or integerial")
}
if (is.numeric(P_R1) == "FALSE" & is.integer(P_R1) == "FALSE"){
return("P_R1 must be numeric or integerial")
}
if (is.numeric(voffset) == "FALSE" & is.integer(voffset) == "FALSE"){
return("voffset must be numeric or integerial")
}
if (is.numeric(fps) == "FALSE" & is.integer(fps) == "FALSE"){
return("fps must be numeric or integerial")
}
if (is.numeric(P_R2) == "FALSE" & is.integer(P_R2) == "FALSE"){
return("P_R2 must be numeric or integerial")
}
if (is.numeric(P_B) == "FALSE" & is.integer(P_B) == "FALSE"){
return("P_B must be numeric or integerial")
}
if (is.numeric(P_F) == "FALSE" & is.integer(P_F) == "FALSE"){
return("P_F must be numeric or integerial")
}
if (is.numeric(P_O) == "FALSE" & is.integer(P_O) == "FALSE"){
return("P_O must be numeric or integerial")
}
if (is.numeric(emiss) == "FALSE"){
return("emiss must be numeric")
}
if (emiss <= 0 | emiss > 1){
return("emiss must be a numeric value between 0 and 1")
}
if (is.numeric(OD) == "FALSE" & is.integer(OD) == "FALSE"){
return("OD must be numeric or integerial")
}
if (OD <= 0){
return("OD must be greater than 0")
}
if (is.numeric(AT) == "FALSE" & is.integer(AT) == "FALSE"){
return("AT must be numeric or integerial")
}
if (is.numeric(transmit) == "FALSE" & is.integer(transmit) == "FALSE"){
return("transmit must be numeric or integerial")
}
if (transmit <= 0 | transmit > 1){
return("transmit must fall between 0 and 1")
}
if (is.numeric(hum) == "FALSE" & is.integer(hum) == "FALSE"){
return("hum must be numeric or integerial")
}
if (hum <= 0 | hum > 100){
return("hum must fall between 0 and 100")
}
if (parallel != TRUE & parallel != FALSE){
return("parallel must be TRUE or FALSE")
}
if (summarise != TRUE & summarise != FALSE){
return("summarise must be TRUE or FALSE")
}
ret_bin = function(x, P_R1, P_R2, P_B, P_F, P_O, emiss, OD, FrameSeconds, AT, hum, transmit){
readTemp = file(x, "rb")
to_ret = readBin(readTemp, integer(), n = file.info(x)$size, size=2, endian="little")
close(readTemp)
ToRemove = x
transmit = 1
invisible(file.remove(ToRemove))
to_ret_adj = ReVuePro::Rad_Temp(to_ret, Planck_R1 = P_R1,
Planck_R2 = P_R2, Planck_B = P_B, Planck_F = P_F, Planck_O = P_O,
emissivity = emiss, obj_distance = OD, amb_temp = AT, ref_temp = AT,
window_temp = AT, wind_transmittance = transmit, humidity = hum)
return(to_ret_adj)
}
readingIn <- file(input_video, "rb")
BinData <- readBin(readingIn, raw(), n = file.info(input_video)$size)
close(readingIn)
Imagelength = (iwidth*iheight)*2
NoFrames = ceiling((length(BinData) - voffset)/(Imagelength + gapsize))
if (parallel == "TRUE"){
registerDoParallel()
Temp_vals = foreach(j=1:NoFrames) %dopar% {
FrameSeconds = j
Image=BinData[(voffset+(Imagelength+gapsize)*(j-1)+1):((voffset+(Imagelength+gapsize)*(j))-gapsize+1)]
tempcon = file(paste("temp", j, sep = "_"))
open(tempcon, "wb")
writeBin(Image, tempcon, raw(), endian = .Platform$endian)
close(tempcon)
file_name = paste("temp", j, sep = "_")
suppressWarnings(ret_bin(x = file_name, P_R1 = P_R1, P_R2 = P_R2, P_B = P_B, P_F = P_F,
P_O = P_O, emiss = emiss, OD = OD, FrameSeconds = FrameSeconds, AT = AT, hum = hum, transmit = transmit))
}
} else if (parallel == "FALSE"){
Temp_vals = vector('list', length(NoFrames))
for (j in 1:NoFrames){
FrameSeconds = j
Image=BinData[(voffset+(Imagelength+gapsize)*(j-1)+1):((voffset+(Imagelength+gapsize)*(j))-gapsize+1)]
tempcon = file(paste("temp", j, sep = "_"))
open(tempcon, "wb")
writeBin(Image, tempcon, raw(), endian = .Platform$endian)
close(tempcon)
file_name = paste("temp", j, sep = "_")
Temp_vals[[j]] = suppressWarnings(ret_bin(x = file_name, P_R1 = P_R1, P_R2 = P_R2, P_B = P_B, P_F = P_F,
P_O = P_O, emiss = emiss, OD = OD, FrameSeconds = FrameSeconds, AT = AT, hum = hum, transmit = transmit))
}
} else {
return("Incorrect value for 'parallel' parameter.")
}
# Clean temporary files
ToRemove = "temp"
if (file.exists(ToRemove)){file.remove(ToRemove)}
# Saving sample image, then calculating differences between frames
FITSdf=as.data.frame(matrix(Temp_vals[[1]], ncol=480))
FITSdf[,1:ncol(FITSdf)]=FITSdf[,1:ncol(FITSdf)]
WriteFITS=paste(sample_output, "/sample.fits", sep="")
writeFITSim(as.matrix(FITSdf), file = WriteFITS, type = "single")
Above_Vals = c()
if (parallel == "TRUE"){
registerDoParallel()
Above_Vals_Lead = foreach(j=1:(length(Temp_vals)-1)) %dopar% {
Frame_Diff = as.data.frame(matrix(abs(Temp_vals[[j+1]] - Temp_vals[[j]]), ncol=480))
Frame_Diff = Frame_Diff[,1:ncol(Frame_Diff)]=
Frame_Diff[,1:ncol(Frame_Diff)]
sum(sapply(Frame_Diff, function(x) sum(x > temp_cut)))
}
Above_Vals = unlist(Above_Vals_Lead)
} else if (parallel == "FALSE"){
for (j in 1:(length(Temp_vals)-1)){
Frame_Diff = as.data.frame(matrix(abs(Temp_vals[[j+1]] - Temp_vals[[j]]), ncol=480))
Frame_Diff = Frame_Diff[,1:ncol(Frame_Diff)]=
Frame_Diff[,1:ncol(Frame_Diff)]
Above_Vals[j] = sum(sapply(Frame_Diff, function(x) sum(x > temp_cut)))
}
}
Movement_by_time = data.frame("Frame" = seq(1, (NoFrames - 1), by = 1),
"Delta" = Above_Vals/(iwidth*iheight),
"Type" = "Proportion_Pixels")
# Removing anomalies
Movement_by_time$Delta[c(which(Movement_by_time$Delta > 0.2))] = 0
if (summarise == "TRUE"){
To_Report = data.frame("Frames Assessed" = NoFrames, "Time Assessed" = (1/fps)*NoFrames,
"Moving_Frames" = length(which(Movement_by_time$Delta >= move_cut)),
"Moving_Time" = (1/fps)*length(which(Movement_by_time$Delta >= move_cut)))
} else if (summarise == "FALSE"){
To_Report = Movement_by_time
To_Report$Movement = 0
To_Report$Movement[c(which(To_Report$Delta >= move_cut))] = 1
To_Report = To_Report %>% dplyr::select(-Type) %>%
dplyr::rename("Prop_Pixels_Changed" = Delta)
}
Plot_1 = ggplot(Movement_by_time, aes(x = Frame, y = Delta)) +
geom_line(size = 1, colour = "slateblue") + theme_bw() +
geom_hline(yintercept = move_cut, linetype = "dashed", size = 1, colour = "black") +
xlab("Video Frame Number") + ylab("Proportion of Pixels with\nDelta Above Cutoff")
return_list = vector('list', 2)
return_list[[1]] = To_Report
return_list[[2]] = Plot_1
closeAllConnections()
message("Calculation complete")
return(return_list)
}
joshuakrobertson/R-Package_ReVuePro documentation built on June 2, 2020, 8:23 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions SEQ_Move
Documented in SEQ_Move
#' ReVuePro: SEQ_Move
#'
#' A function used to assess the amount of movement observed across a FLIR thermal image, captured in .SEQ format.
#' @details This function partitions TIFF stacks into FITS videos, of one second length. These FITS files contain temperature values (in degrees Celcius), knitten to each pixel. Note that FITS files will be written such that their creation date matches that of capture time (so long as the creation date of the parent TIFF has not been modified since capture). Furthermore, this function calls upon Microsoft Powershell, and is therefore currently limited to Windows users.
#' @param input_video A path to the SEQ file within which motion is to be assessed. There is no default input.
#' @param sample_output The path to a folder where a sample FITS file of a thermal image frame will be saved. Default is your current working directory.
#' @param temp_cut A cutoff value that is used to assess whether movement has occurred at a given pixel. If a change in temperature at a given pixel exceeds this value, movement at this pixel is assumed. This value is expressed in degrees Celsius and has a default of 1.0.
#' @param move_cut Another cutoff value that is used to assess whether movement has occurred at a given pixel. If the total proportion of pixels in a given frame that have changed temperature exceeds this value, movement is assumed. Default is 0.01.
#' @param iwidth The width, in pixels, of the thermal image. Default is 640.
#' @param iheight The height, in pixels, of the thermal image Default is 480.
#' @param gapsize The number of bytes between each image frame, within the SEQ stack. Default is 1424.
#' @param voffset The number of byted between the start of the SEQ, and the beginning of the fist image frame. Default is 1372.
#' @param fps The frames per second of the TIFF stack. Default is 1/15.
#' @param P_R1 Planck_R1 from function "Rad_Temp" in package "ReVuePro". A callibration constant, specific per FLIR camera. This can be determined using 'exiftool.exe', produced by Phil Harvey. Default is 20939.062.
#' @param P_R2 Planck_R2 from function "Rad_Temp" in package "ReVuePro". A callibration constant, specific per FLIR camera. This can be determined using 'exiftool.exe', produced by Phil Harvey. Default is 0.012890106.
#' @param P_B Planck_B from function "Rad_Temp" in package "ReVuePro". A callibration constant, specific per FLIR camera. This can be determined using 'exiftool.exe', produced by Phil Harvey. Default is 1498.6.
#' @param P_F Planck_F from function "Rad_Temp" in package "ReVuePro". A callibration constant, specific per FLIR camera. This can be determined using 'exiftool.exe', produced by Phil Harvey. Default is 1.0.
#' @param P_O Planck_O from function "Rad_Temp" in package "ReVuePro". A callibration constant, specific per FLIR camera. This can be determined using 'exiftool.exe', produced by Phil Harvey. Default is -7658.
#' @param emiss Emmissivity from function "Rad_Temp" in package "ReVuePro". The relative energy that is emitted (or radiated) from the surface of the object in the image, compared to that emitted from a blackbody in equivalent conditions. This value must lay between 0 and 1. Default is 0.98.
#' @param OD obj_distance from function "Rad_Temp" in package "ReVuePro". The distance between the thermal imaging camera and object to be measured within the image. This value is expressed in metres. Default is 1.0 metres.
#' @param AT Ambient temperature during capture of SEQ file. There is no default value.
#' @param transmit wind_transmittance from function "Rad_Temp" in package "ReVuePro". The relative amount of light transmitted though a window between the thermal imaging camera and object in question. This value must lay between 0 and 1, with a default value of 1.
#' @param hum humidity from function "Rad_Temp" in package "ReVuePro". Relative, atmospheric humidity at the time if image character. This value is expressed as a percentage, and therefore should lay between 0 and 100. Default is 40.
#' @param parallel A binary 'TRUE/FALSE' parameter dictating whether conversions will be completed with parallel processing or not. Default is TRUE.
#' @param summarise A binary 'TRUE/FALSE' parameter dictating whether movement data is to be summarised across the video length or provided in raw format (per frame). Default is TRUE.
#' @keywords VuePro, Thermal
#' @import FITSio doParallel dplyr foreach ggplot2
#' @examples
#' source = "C:/MyJPGs"
#' destination = "C:/MyFITS"
#' tempdata = "C:/Temperature_Data/ExperimentTemp.xlsx"
#' SEQ_Move(input_video = source, sample_output = destination, temp_cut = 0.5, move_cut = 0.1, fps = 10, AT = 22, hum = 30)
#' @export
SEQ_Move <-function(input_video, sample_output = getwd(), temp_cut = 1, move_cut = 0.01, iwidth = 640, iheight = 480,
gapsize = 1424, P_R1 = 20939.062, voffset = 1372, fps=(1/15), P_R2 = 0.012890106,
P_B = 1498.6, P_F = 1, P_O = -7658, emiss = 0.98, OD = 1.0, AT, transmit = 1, hum = 40,
parallel = TRUE, summarise = TRUE){
require('doParallel')
require('dplyr')
require('foreach')
require('FITSio')
require('ggplot2')
# Assessing input variables
if (is.character(input_video) == "FALSE"){
return("input_video must be a path to the video you wish to assess")
}
if (is.numeric(temp_cut) == "FALSE" & is.integer(temp_cut) == "FALSE"){
return("temp_cut must be numeric or integerial")
}
if (is.numeric(move_cut) == "FALSE"){
return("move_cut must be numeric")
}
if (move_cut <= 0 | move_cut > 1){
return("move_cut must fall between 0 and 1")
}
if (is.numeric(iwidth) == "FALSE" & is.integer(iwidth) == "FALSE"){
return("iwidth must be numeric or integerial")
}
if (is.numeric(iheight) == "FALSE" & is.integer(iheight) == "FALSE"){
return("iheight must be numeric or integerial")
}
if (is.numeric(gapsize) == "FALSE" & is.integer(gapsize) == "FALSE"){
return("gapsize must be numeric or integerial")
}
if (is.numeric(P_R1) == "FALSE" & is.integer(P_R1) == "FALSE"){
return("P_R1 must be numeric or integerial")
}
if (is.numeric(voffset) == "FALSE" & is.integer(voffset) == "FALSE"){
return("voffset must be numeric or integerial")
}
if (is.numeric(fps) == "FALSE" & is.integer(fps) == "FALSE"){
return("fps must be numeric or integerial")
}
if (is.numeric(P_R2) == "FALSE" & is.integer(P_R2) == "FALSE"){
return("P_R2 must be numeric or integerial")
}
if (is.numeric(P_B) == "FALSE" & is.integer(P_B) == "FALSE"){
return("P_B must be numeric or integerial")
}
if (is.numeric(P_F) == "FALSE" & is.integer(P_F) == "FALSE"){
return("P_F must be numeric or integerial")
}
if (is.numeric(P_O) == "FALSE" & is.integer(P_O) == "FALSE"){
return("P_O must be numeric or integerial")
}
if (is.numeric(emiss) == "FALSE"){
return("emiss must be numeric")
}
if (emiss <= 0 | emiss > 1){
return("emiss must be a numeric value between 0 and 1")
}
if (is.numeric(OD) == "FALSE" & is.integer(OD) == "FALSE"){
return("OD must be numeric or integerial")
}
if (OD <= 0){
return("OD must be greater than 0")
}
if (is.numeric(AT) == "FALSE" & is.integer(AT) == "FALSE"){
return("AT must be numeric or integerial")
}
if (is.numeric(transmit) == "FALSE" & is.integer(transmit) == "FALSE"){
return("transmit must be numeric or integerial")
}
if (transmit <= 0 | transmit > 1){
return("transmit must fall between 0 and 1")
}
if (is.numeric(hum) == "FALSE" & is.integer(hum) == "FALSE"){
return("hum must be numeric or integerial")
}
if (hum <= 0 | hum > 100){
return("hum must fall between 0 and 100")
}
if (parallel != TRUE & parallel != FALSE){
return("parallel must be TRUE or FALSE")
}
if (summarise != TRUE & summarise != FALSE){
return("summarise must be TRUE or FALSE")
}
ret_bin = function(x, P_R1, P_R2, P_B, P_F, P_O, emiss, OD, FrameSeconds, AT, hum, transmit){
readTemp = file(x, "rb")
to_ret = readBin(readTemp, integer(), n = file.info(x)$size, size=2, endian="little")
close(readTemp)
ToRemove = x
transmit = 1
invisible(file.remove(ToRemove))
to_ret_adj = ReVuePro::Rad_Temp(to_ret, Planck_R1 = P_R1,
Planck_R2 = P_R2, Planck_B = P_B, Planck_F = P_F, Planck_O = P_O,
emissivity = emiss, obj_distance = OD, amb_temp = AT, ref_temp = AT,
window_temp = AT, wind_transmittance = transmit, humidity = hum)
return(to_ret_adj)
}
readingIn <- file(input_video, "rb")
BinData <- readBin(readingIn, raw(), n = file.info(input_video)$size)
close(readingIn)
Imagelength = (iwidth*iheight)*2
NoFrames = ceiling((length(BinData) - voffset)/(Imagelength + gapsize))
if (parallel == "TRUE"){
registerDoParallel()
Temp_vals = foreach(j=1:NoFrames) %dopar% {
FrameSeconds = j
Image=BinData[(voffset+(Imagelength+gapsize)*(j-1)+1):((voffset+(Imagelength+gapsize)*(j))-gapsize+1)]
tempcon = file(paste("temp", j, sep = "_"))
open(tempcon, "wb")
writeBin(Image, tempcon, raw(), endian = .Platform$endian)
close(tempcon)
file_name = paste("temp", j, sep = "_")
suppressWarnings(ret_bin(x = file_name, P_R1 = P_R1, P_R2 = P_R2, P_B = P_B, P_F = P_F,
P_O = P_O, emiss = emiss, OD = OD, FrameSeconds = FrameSeconds, AT = AT, hum = hum, transmit = transmit))
}
} else if (parallel == "FALSE"){
Temp_vals = vector('list', length(NoFrames))
for (j in 1:NoFrames){
FrameSeconds = j
Image=BinData[(voffset+(Imagelength+gapsize)*(j-1)+1):((voffset+(Imagelength+gapsize)*(j))-gapsize+1)]
tempcon = file(paste("temp", j, sep = "_"))
open(tempcon, "wb")
writeBin(Image, tempcon, raw(), endian = .Platform$endian)
close(tempcon)
file_name = paste("temp", j, sep = "_")
Temp_vals[[j]] = suppressWarnings(ret_bin(x = file_name, P_R1 = P_R1, P_R2 = P_R2, P_B = P_B, P_F = P_F,
P_O = P_O, emiss = emiss, OD = OD, FrameSeconds = FrameSeconds, AT = AT, hum = hum, transmit = transmit))
}
} else {
return("Incorrect value for 'parallel' parameter.")
}
# Clean temporary files
ToRemove = "temp"
if (file.exists(ToRemove)){file.remove(ToRemove)}
# Saving sample image, then calculating differences between frames
FITSdf=as.data.frame(matrix(Temp_vals[[1]], ncol=480))
FITSdf[,1:ncol(FITSdf)]=FITSdf[,1:ncol(FITSdf)]
WriteFITS=paste(sample_output, "/sample.fits", sep="")
writeFITSim(as.matrix(FITSdf), file = WriteFITS, type = "single")
Above_Vals = c()
if (parallel == "TRUE"){
registerDoParallel()
Above_Vals_Lead = foreach(j=1:(length(Temp_vals)-1)) %dopar% {
Frame_Diff = as.data.frame(matrix(abs(Temp_vals[[j+1]] - Temp_vals[[j]]), ncol=480))
Frame_Diff = Frame_Diff[,1:ncol(Frame_Diff)]=
Frame_Diff[,1:ncol(Frame_Diff)]
sum(sapply(Frame_Diff, function(x) sum(x > temp_cut)))
}
Above_Vals = unlist(Above_Vals_Lead)
} else if (parallel == "FALSE"){
for (j in 1:(length(Temp_vals)-1)){
Frame_Diff = as.data.frame(matrix(abs(Temp_vals[[j+1]] - Temp_vals[[j]]), ncol=480))
Frame_Diff = Frame_Diff[,1:ncol(Frame_Diff)]=
Frame_Diff[,1:ncol(Frame_Diff)]
Above_Vals[j] = sum(sapply(Frame_Diff, function(x) sum(x > temp_cut)))
}
}
Movement_by_time = data.frame("Frame" = seq(1, (NoFrames - 1), by = 1),
"Delta" = Above_Vals/(iwidth*iheight),
"Type" = "Proportion_Pixels")
# Removing anomalies
Movement_by_time$Delta[c(which(Movement_by_time$Delta > 0.2))] = 0
if (summarise == "TRUE"){
To_Report = data.frame("Frames Assessed" = NoFrames, "Time Assessed" = (1/fps)*NoFrames,
"Moving_Frames" = length(which(Movement_by_time$Delta >= move_cut)),
"Moving_Time" = (1/fps)*length(which(Movement_by_time$Delta >= move_cut)))
} else if (summarise == "FALSE"){
To_Report = Movement_by_time
To_Report$Movement = 0
To_Report$Movement[c(which(To_Report$Delta >= move_cut))] = 1
To_Report = To_Report %>% dplyr::select(-Type) %>%
dplyr::rename("Prop_Pixels_Changed" = Delta)
}
Plot_1 = ggplot(Movement_by_time, aes(x = Frame, y = Delta)) +
geom_line(size = 1, colour = "slateblue") + theme_bw() +
geom_hline(yintercept = move_cut, linetype = "dashed", size = 1, colour = "black") +
xlab("Video Frame Number") + ylab("Proportion of Pixels with\nDelta Above Cutoff")
return_list = vector('list', 2)
return_list[[1]] = To_Report
return_list[[2]] = Plot_1
closeAllConnections()
message("Calculation complete")
return(return_list)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.