R/Fill_IF_function.R

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

#' ReVuePro: Fill_IF
#'
#' A function that identifies 'start' and 'end' positions in a dataframe and replaces them with presence values of '1'.
#' @param data The path to your .csv file that requires filling. There is no default input.
#' @param image_folder The path to your images used to construct the data in .csv form. There is no default input.
#' @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 dataframe, replace
#' @export
#' @import dplyr stringr tidyr
#' @examples
#' setwd("C:/Users/Yukon/Desktop/BirdVids")
#' Present_Birds<-Fill_IF("Bird Video Output.csv", "./BirdImages"))
#' print(Present_Birds)

Fill_IF = function(data, image_folder, vid, ffmpeg_path = "DEFAULT", ips = 8){
  
require('dplyr')
library("stringr")
require('tidyr')

if (file.exists(data) == "TRUE"){
	data = read.csv(data)
	} else {
	return("Data file does not exist.")
	}

if (file.exists(vid) == "TRUE"){
	input_vid = vid
	} else {
	return("Video file does not exist.")
	}

Cols = colnames(data)[5:ncol(data)]
which_start = function(x){
	which(x == "Start")
	}
which_end = function(x){
	which(x == "End")
	}

if (length(Cols) > 1){
Beginnings = lapply(data[,Cols], which_start)
	Blist.lengths = as.numeric(as.table(summary(Beginnings))[,1])
	if (0 %in% Blist.lengths == "TRUE"){
	to_remove = which(Blist.lengths == 0)
	Beginnings = Beginnings[-to_remove]
	} else {
	Beginnings = Beginnings
	}
} else {
Beginnings = which_start(data[,Cols])
}

if (length(Cols) > 1){
Endings = lapply(data[,Cols], which_end)
	Elist.lengths = as.numeric(as.table(summary(Endings))[,1])
	if (0 %in% Elist.lengths == "TRUE"){
	to_remove = which(Elist.lengths == 0)
	Endings = Endings[-to_remove]
	} else {
	Endings = Endings
	}
} else {
Endings = which_end(data[,Cols])
}

if (length(Beginnings) == 0 & length(Endings) == 0){
  Recon = data
} else {
if (length(Beginnings) != length(Endings)){
	return("Mismatching number of start and end points")
	} else {}

if (exists(paste("to_remove", sep = "")) == "TRUE"){
	Cols = Cols[-to_remove]
	} else {}

pull_seq = function(x){

  if (is.list(Beginnings) == "TRUE" & is.list(Endings) == "TRUE"){
    if (length(Beginnings) == length(Endings)){
      bird_present = c()
      
      for (i in 1:length(Beginnings)){
        bird_present = c(bird_present, seq(from = Beginnings[[i]], to = Endings[[i]]))
      }
      return(bird_present)
    } else {
      return("Mismatching number of start and end points")
    }
  } else {
  
  if (length(Beginnings) == length(Endings)){
	bird_present = c()

	for (i in 1:length(Beginnings)){
	bird_present = c(bird_present, seq(from = Beginnings[i], to = Endings[i]))
	}
	return(bird_present)
	} else {
	return("Mismatching number of start and end points")
	}
 }  
}
 
pull_seq_list = function(x){
	if (length(Beginnings[[x]]) == length(Endings[[x]])){
	bird_present = c()

	for (i in 1:length(Beginnings[[x]])){
	bird_present = c(bird_present, seq(from = Beginnings[[x]][i], to = Endings[[x]][i]))
	}
	return(bird_present)
	} else {
	return("Mismatching number of start and end points")
	}
}

if (length(Cols) > 1){
	With_Birds = lapply(c(1:length(Cols)), pull_seq_list)
} else {
	With_Birds = pull_seq(Cols)
}

    if (grepl("TRUE", paste(grepl("Mismatching", With_Birds), collapse = ",")) == "TRUE"){
	return(paste("Mismatching number of start to end points in birds ",
	paste(colnames(data)[4 + which(paste(grepl("Mismatching", With_Birds)) == "TRUE")], collapse = ", "),
	" of pen ", levels(data$Pen.ID)[which((levels(data$Pen.ID)) != 0)], sep = ""))
    } else {}

fill_holes = function(x){
	New_Factors = factor(data[,Cols[x]], levels = c(levels(data[,Cols[x]]), "1"))
	New_Col = replace(New_Factors, With_Birds, 1) 
	return(New_Col)
}

fill_holes_list = function(x){
	New_Factors = factor(data[,Cols[x]], levels = c(levels(data[,Cols[x]]), "1"))
	New_Col = replace(New_Factors, With_Birds[[x]], 1) 
	return(New_Col)
}

if (length(Cols) > 1){
	Filled_Columns = lapply(c(1:length(Cols)), fill_holes_list)
	Filled_DF = as.data.frame(Filled_Columns)
	colnames(Filled_DF) = Cols
} else {
	Filled_Columns = fill_holes(1)
	Filled_DF = as.data.frame(Filled_Columns)
	colnames(Filled_DF) = Cols
}
Recon = cbind(data[,1:4], Filled_DF)
}
## Filling holes in Pen, Date, and Image Number Columns

Pen = levels(Recon$Pen.ID)[c(which(!(levels(Recon$Pen.ID) %in% c("", "0")) == "TRUE"))]
Recon$Pen = Pen

Datecol_factor = as.factor(as.character(Recon$Date..YYYYMMDD.))
Date = levels(Datecol_factor)[c(which(!(levels(Datecol_factor) %in% c("", "0")) == "TRUE"))]
Recon$Date = Date

Recon$Image = seq(1:nrow(Recon))

Images = list.files(image_folder, pattern = ".jpg")
if (length(Images) == nrow(Recon)){
	Recon$Image.Name = Images
	} else if (length(Images) > nrow(Recon)){
	Recon = add_row(Recon, Image = c((nrow(Recon)+1):length(Images)), 
	Pen = Pen, Date = Date, Initials = Recon$Initials[1])
	Recon$Image.Name = Images
	} else if (length(Images) < nrow(Recon)){
	return("Number of images is less than length of .csv dataframe")
	}

# Filling Bird Columns

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

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

Recon = select(Recon, c(Initials, Date, Pen, Image.Name, Image, Bird..1, Bird..2, Bird..3, Bird..4, Bird..5))
Recon[is.na(Recon)] = "0"

## Expanding dataframe to include all possible images

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 = ""))

# Possible Data

Initials = as.character(rep(Recon$Initials[1], length(Possible_im)))
Date = rep(Recon$Date[1], length(Possible_im))
Pen = rep(Recon$Pen[1], length(Possible_im))

All_Data = data.frame(Initials, Date, Pen, "Image.Name" = Possible_im)
Final = merge(All_Data, Recon, by = "Image.Name", all = TRUE)

Time_sec = seq(from = 1/ips, to = nrow(Final)/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 = ":")

Final$Vid_Time = Time_hhmmss

Final = select(Final, c(Initials.x, Date.x, Pen.x, Image.Name, Vid_Time, Bird..1, Bird..2, Bird..3, Bird..4, Bird..5))
colnames(Final) = c("Initials", "Date", "Pen", "Image.Name", "Video.Time", "Bird.1", "Bird.2", "Bird.3", "Bird.4", "Bird.5")
Final[is.na(Final)] = "0"

return(Final)

}