pulled over Check_EV_Properties.R and updated basic_comps

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)
+}

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))    
+}

old/hello.Rd

@@ -0,0 +1,12 @@
+\name{hello}
+\alias{hello}
+\title{Hello, World!}
+\usage{
+hello()
+}
+\description{
+Prints 'Hello, world!'.
+}
+\examples{
+hello()
+}