From 71128ce9792de2ea442f26613817dd421b292543 Mon Sep 17 00:00:00 2001 From: rebeccathomas-NOAA <79660143+rebeccathomas-NOAA@users.noreply.github.com> Date: Tue, 19 Mar 2024 10:51:46 -0700 Subject: [PATCH] pulled over Check_EV_Properties.R and updated basic_comps --- R/Check_EV_Properties.R | 128 +++++++++++++++++++++++++++++++++ R/basic_comps.R | 142 +++++++++++++++++++++++++++++++++++++ man/Check_EV_Properties.Rd | 30 ++++++++ man/basic_comps.Rd | 27 +++++++ old/hello.Rd | 12 ++++ 5 files changed, 339 insertions(+) create mode 100644 R/Check_EV_Properties.R create mode 100644 R/basic_comps.R create mode 100644 man/Check_EV_Properties.Rd create mode 100644 man/basic_comps.Rd create mode 100644 old/hello.Rd diff --git a/R/Check_EV_Properties.R b/R/Check_EV_Properties.R new file mode 100644 index 0000000..1a22bb7 --- /dev/null +++ b/R/Check_EV_Properties.R @@ -0,0 +1,128 @@ +#' Check_EV_Properties.R +#' +#' @description Uses COM objects to run Echoview and get transducer properties. These properties are +#' saved to a .csv file in the Data_Compile_dir of the DirNameFile excel spreadsheet. The name defaults +#' to TransducerConfigCheck(SurveyName).csv +#' +#' @param SurveyName name of survey as in excel file +#' @param DirNameFile excel file name of paths +#' @param variables - variables to export +#' @param database is an optional argument for export format. Default is database (1). Spreadsheet =0 +#' @param sheet is an optional argument to denote which sheet of the DirNameFile +#' want to use. This defaults to the first sheet if not set. +#' @examples +#' \dontrun{ +#' Check_EV_Properties(SurveyName1in, DirNameFile,variables,sheet=case) +#'} +#' @export +#' +Check_EV_Properties<-function(SurveyName, DirNameFile,variables,sheet=case){ + ### Uses COM objects to run Echoview and get transducer properties + #Adapted from Beth Phillip's script 2023 + + # # Location of EV files to check transducer settings + DirTable <- readxl::read_excel(DirNameFile,sheet) + DirTableSurvey<- subset(DirTable, Survey == SurveyName) + DirTableSurvey[] <- lapply(DirTableSurvey, function(x) if(is.factor(x)) factor(x) else x) #to ensure dataframe actually removed other variables in subset + BaseJudgePath <- as.character(DirTableSurvey$Base_Path) + ExportPath <- DirTableSurvey$Data_Compile_Dir + #EVdirs <-DirTableSurvey$Orig_EV_Dir + EVdirs<-BaseJudgePath + expected_ducerdepth <- DirTableSurvey$DucerDepth #expected transducer vertical offset for each vessel + + # Make directory that data will be saved in if it doesn't exist + dir.create(file.path(ExportPath), showWarnings = FALSE) + + ######################### + # list the EV files to update transducer properties + EVfile.list <- list.files(paste0(EVdirs), pattern=".EV$", ignore.case = TRUE) + + ############################################### + # Open Original EV file to get settings # + ############################################### + + ducer_location.list = list() + ducer_locations.list = list() + + + for (i in EVfile.list){ + # EV filename + var=variables #reset in case it was changed + EVfileNames <- file.path(EVdirs, i) + EvName <- strsplit(i, split = '*.EV')[[1]] + Tr=strsplit(EvName,"x")[[1]][2] #get transect number + EVfileName <- file.path(EVdirs, i) + print(EVfileName) + + # create COM connection between R and Echoview + EVApp <- COMCreate("EchoviewCom.EvApplication") + EVApp$Minimize() #Minimize EV file to run in background + + # open EV file + EVfile <- EVApp$OpenFile(EVfileName) + Obj <- EVfile[["Variables"]] + if (is.null(Obj$FindByName(var))==TRUE){ + var<-paste0(var,' (1)') #try adding (1) to the variable if it doesn't work the first time + } + varac <- Obj$FindByName(var)$AsVariableAcoustic() + # access transducer properties + transducerobj <- EVfile[["Transducers"]] + no_trans <- transducerobj[["Count"]] + no_trans_list <-vector(mode="list", length=no_trans) + + #get transducer depth (vertical offset), and x- y- offset settings + #for survey purposes, just look at 38 kHz + #for (k in 1:length(no_trans_list)){ + k=2 #38 kHz + # get offset settings for each transducer + transducerobj_props <- EVfile[["Transducers"]]$Item(k-1) + Freq <- transducerobj_props[["Name"]] + x_offset <- transducerobj_props[["AlongshipOffset"]] + y_offset <- transducerobj_props[["AthwartshipOffset"]] + z_offset <- transducerobj_props[["VerticalOffset"]] + flag <- ifelse(z_offset==expected_ducerdepth,"N","Y") + ducer_location.list[[k]] <- c(EvName,Freq,x_offset,y_offset,z_offset,flag) + #} + #combine settings for each transducer + ducer_location = do.call(rbind, ducer_location.list) + #add transducer settings for transect to rest of the transects + ducer_locations.list[[i]] <- ducer_location + #add more values of interest + ducer_locations.list[i][[1]][7]<-varac[["Properties"]][["Analysis"]][["Excludebelow"]] + ducer_locations.list[i][[1]][8]<-varac[["Properties"]][["Analysis"]][["BadDataHasVolume"]] + TDmode<-varac[["Properties"]][["Grid"]][["TimeDistanceMode"]] + if(TDmode==2){TDmodech<-"GPSNMi"} + if(TDmode==3){TDmodech<-"VesselLogNMi"} + ducer_locations.list[i][[1]][9]<-TDmodech + varaccal<-varac[["Properties"]][["Calibration"]] + ducer_locations.list[i][[1]][10]<-varaccal$Get("SoundSpeed",1) + ducer_locations.list[i][[1]][11]<-varaccal$Get("Ek5TsGain",1) + ducer_locations.list[i][[1]][12]<-varaccal$Get("EK60SaCorrection",1) + # Close EV file + EVApp$CloseFile(EVfile) + + # Quit echoview + EVApp$Quit() + + } + + # Bind all rows from transects and transducer settings into a data frame + ducer_locations = as.data.frame(do.call(rbind, ducer_locations.list)) + + #Change column names of data frame + names(ducer_locations)[1] <- "Transect" + names(ducer_locations)[2] <- "Transducer name" + names(ducer_locations)[3] <- "x_offset" + names(ducer_locations)[4] <- "y_offset" + names(ducer_locations)[5] <- "z_offset" + names(ducer_locations)[6] <- "Flag" + names(ducer_locations)[7] <- "Exclude_below_line" + names(ducer_locations)[8] <- "Include_volume_nodata_samples" + names(ducer_locations)[9] <- "TimeDistanceMode" + names(ducer_locations)[10] <- "SoundSpeed" + names(ducer_locations)[11] <- "TsGain" + names(ducer_locations)[12] <- "SaCorrection" + ducer_locations + + write.csv(ducer_locations, paste0(ExportPath,"/TransducerConfigCheck",SurveyName,".csv"),row.names = FALSE) +} \ No newline at end of file diff --git a/R/basic_comps.R b/R/basic_comps.R new file mode 100644 index 0000000..ccd2694 --- /dev/null +++ b/R/basic_comps.R @@ -0,0 +1,142 @@ +#' basic_comps.R +#' +#' @description Function to compare two dataframes of Echoview file exports. +#' The output is a list along with plots. The first item in the list are Boolean values that reflect +#' the answers to the following questions: +#' The second item in the list are the row and columns of differences between the +#' two dataframes. +#' +#' @param X data frame +#' @param Y second data frame +#' @param compcols the names of columns to be compared for certain comparisons + +#' @examples +#' \dontrun{ +#' T<-basiccomps(data,data2) +#'} +#' @export + +basic_comps<-function(X,Y,compcols,imagedirin,case1in, case2in,...){ + nL<-10 + year<-substr(X$Survey[1],1,4) + L<-vector(length=nL) #make vector to put test outputs into + #Test for same number of columns + if ((ncol(X)!=ncol(Y))==TRUE){ + print('The number of columns in the two dataframes are not the same') + L[1]<-FALSE + SameNumCol<-FALSE + } else{ + #Are data frames identical? + L[1]<-identical(X,Y) #Are data frames identical? + SameNumCol<-TRUE + } + Xc<-dplyr::select(X,dplyr::all_of(c(compcols,"Transect"))) + Xc$dataset<-case1in + Yc<-dplyr::select(Y,dplyr::all_of(c(compcols, "Transect"))) + Yc$dataset<-case2in + XYc<-rbind(Xc,Yc) + #Are sums of compared columns identical? + L[2]<-identical(colSums(Xc[,compcols]),colSums(Yc[,compcols])) + #Are the (location and) values of the compared columns identical? + L[3]<-identical(Xc,Yc) + #Test for same number of row + if ((nrow(Xc)!=nrow(Yc))==TRUE){ + print('The number of rows in the two dataframes are not the same') + RC=FALSE + } else{ + #Are data frames identical? + RC=which(Xc != Yc, arr.ind=TRUE) #has to have the same number of rows for this to work + } + + #Make a table to look at summed NASC by transect + #data_SumbyT_c<-aggregate(X[compcols], list(data$Transect), FUN=sum) + #names(data_SumbyT_c)[names(data_SumbyT_c) == 'Group.1'] <- 'Transect' + #data2_SumbyT_c<-aggregate(data2[compcols], list(data2$Transect), FUN=sum) + #names(data2_SumbyT_c)[names(data2_SumbyT_c) == 'Group.1'] <- 'Transect' + XYc_SumbyT_c<-aggregate(.~Transect+dataset, XYc, FUN=sum) + names(XYc_SumbyT_c)[names(XYc_SumbyT_c) == 'Group.1'] <- 'Transect' + ### + #make plots/displays + ### + # Display this if the numbers of columns are not the same + if(SameNumCol==FALSE){ + test<-janitor::compare_df_cols(X,Y) #use janitor package to show difference between columns + print(test) + ft<-flextable::flextable(test) + ft<-flextable::set_header_labels(ft,X=Xc$dataset[1],Y=Yc$dataset[2]) + saveRDS(ft,file.path(imagedirin,"2011_export_column_table")) + } + + # Make these plots of the numbers of rows are not the same + if(RC==FALSE){ + VLdiffs1<-setdiff(X$VL_start, Y$VL_start) + VLdiffs2<-setdiff(Y$VL_start, X$VL_start) + print(paste(c('The second dataframe does not have the vessel logs ',VLdiffs1),collapse =" ")) + print(paste(c('The first dataframe does not have the vessel logs ',VLdiffs2),collapse =" ")) + } + + if(RC==TRUE){ + # Make these plots when the data frame sizes are the same + #make plots of each of the compared columns in each dataset + par(mfrow=c(length(compcols),1)) + for (k in 1:length(compcols)){ + plot(as.numeric(Xc[,k]),as.numeric(Yc[,k]),type='o',main=compcols[k],xlab='First data set',ylab='Second data set') + filename <- file.path(imagedirin,paste0("Compared ", compcols[k]," for survey ", X$Survey[1], ".png")) + dev.copy(png, filename, width = 1000) + dev.off() + } + + #plot x axis as interval, y axis the data for each of the compared columns on top of each other + par(mfrow=c(1,1)) + for (k in 1:length(compcols)){ + plot(X$Interval,as.numeric(Xc[,k]),col='blue',main=compcols[k],xlab='Interval') + par(new=TRUE) + plot(Y$Interval,as.numeric(Yc[,k]),col='green',main=compcols[k],xlab='Interval') + legend(x="topleft",legend =c('First dataset','Second dataset'),col=c("blue", "green"),pch=1, cex=0.8) + filename <- file.path(imagedirin,paste0("Overlain ", compcols[k]," for survey ", X$Survey[1], ".png")) + dev.copy(png, filename, width = 1000) + dev.off() + } + } + + + # Make these plots regardless + # Plot sum of transect NASC + par(mfrow=c(1,1)) + for (k in 1:length(compcols)){ + #below in base R, but decided to switch to ggplot + # plot(data_SumbyT_c$Transect,as.numeric(data_SumbyT_c[,k+1]),col='blue',main=compcols[k],xlab='Transect',ylab='Sum') + # points(data2_SumbyT_c$Transect,as.numeric(data2_SumbyT_c[,k+1]),col='green',) + # legend(x="topright",inset=c(0, -.1),legend =c('First dataset','Second dataset'),col=c("blue", "green"),pch=1, cex=0.8) + filename <- file.path(imagedirin,paste0("Overlain transect summed ", compcols[k]," for ", year , " survey.png")) + # dev.copy(png, filename, width = 1000) + # dev.off() + #p<-ggplot(data=XYc_SumbyT_c,aes_string(x="Transect",y=compcols[k]), group="dataset")+ # + p<-ggplot(data=XYc_SumbyT_c,aes(x=Transect,y=!!sym(compcols[k])), group=dataset)+ #https://stackoverflow.com/questions/22309285/how-to-use-a-variable-to-specify-column-name-in-ggplot + labs(title=compcols[k], x='Transect',y='Sum')+ + geom_point(aes(col=dataset))+ + theme_bw() + print(p) + ggsave(filename,dpi=500) #could maybe use saveRDS instead if wanted to be loaded just into markdown later. + } + ## plot summed NASC + par(mfrow=c(1,1)) + ss=c(sum(X$PRC_NASC),sum(Y$PRC_NASC)) + barplot(ss, main="Summed NASC") + lbs=paste(c("difference:", round(diff(ss),2), ",proportion:",round(diff(ss)/ss[1],3)), collapse=" ") + text(1,ss[1]/2,lbs) + filename <- file.path(imagedirin,paste0("Summed NASC for ", year, " survey.png")) + dev.copy(png, filename, width = 1000) + dev.off() + + ## Make table of NASC and differences + case1_NASC<-ss[1] + case2_NASC<-ss[2] + Per_diff=round(diff(ss)*100/case1_NASC,5) #round to 5 decimal places + sstable<-data.frame(year,case1_NASC,case2_NASC,Per_diff) + ftNASC<-flextable::flextable(sstable) + ftNASC<-flextable::set_header_labels(ftNASC,case1_NASC=case1,case2_NASC=case2, Per_diff="Percent Difference") + saveRDS(ftNASC,file.path(imagedirin,"2011_export_NASC_table")) + + return(list(L,RC,ss)) +} diff --git a/man/Check_EV_Properties.Rd b/man/Check_EV_Properties.Rd new file mode 100644 index 0000000..fb2dd88 --- /dev/null +++ b/man/Check_EV_Properties.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Check_EV_Properties.R +\name{Check_EV_Properties} +\alias{Check_EV_Properties} +\title{Check_EV_Properties.R} +\usage{ +Check_EV_Properties(SurveyName, DirNameFile, variables, sheet = case) +} +\arguments{ +\item{SurveyName}{name of survey as in excel file} + +\item{DirNameFile}{excel file name of paths} + +\item{variables}{- variables to export} + +\item{sheet}{is an optional argument to denote which sheet of the DirNameFile +want to use. This defaults to the first sheet if not set.} + +\item{database}{is an optional argument for export format. Default is database (1). Spreadsheet =0} +} +\description{ +Uses COM objects to run Echoview and get transducer properties. These properties are +saved to a .csv file in the Data_Compile_dir of the DirNameFile excel spreadsheet. The name defaults +to TransducerConfigCheck(SurveyName).csv +} +\examples{ + \dontrun{ +Check_EV_Properties(SurveyName1in, DirNameFile,variables,sheet=case) +} +} diff --git a/man/basic_comps.Rd b/man/basic_comps.Rd new file mode 100644 index 0000000..f1d3953 --- /dev/null +++ b/man/basic_comps.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/basic_comps.R +\name{basic_comps} +\alias{basic_comps} +\title{basic_comps.R} +\usage{ +basic_comps(X, Y, compcols, imagedirin, case1in, case2in, ...) +} +\arguments{ +\item{X}{data frame} + +\item{Y}{second data frame} + +\item{compcols}{the names of columns to be compared for certain comparisons} +} +\description{ +Function to compare two dataframes of Echoview file exports. +The output is a list along with plots. The first item in the list are Boolean values that reflect +the answers to the following questions: +The second item in the list are the row and columns of differences between the +two dataframes. +} +\examples{ + \dontrun{ +T<-basiccomps(data,data2) +} +} diff --git a/old/hello.Rd b/old/hello.Rd new file mode 100644 index 0000000..0fa7c4b --- /dev/null +++ b/old/hello.Rd @@ -0,0 +1,12 @@ +\name{hello} +\alias{hello} +\title{Hello, World!} +\usage{ +hello() +} +\description{ +Prints 'Hello, world!'. +} +\examples{ +hello() +}