R/Complete_IM_function.R

In joshuakrobertson/R-Package_ReVuePro: ReVuePro: Enabling analysis of thermal images captured by FLIRs VuePro R

#' ReVuePro: Complete_IM
#'
#' A function that expands an output from Fill_IF to include all time captured by an input video. 
#' This function calls ffmpeg and is currently limited to Windows architecture.
#' @details This function assumes that data were collected from a combination of the motion_sense function in the ReVuePro package, and custom ImageJ macros used to indicate individuals present at time of motion. Ffmpeg must be installed for this function to operate correctly. Furthermore, this function calls upon ffmpeg using Windows language, and is therefore currently limited to Windows users.
#' @param df A path to a .csv file containing output from ImageJ macros.
#' @param vid A path to the video file that images with motion were initially extracted from.
#' @param ffmpeg_path A path to ffmpeg.exe. Default path is assigned by the ffmpeg_dir function.
#' @param ips The frame-rate at which images were extracted from the input video, as applied in motion_sense. Default is 8.
#' @keywords ffmpeg, jpg, motion_sense
#' @import dplyr stringr
#' @examples
#' video = "C:/BirdsFeeding.mp4"
#' ffmpeg.locale = "C:/Users/Rudolf/ffmpeg.exe"
#' motion.data = "C:/BirdsFeeding_data.csv"
#' Complete_IM(df = motion.data, vid = video, ffmpeg_path = ffmpeg.locale, ips = 8)
#' @export

Complete_IM = function(df, vid, ffmpeg_path = "DEFAULT", ips = 8){

library("dplyr")
library("stringr")

dir = getwd()

input_vid = vid
data.file = df

base = gsub("\\..*", "", basename(input_vid))

	if (ffmpeg_path == "DEFAULT"){
      ffmpeg.path = paste(read.table(paste(.libPaths()[1], "/ffmpeg/","FFMPEG_DIRECTORY.txt", sep=""))[1,1])
	} else {
	ffmpeg.path = ffmpeg_path
	}

	pull_dur = paste('"', ffmpeg.path, '"', " -i ", '"', input_vid, '"', sep = "")
	Time = suppressWarnings(unlist(strsplit(gsub(".*: ", "", unlist(strsplit(system(pull_dur, intern = TRUE)[grep("Duration", system(pull_dur, intern = TRUE))], ","))[1]), ":")))
      Dur_Seconds = as.numeric(Time[1])*3600 + as.numeric(Time[2])*60 + as.numeric(Time[3])
	range_1 = c(0, floor((Dur_Seconds/2)*ips))
	range_2 = c((floor((Dur_Seconds/2)*ips) + 1), floor((Dur_Seconds)*ips))
	range_2_end = range_2_end = range_2[2] - range_2[1] 

Possible_im = c(paste(base, "R1_", 
	str_pad(seq(1, to = range_1[2]+1), 
	7, pad = "0"), ".jpg", sep = ""), 
	paste(base, "R2_", 
	str_pad(seq(1, to = range_2_end+1), 
	7, pad = "0"), ".jpg", sep = ""))

Data = Fill_IF(read.csv(data.file))

	if (grepl("Mismatching", Data) == "TRUE"){
	return(paste(Data, " in file ", base, ".", sep = ""))
	} else {}

Data.dir = gsub(basename(data.file), "", data.file)
setwd(Data.dir)
images = list.files(pattern = "\\.jpg$")[1:nrow(Data)]
Data$Images = images

Initials = rep(Data[!(Data[,1] == 0),1][1], length(Possible_im))
Date = rep(Data[!(Data[,2] == 0),2][1], length(Possible_im))
Pen = rep(Data[!(Data[,3] == 0),3][1], length(Possible_im))

All_Data = data.frame(Initials, Date, Pen, "Images" = Possible_im)

## Searching for bird presence

Absent.Bird = rep(0, nrow(Data))
Birds = c("Bird..1", "Bird..2", "Bird..3", "Bird..4", "Bird..5")

{
   if (Birds[1] %in% colnames(Data) == "TRUE"){
	} else {
   assign(paste(Birds[1]), Absent.Bird)
	Data$Bird..1 = Bird..1	
	}
   if (Birds[2] %in% colnames(Data) == "TRUE"){
	} else {
   assign(paste(Birds[2]), Absent.Bird)
	Data$Bird..2 = Bird..2	
	}
   if (Birds[3] %in% colnames(Data) == "TRUE"){
	} else {
   assign(paste(Birds[3]), Absent.Bird)
	Data$Bird..3 = Bird..3	
	}
   if (Birds[4] %in% colnames(Data) == "TRUE"){
	} else {
   assign(paste(Birds[4]), Absent.Bird)
	Data$Bird..4 = Bird..4	
	}
   if (Birds[5] %in% colnames(Data) == "TRUE"){
	} else {
   assign(paste(Birds[5]), Absent.Bird)
	Data$Bird..5 = Bird..5	
	}
}

Filled = merge(All_Data, Data, by = "Images", all = TRUE)
Time_sec = seq(from = 1/ips, to = nrow(Filled)/ips, by = 1/ips)
Time_hhmmss = paste(str_pad(floor(Time_sec/3600), 2, "0", side = "left"), 
	str_pad(floor((Time_sec - (floor(Time_sec/3600)*3600))/60), 2, "0", side = "left"),
	str_pad(floor((Time_sec - (floor(Time_sec/3600)*3600)) - 
	(floor((Time_sec - (floor(Time_sec/3600)*3600))/60)*60)), 2, "0", side = "left"),
	sep = ":")
Filled$Vid_Time = Time_hhmmss

DatePreserve_vec = function(input_video, ffmpeg_path = "DEFAULT", ips = 8){

	library("dplyr")
	library("stringr")
	dir = getwd()
	base = gsub("\\..*", "", basename(input_video))
	if (ffmpeg_path == "DEFAULT") {
		ffmpeg.path = paste(read.table(paste(.libPaths()[1], 
		"/ffmpeg/", "FFMPEG_DIRECTORY.txt", sep = ""))[1, 
		1])
	} else {
	ffmpeg.path = ffmpeg_path
	}
	pull_dur = paste("\"", ffmpeg.path, "\"", " -i ", "\"", input_video, 
		"\"", sep = "")
	Time = suppressWarnings(unlist(strsplit(gsub(".*: ", "", 
		unlist(strsplit(system(pull_dur, intern = TRUE)[grep("Duration", 
		system(pull_dur, intern = TRUE))], ","))[1]), ":")))
	Dur_Seconds = as.numeric(Time[1]) * 3600 + as.numeric(Time[2]) * 
		60 + as.numeric(Time[3])

    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; ", "$VidDir = ", 
		"\\", "\"", ReconSource, "\\", "\"", "; ", "cd $VidDir; ", 
		"$VidWriteTime = ", "\\", "\"", "{0:HH:mm:ss}", "\\", "\"", 
		" -f [datetime](Get-ItemProperty -Path \\", "\"", ".\\", 
		basename(input_video), "\\", "\"",
		" -Name CreationTime).creationtime; ", "$VidWriteTime", 
		sep = "") 
		}
	Real_Time = system(powershellstring, intern = TRUE)
	T_Seconds =  as.numeric(unlist(strsplit(Real_Time, ":"))[1])*3600 + 
		as.numeric(unlist(strsplit(Real_Time, ":"))[2])*60 + 
		as.numeric(unlist(strsplit(Real_Time, ":"))[3])

	Dur_Seq = seq(from = 0, to = Dur_Seconds, by = 1/ips)
	Time_Seq = Dur_Seq + T_Seconds
	
	Sec2Time = function(x){
	hours = floor(x/3600)
	minutes = floor((x - hours*3600)/60)
	seconds = floor(x - hours*3600 - minutes*60)
	out = paste(str_pad(hours, 2, "0", side = "left"), 
		str_pad(minutes, 2, "0", side = "left"), 
		str_pad(seconds, 2, "0", side = "left"), sep = ":")
	return(out)
	}
	FullTime_Seq = unlist(lapply(Time_Seq, Sec2Time))
	return(FullTime_Seq)
	} else {
	return("This package is only supported under Windows architecture at the moment. Our apologies.")
	}
}

Real_Time = DatePreserve_vec(input_video = vid, ffmpeg_path = ffmpeg_path, ips = ips)

Filled$Real_Time = Real_Time

Filled = Filled %>% select("Initials" = Initials.x, Date, Pen, Vid_Time, Real_Time, Bird..1, Bird..2, Bird..3, Bird..4, Bird..5, Images)
Filled[is.na(Filled)] = 0 
Filled = Filled %>% mutate(Bird..1 = as.numeric(as.character(Bird..1)),
	Bird..2 = as.numeric(as.character(Bird..2)),
	Bird..3 = as.numeric(as.character(Bird..3)),
	Bird..4 = as.numeric(as.character(Bird..4)),
	Bird..5 = as.numeric(as.character(Bird..5)))

setwd(dir)
return(Filled)
}