R/TIFF2FitsET_function.R
In joshuakrobertson/R-Package_ReVuePro: ReVuePro: Enabling analysis of thermal images captured by FLIRs VuePro R
Defines functions
TIFF2FitsET
Documented in
TIFF2FitsET
#' ReVuePro: TIFF2FitsET
#'
#' A culmination function to decrypt radiometric TIFF stacks (videos) captured using a FLIR Vue Pro R camera, convert units of infrared radiation (kW/m2) to units of temperature (degrees Celsius), and construct a FITS file using IEEE754, single point format to encode temperature information. Highly similar to function FLIR2Fits_ET, however, input variable must be a TIFF stack, rather than a radiometric JPG image.
#' @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 source A path to the folder containing TIFF stack to be rewritten. There is no default input.
#' @param destination The path to a folder at wish you would like to save your rewritten, Vue Pro radiometric TIFF stack.
#' @param iwidth The width, in pixels, of the thermal image. Default is 336.
#' @param iheight The height, in pixels, of the thermal image Default is 256.
#' @param gapsize The number of bytes between each image frame, within the TIFF stack. Default is 4596.
#' @param voffset The number of byted between the start of the TIFF file, and the beginning of the fist image frame. Default is 8.
#' @param fps The frames per second of the TIFF stack. Default is 5.
#' @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 17096.453125.
#' @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.04351538.
#' @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 1428.0.
#' @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 -55.0.
#' @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_Path A path to an XLSX or CSV file containing ambient temperature and time at which ambient temperature was collected. Currently, this package supports formatting produced by WeeButton(TM) software, or outputs from the "CButtonFile", or "CButtonDate" functions (from the ReVuePro package).
#' @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.
#' @param parallel A binary 'TRUE/FALSE' parameter dictating whether conversions will be completed with parallel processing or not. Default is TRUE.
#' @keywords VuePro, Thermal
#' @import FITSio openxlsx rio doParallel foreach
#' @examples
#' source = "C:/MyJPGs"
#' destination = "C:/MyFITS"
#' tempdata = "C:/Temperature_Data/ExperimentTemp.xlsx"
#' TIFF2FitsET(source = source, destination = destination, fps = 10, AT_Path = tempdata, hum = 30)
#' @export
TIFF2FitsET<-function(input_video, destination, iwidth = 336, iheight = 256, gapsize=4596, P_R1 = 17096.453125,
voffset=8, fps=5, P_R2 = 0.04351538, P_B = 1428.0, P_F = 1, P_O = -55.0,
emiss = 0.98, OD = 1.0, AT_Path, transmit = 1, hum, parallel = TRUE){
require('doParallel')
require('foreach')
require('FITSio')
require('openxlsx')
require('rio')
video_CT = format.POSIXct(file.info(input_video)$mtime, "%H:%M:%S")
video_CD = format.POSIXct(file.info(input_video)$mtime, "%B %d, %Y")
T_V = as.numeric(unlist(strsplit(video_CT, ":")))
Absolute_Seconds=(T_V[1]*3600)+(T_V[2]*60)+(T_V[3])
Second_inc=1/fps
Sec2Time = function(x){
Hours=c()
Minutes=c()
Seconds=c()
if(nchar(floor(x/3600))<2){
Hours=paste("0",floor(x/3600),sep="")
} else {
Hours=as.character(floor(x/3600))}
if(nchar(floor((x-(as.numeric(Hours)*3600))/60))<2){
Minutes=(paste("0",floor((x-(as.numeric(Hours)*3600))/60),sep=""))
} else {
Minutes=(as.character(floor((x-(as.numeric(Hours)*3600))/60)))}
Seconds=as.character(x-(as.numeric(Hours)*3600+as.numeric(Minutes)*60))
if(nchar(Seconds)<2){Seconds = paste("0", Seconds, sep="")}
return(paste(Hours,":",Minutes,":",Seconds,sep=""))
}
substrRight = function(x, n){
substr(x, nchar(x)-n+1, nchar(x))
}
my.file.rename <- function(from, to) {
todir <- dirname(to)
if (!isTRUE(file.info(todir)$isdir)) dir.create(todir, recursive=TRUE)
file.rename(from = from, to = to)
}
setwd(gsub(paste("/", basename(input_video), sep=""), "", input_video))
originalwd<-getwd()
dir2<-destination
## Preparing temperature CSV
if(gsub("^.*\\.", "", AT_Path)=="xlsx"){
ATFile_Dir = gsub(basename(AT_Path),"", AT_Path)
ATFile_Name = gsub("\\..*", "", basename(AT_Path))
AT_CSV = paste(ATFile_Dir, ATFile_Name, ".csv", sep="")
convert(AT_Path, AT_CSV)
CButtonFile(AT_CSV)
AT_CSVmod = paste(ATFile_Dir,basename(list.files(ATFile_Dir, full.names=TRUE)[which.max(file.info(list.files(ATFile_Dir, full.names=TRUE))$mtime)]),sep="")
AT_Clean = read.csv(AT_CSVmod)
CSVRm <- AT_CSVmod
if (file.exists(CSVRm)){file.remove(CSVRm)}
}
if(gsub("^.*\\.", "", AT_Path)=="xls"){
ATFile_Dir = gsub(basename(AT_Path),"", AT_Path)
ATFile_Name = gsub("\\..*", "", basename(AT_Path))
AT_CSV = paste(ATFile_Dir, ATFile_Name, ".csv", sep="")
convert(AT_Path, AT_CSV)
CButtonFile(AT_CSV)
AT_CSVmod = paste(ATFile_Dir,basename(list.files(ATFile_Dir, full.names=TRUE)[which.max(file.info(list.files(ATFile_Dir, full.names=TRUE))$mtime)]),sep="")
AT_Clean = read.csv(AT_CSVmod)
CSVRm <- AT_CSVmod
if (file.exists(CSVRm)){file.remove(CSVRm)}
}
if(gsub("^.*\\.", "", AT_Path)=="csv"){
temp_AT=read.csv(AT_Path)
if(colnames(temp_AT)[1]=="Date"){
AT_Clean = temp_AT
} else {
CButtonFile(AT_Path)
ATFile_Dir = gsub(basename(AT_Path),"", AT_Path)
AT_Data = paste(ATFile_Dir,basename(list.files(ATFile_Dir, full.names=TRUE)[which.max(file.info(list.files(ATFile_Dir, full.names=TRUE))$mtime)]),sep="")
AT_Clean = read.csv(AT_Data)
CSVRm <- AT_Data
if (file.exists(CSVRm)){file.remove(CSVRm)}
}
}
FairExtensions=c("csv","xlsx")
if(gsub("^.*\\.", "", AT_Path)%in%FairExtensions=="FALSE"){
return("Incorrect format of ambient temperature file")
}
WriteFile=gsub("\\..*", "", input_video)
readingIn <- file(input_video, "rb")
BinData <- readBin(readingIn, raw(), n = file.info(input_video)$size)
close(readingIn)
Imagelength = (iwidth*iheight)*2
NoFrames = (length(BinData) - voffset)/(Imagelength + gapsize)
if (parallel == "FALSE"){
for (i in 1:NoFrames){
Image=BinData[(voffset+(Imagelength+gapsize)*(i-1)+1):((voffset+(Imagelength+gapsize)*(i))-gapsize+1)]
tempcon <- file("temp")
open(tempcon, "wb")
writeBin(Image, tempcon, raw(), endian = .Platform$endian)
close(tempcon)
readTemp <- file("temp", "rb")
radiance <- readBin(readTemp, integer(), n = file.info("temp")$size, size=2, endian="little")
assign(paste("radiance", i, sep="_"), radiance)
close(readTemp)
}
} else if (parallel == "TRUE"){
ret_bin = function(x, P_R1, P_R2, P_B, P_F, P_O, emiss, OD, FrameSeconds, CleanData, hum, transmit){
tiffmultiplier = 3.0904822947
tiffoffset = 240.6247734137
readTemp = file(x, "rb")
to_ret = readBin(readTemp, integer(), n = file.info(x)$size, size=2, endian="little")
close(readTemp)
ToRemove = x
invisible(file.remove(ToRemove))
AT = CleanData[which(abs(CleanData$TIS-FrameSeconds)==min(abs(CleanData$TIS-FrameSeconds))),5]
RT = CleanData[which(abs(CleanData$TIS-FrameSeconds)==min(abs(CleanData$TIS-FrameSeconds))),5]
WT = CleanData[which(abs(CleanData$TIS-FrameSeconds)==min(abs(CleanData$TIS-FrameSeconds))),5]
to_ret_adj = tiffmultiplier*(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 = WT, wind_transmittance = transmit, humidity = hum))-tiffoffset
return(to_ret_adj)
}
P_R1 = P_R1
P_R2 = P_R2
P_B = P_B
P_F = P_F
P_O = P_O
emiss = emiss
OD = OD
registerDoParallel()
Temp_vals = foreach(j=1:NoFrames) %dopar% {
FrameSeconds=c()
FrameSeconds=Absolute_Seconds+(Second_inc*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, CleanData = AT_Clean, hum = hum, transmit = transmit))
}
} else {
return("Incorrect value for 'parallel' parameter.")
}
ToRemove = "temp"
if (file.exists(ToRemove)){file.remove(ToRemove)}
if (parallel == "FALSE"){
Temp_vals = vector('list', NoFrames)
for (i in 1:NoFrames){
FrameSeconds=c()
FrameSeconds=Absolute_Seconds+(Second_inc*i)
P_R1 = P_R1
P_R2 = P_R2
P_B = P_B
P_F = P_F
P_O = P_O
emiss = emiss
OD = OD
AT = AT_Clean[which(abs(AT_Clean$TIS-FrameSeconds)==min(abs(AT_Clean$TIS-FrameSeconds))),5]
RT = AT_Clean[which(abs(AT_Clean$TIS-FrameSeconds)==min(abs(AT_Clean$TIS-FrameSeconds))),5]
WT = AT_Clean[which(abs(AT_Clean$TIS-FrameSeconds)==min(abs(AT_Clean$TIS-FrameSeconds))),5]
transmit = transmit
hum = hum
tiffmultiplier = 3.0904822947
tiffoffset = 240.6247734137
viewed_frame=paste("radiance", i, sep="_")
Temp_vals[[i]] = tiffmultiplier*(Rad_Temp(get(viewed_frame), 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 = WT, wind_transmittance = transmit, humidity = hum))-tiffoffset
}
} else if (parallel == "TRUE"){
} else {
return("Incorrect call for 'parallel' parameter.")
}
setwd(dir2)
for (j in 1:ceiling(NoFrames/fps)){
FITSArray <- array(dim=c(336,256,fps))
for (i in (1+(fps*(j-1))):(j*fps)){
if (i <= length(Temp_vals)){
FITSdf=as.data.frame(matrix(Temp_vals[[i]], ncol=256))
FITSdf[,1:ncol(FITSdf)]=rev(FITSdf[,1:ncol(FITSdf)])
FITSArray[,,(i-((j-1)*fps))]=as.matrix(FITSdf)
}
WriteFITS=paste(dir2, "/", basename(WriteFile), "_", j, ".fits", sep="")
writeFITSim(FITSArray, file = WriteFITS, type = "single")
}
}
setwd(gsub(paste("/", basename(input_video), sep=""), "", input_video))
closeAllConnections()
## Update creation times
New_DateTimes = c()
for (i in 1:NoFrames){
New_DateTimes[i] = paste(video_CD, Sec2Time(Absolute_Seconds +(i-1)), sep=" ")
}
All_DateTimes = data.frame("Date_Time" = New_DateTimes)
write.csv(All_DateTimes, "Temp_DT.csv", row.names=FALSE)
ReconDest<-as.character(gsub("/", "\\\\\\\\", destination))
ReconSource<-as.character(gsub("/", "\\\\\\\\", (gsub(paste("/", basename(input_video), sep=""), "", input_video))))
if(Sys.info()[[1]]=="Windows"){
powershellstring<-{
paste("powershell Import-Module Microsoft.PowerShell.Management; ",
"Import-Module Microsoft.PowerShell.Utility; ",
"Import-Module PSReadline; ",
"$FITSDir = ", "\\", '"', ReconDest, "\\", '"', "; ",
"cd $FITSDir; ",
"$FITSChI = get-childitem $FITSDir; ",
"$FITSList = $FITSChI | where {$_.extension -eq ", "\\", '"', ".fits", "\\", '"', "} | sort LastWriteTime; ",
"$CSVDir = ", "\\", '"', ReconSource, "\\", '"', "; ",
"cd $CSVDir; ",
"$NewDateList = @(Import-Csv Temp_DT.csv); ",
"cd $FITSDir; ",
"for ($i=0; $i - ($FITSList.length); $i++){ ",
"(Get-Item $FITSList[$i]).LastWriteTime = $NewDateList[$i].Date_Time}", sep="")
}
system(powershellstring)
} else {
print("This package currently supports Windows alone. Our apologies!")
}
ToRemove_CSV <- "Temp_DT.csv"
if (file.exists(ToRemove_CSV)){file.remove(ToRemove_CSV)}
return("Conversion complete")
}
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 TIFF2FitsET
Documented in TIFF2FitsET
#' ReVuePro: TIFF2FitsET
#'
#' A culmination function to decrypt radiometric TIFF stacks (videos) captured using a FLIR Vue Pro R camera, convert units of infrared radiation (kW/m2) to units of temperature (degrees Celsius), and construct a FITS file using IEEE754, single point format to encode temperature information. Highly similar to function FLIR2Fits_ET, however, input variable must be a TIFF stack, rather than a radiometric JPG image.
#' @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 source A path to the folder containing TIFF stack to be rewritten. There is no default input.
#' @param destination The path to a folder at wish you would like to save your rewritten, Vue Pro radiometric TIFF stack.
#' @param iwidth The width, in pixels, of the thermal image. Default is 336.
#' @param iheight The height, in pixels, of the thermal image Default is 256.
#' @param gapsize The number of bytes between each image frame, within the TIFF stack. Default is 4596.
#' @param voffset The number of byted between the start of the TIFF file, and the beginning of the fist image frame. Default is 8.
#' @param fps The frames per second of the TIFF stack. Default is 5.
#' @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 17096.453125.
#' @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.04351538.
#' @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 1428.0.
#' @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 -55.0.
#' @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_Path A path to an XLSX or CSV file containing ambient temperature and time at which ambient temperature was collected. Currently, this package supports formatting produced by WeeButton(TM) software, or outputs from the "CButtonFile", or "CButtonDate" functions (from the ReVuePro package).
#' @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.
#' @param parallel A binary 'TRUE/FALSE' parameter dictating whether conversions will be completed with parallel processing or not. Default is TRUE.
#' @keywords VuePro, Thermal
#' @import FITSio openxlsx rio doParallel foreach
#' @examples
#' source = "C:/MyJPGs"
#' destination = "C:/MyFITS"
#' tempdata = "C:/Temperature_Data/ExperimentTemp.xlsx"
#' TIFF2FitsET(source = source, destination = destination, fps = 10, AT_Path = tempdata, hum = 30)
#' @export
TIFF2FitsET<-function(input_video, destination, iwidth = 336, iheight = 256, gapsize=4596, P_R1 = 17096.453125,
voffset=8, fps=5, P_R2 = 0.04351538, P_B = 1428.0, P_F = 1, P_O = -55.0,
emiss = 0.98, OD = 1.0, AT_Path, transmit = 1, hum, parallel = TRUE){
require('doParallel')
require('foreach')
require('FITSio')
require('openxlsx')
require('rio')
video_CT = format.POSIXct(file.info(input_video)$mtime, "%H:%M:%S")
video_CD = format.POSIXct(file.info(input_video)$mtime, "%B %d, %Y")
T_V = as.numeric(unlist(strsplit(video_CT, ":")))
Absolute_Seconds=(T_V[1]*3600)+(T_V[2]*60)+(T_V[3])
Second_inc=1/fps
Sec2Time = function(x){
Hours=c()
Minutes=c()
Seconds=c()
if(nchar(floor(x/3600))<2){
Hours=paste("0",floor(x/3600),sep="")
} else {
Hours=as.character(floor(x/3600))}
if(nchar(floor((x-(as.numeric(Hours)*3600))/60))<2){
Minutes=(paste("0",floor((x-(as.numeric(Hours)*3600))/60),sep=""))
} else {
Minutes=(as.character(floor((x-(as.numeric(Hours)*3600))/60)))}
Seconds=as.character(x-(as.numeric(Hours)*3600+as.numeric(Minutes)*60))
if(nchar(Seconds)<2){Seconds = paste("0", Seconds, sep="")}
return(paste(Hours,":",Minutes,":",Seconds,sep=""))
}
substrRight = function(x, n){
substr(x, nchar(x)-n+1, nchar(x))
}
my.file.rename <- function(from, to) {
todir <- dirname(to)
if (!isTRUE(file.info(todir)$isdir)) dir.create(todir, recursive=TRUE)
file.rename(from = from, to = to)
}
setwd(gsub(paste("/", basename(input_video), sep=""), "", input_video))
originalwd<-getwd()
dir2<-destination
## Preparing temperature CSV
if(gsub("^.*\\.", "", AT_Path)=="xlsx"){
ATFile_Dir = gsub(basename(AT_Path),"", AT_Path)
ATFile_Name = gsub("\\..*", "", basename(AT_Path))
AT_CSV = paste(ATFile_Dir, ATFile_Name, ".csv", sep="")
convert(AT_Path, AT_CSV)
CButtonFile(AT_CSV)
AT_CSVmod = paste(ATFile_Dir,basename(list.files(ATFile_Dir, full.names=TRUE)[which.max(file.info(list.files(ATFile_Dir, full.names=TRUE))$mtime)]),sep="")
AT_Clean = read.csv(AT_CSVmod)
CSVRm <- AT_CSVmod
if (file.exists(CSVRm)){file.remove(CSVRm)}
}
if(gsub("^.*\\.", "", AT_Path)=="xls"){
ATFile_Dir = gsub(basename(AT_Path),"", AT_Path)
ATFile_Name = gsub("\\..*", "", basename(AT_Path))
AT_CSV = paste(ATFile_Dir, ATFile_Name, ".csv", sep="")
convert(AT_Path, AT_CSV)
CButtonFile(AT_CSV)
AT_CSVmod = paste(ATFile_Dir,basename(list.files(ATFile_Dir, full.names=TRUE)[which.max(file.info(list.files(ATFile_Dir, full.names=TRUE))$mtime)]),sep="")
AT_Clean = read.csv(AT_CSVmod)
CSVRm <- AT_CSVmod
if (file.exists(CSVRm)){file.remove(CSVRm)}
}
if(gsub("^.*\\.", "", AT_Path)=="csv"){
temp_AT=read.csv(AT_Path)
if(colnames(temp_AT)[1]=="Date"){
AT_Clean = temp_AT
} else {
CButtonFile(AT_Path)
ATFile_Dir = gsub(basename(AT_Path),"", AT_Path)
AT_Data = paste(ATFile_Dir,basename(list.files(ATFile_Dir, full.names=TRUE)[which.max(file.info(list.files(ATFile_Dir, full.names=TRUE))$mtime)]),sep="")
AT_Clean = read.csv(AT_Data)
CSVRm <- AT_Data
if (file.exists(CSVRm)){file.remove(CSVRm)}
}
}
FairExtensions=c("csv","xlsx")
if(gsub("^.*\\.", "", AT_Path)%in%FairExtensions=="FALSE"){
return("Incorrect format of ambient temperature file")
}
WriteFile=gsub("\\..*", "", input_video)
readingIn <- file(input_video, "rb")
BinData <- readBin(readingIn, raw(), n = file.info(input_video)$size)
close(readingIn)
Imagelength = (iwidth*iheight)*2
NoFrames = (length(BinData) - voffset)/(Imagelength + gapsize)
if (parallel == "FALSE"){
for (i in 1:NoFrames){
Image=BinData[(voffset+(Imagelength+gapsize)*(i-1)+1):((voffset+(Imagelength+gapsize)*(i))-gapsize+1)]
tempcon <- file("temp")
open(tempcon, "wb")
writeBin(Image, tempcon, raw(), endian = .Platform$endian)
close(tempcon)
readTemp <- file("temp", "rb")
radiance <- readBin(readTemp, integer(), n = file.info("temp")$size, size=2, endian="little")
assign(paste("radiance", i, sep="_"), radiance)
close(readTemp)
}
} else if (parallel == "TRUE"){
ret_bin = function(x, P_R1, P_R2, P_B, P_F, P_O, emiss, OD, FrameSeconds, CleanData, hum, transmit){
tiffmultiplier = 3.0904822947
tiffoffset = 240.6247734137
readTemp = file(x, "rb")
to_ret = readBin(readTemp, integer(), n = file.info(x)$size, size=2, endian="little")
close(readTemp)
ToRemove = x
invisible(file.remove(ToRemove))
AT = CleanData[which(abs(CleanData$TIS-FrameSeconds)==min(abs(CleanData$TIS-FrameSeconds))),5]
RT = CleanData[which(abs(CleanData$TIS-FrameSeconds)==min(abs(CleanData$TIS-FrameSeconds))),5]
WT = CleanData[which(abs(CleanData$TIS-FrameSeconds)==min(abs(CleanData$TIS-FrameSeconds))),5]
to_ret_adj = tiffmultiplier*(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 = WT, wind_transmittance = transmit, humidity = hum))-tiffoffset
return(to_ret_adj)
}
P_R1 = P_R1
P_R2 = P_R2
P_B = P_B
P_F = P_F
P_O = P_O
emiss = emiss
OD = OD
registerDoParallel()
Temp_vals = foreach(j=1:NoFrames) %dopar% {
FrameSeconds=c()
FrameSeconds=Absolute_Seconds+(Second_inc*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, CleanData = AT_Clean, hum = hum, transmit = transmit))
}
} else {
return("Incorrect value for 'parallel' parameter.")
}
ToRemove = "temp"
if (file.exists(ToRemove)){file.remove(ToRemove)}
if (parallel == "FALSE"){
Temp_vals = vector('list', NoFrames)
for (i in 1:NoFrames){
FrameSeconds=c()
FrameSeconds=Absolute_Seconds+(Second_inc*i)
P_R1 = P_R1
P_R2 = P_R2
P_B = P_B
P_F = P_F
P_O = P_O
emiss = emiss
OD = OD
AT = AT_Clean[which(abs(AT_Clean$TIS-FrameSeconds)==min(abs(AT_Clean$TIS-FrameSeconds))),5]
RT = AT_Clean[which(abs(AT_Clean$TIS-FrameSeconds)==min(abs(AT_Clean$TIS-FrameSeconds))),5]
WT = AT_Clean[which(abs(AT_Clean$TIS-FrameSeconds)==min(abs(AT_Clean$TIS-FrameSeconds))),5]
transmit = transmit
hum = hum
tiffmultiplier = 3.0904822947
tiffoffset = 240.6247734137
viewed_frame=paste("radiance", i, sep="_")
Temp_vals[[i]] = tiffmultiplier*(Rad_Temp(get(viewed_frame), 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 = WT, wind_transmittance = transmit, humidity = hum))-tiffoffset
}
} else if (parallel == "TRUE"){
} else {
return("Incorrect call for 'parallel' parameter.")
}
setwd(dir2)
for (j in 1:ceiling(NoFrames/fps)){
FITSArray <- array(dim=c(336,256,fps))
for (i in (1+(fps*(j-1))):(j*fps)){
if (i <= length(Temp_vals)){
FITSdf=as.data.frame(matrix(Temp_vals[[i]], ncol=256))
FITSdf[,1:ncol(FITSdf)]=rev(FITSdf[,1:ncol(FITSdf)])
FITSArray[,,(i-((j-1)*fps))]=as.matrix(FITSdf)
}
WriteFITS=paste(dir2, "/", basename(WriteFile), "_", j, ".fits", sep="")
writeFITSim(FITSArray, file = WriteFITS, type = "single")
}
}
setwd(gsub(paste("/", basename(input_video), sep=""), "", input_video))
closeAllConnections()
## Update creation times
New_DateTimes = c()
for (i in 1:NoFrames){
New_DateTimes[i] = paste(video_CD, Sec2Time(Absolute_Seconds +(i-1)), sep=" ")
}
All_DateTimes = data.frame("Date_Time" = New_DateTimes)
write.csv(All_DateTimes, "Temp_DT.csv", row.names=FALSE)
ReconDest<-as.character(gsub("/", "\\\\\\\\", destination))
ReconSource<-as.character(gsub("/", "\\\\\\\\", (gsub(paste("/", basename(input_video), sep=""), "", input_video))))
if(Sys.info()[[1]]=="Windows"){
powershellstring<-{
paste("powershell Import-Module Microsoft.PowerShell.Management; ",
"Import-Module Microsoft.PowerShell.Utility; ",
"Import-Module PSReadline; ",
"$FITSDir = ", "\\", '"', ReconDest, "\\", '"', "; ",
"cd $FITSDir; ",
"$FITSChI = get-childitem $FITSDir; ",
"$FITSList = $FITSChI | where {$_.extension -eq ", "\\", '"', ".fits", "\\", '"', "} | sort LastWriteTime; ",
"$CSVDir = ", "\\", '"', ReconSource, "\\", '"', "; ",
"cd $CSVDir; ",
"$NewDateList = @(Import-Csv Temp_DT.csv); ",
"cd $FITSDir; ",
"for ($i=0; $i - ($FITSList.length); $i++){ ",
"(Get-Item $FITSList[$i]).LastWriteTime = $NewDateList[$i].Date_Time}", sep="")
}
system(powershellstring)
} else {
print("This package currently supports Windows alone. Our apologies!")
}
ToRemove_CSV <- "Temp_DT.csv"
if (file.exists(ToRemove_CSV)){file.remove(ToRemove_CSV)}
return("Conversion complete")
}
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.