In bridachristian/DataQualityCheckEuracAlpEnv:

Report start at r Sys.time()

input_dir <- params$input_dir
output_dir_data <- params$output_dir_data
output_dir_report <- params$output_dir_report
project_dir <- params$project_dir
data_from_row <- params$data_from_row
header_row_number <- params$header_row_number
datetime_header <- params$datetime_header
datetime_format <- params$datetime_format
datetime_sampling <- params$datetime_sampling
record_header <- params$record_header
range_file <- params$range_file
write_output_files <- params$write_output_files
write_output_report <- params$write_output_report
file_name <- params$file_name
station_name <- params$station_name
logger_info_file <- params$logger_info_file
record_check <- params$record_check
start_date <- params$start_date

# ~~~ Default directory ~~~~

# range_dir <- paste(project_dir, "Data/Support_files/Range/",sep = "")


# .....................................................................................................................................................

# ..... Define flags ..................................................................................................................................

flag_empty = NA
flag_logger_number = NA
flag_error_df = NA
flag_date = NA
flag_duplicates_rows = NA
flag_overlap = NA
flag_missing_records = NA
flag_missing_dates = NA
flag_range_variable_to_set = NA
flag_range_variable_new = NA
flag_out_of_range = NA

# ..... Body ..........................................................................................................................................

if(check_empty_file(INPUT_DATA_DIR = input_dir, FILE_NAME = file_name) == TRUE){

  flag_empty = 1

}else{

  flag_empty = 0

  data_import <- read_data(INPUT_DATA_DIR = input_dir, FILE_NAME = file_name, 
                           DATETIME_HEADER = datetime_header, DATETIME_FORMAT = datetime_format,
                           DATA_FROM_ROW = data_from_row, HEADER_ROW_NUMBER = header_row_number)  
  header = data_import [[1]]
  header_colnames = data_import [[2]]
  data = data_import [[3]]
  flag_error_df = data_import [[4]]

  data = data[order(data[,which(colnames(data) == datetime_header)]),]               #### add to order dataframe by date

  rm(data_import)

  logger_number = header[1,4]                                                                   # check logger numbers
  software_version = header[1,6]
  logger_info_csv = read.csv(file = logger_info_file, stringsAsFactors = F)
  col_log = colnames(logger_info_csv)
  w_logger = which(logger_info_csv[,1] == station_name)
  # w_logger = which(logger_info_csv[,1] == substring(file_name, 1, nchar(file_name)-4))

  if(length(w_logger) == 0){
    logger_info_csv = rbind(logger_info_csv, c(station_name, logger_number, software_version))
    colnames(logger_info_csv) = col_log
    # logger_info_csv = rbind(logger_info_csv, c(substring(file, 1, nchar(file)-4), logger_number, software_version))
    write.csv(logger_info_csv,logger_info_file,row.names = F,col.names = T )
    flag_logger_number = 0
  }else{
    logger_info = logger_info_csv[w_logger,]
    if(logger_number != logger_info[,2]){
      flag_logger_number = 1
    }else{
      flag_logger_number = 0
    }
  }

  if(flag_logger_number == 0){
    if(flag_error_df == 0){
      time_data = data[,which(colnames(data)==datetime_header)]

      if(is.na(start_date)){
        original <- data
        mydata <- data    
        flag_date = 0
        # rm(data)

      }else{

        if(as.POSIXct(start_date, tz = 'Etc/GMT-1') < time_data[length(time_data)]){

          if(as.POSIXct(start_date, tz = 'Etc/GMT-1') < time_data[1]){
            original <- data
            mydata <- data
            first_row <- data.frame(t(rep(NA,times = ncol(data))))
            colnames(first_row) = colnames(data)

            fd = as.POSIXct(seq(from = as.POSIXct(start_date, tz = "Etc/GMT-1"), by = datetime_sampling,length.out = 2)[2],tz = "Etc/GMT-1")
            first_row[,which(colnames(data) == datetime_header)] = as.POSIXct(first_row[,which(colnames(data) == datetime_header)])
            first_row[1,which(colnames(data) == datetime_header)] <- fd
            first_row[which(colnames(data) == record_header)] = -1

            mydata <- rbind(first_row,data)
            flag_date = 0
            # rm(data)

          }else{
            original = data[(which(time_data == as.POSIXct(start_date, tz = 'Etc/GMT-1'))+1):nrow(data),]      # possible issues in data subset!!! to check
            mydata = data[(which(time_data == as.POSIXct(start_date, tz = 'Etc/GMT-1'))+1):nrow(data),]
            flag_date = 0
            # rm(data)
          }

        } else {

          flag_date = 1
        }
      }


      if(flag_date == 0){
        deletes_duplcated <- deletes_duplcated_data(DATA = mydata,DATETIME_HEADER = datetime_header)         # <- Deletes identical rows if found
        mydata = deletes_duplcated [[1]]
        duplicated_data = deletes_duplcated [[2]]
        duplicated_data = time_to_char(DATA = duplicated_data, DATETIME_HEADER = datetime_header, DATETIME_FORMAT = datetime_format)

        rm(deletes_duplcated)

        if(unique(as.character(duplicated_data[1,])) == "---"){
          flag_duplicates_rows = 0
        } else{
          flag_duplicates_rows = 1
        }

        data_in_old_files <- deletes_old_datetime(DATA = mydata,DATETIME_HEADER = datetime_header)
        mydata = data_in_old_files [[1]]
        old_data = data_in_old_files[[2]]

        rm(data_in_old_files)

        orig_wihtout_dupli = mydata

        lastdate_orig = format(orig_wihtout_dupli[nrow(orig_wihtout_dupli), which(colnames(orig_wihtout_dupli) == datetime_header)],datetime_format)

        out_lastdate_orig = paste(substring(lastdate_orig,1,4),
                                  substring(lastdate_orig,6,7),
                                  substring(lastdate_orig,9,10),
                                  substring(lastdate_orig,12,13),
                                  substring(lastdate_orig,15,16),
                                  sep = "")
        orig_filename = paste(station_name,"_", out_lastdate_orig,"_raw.dat", sep = "")
        # orig_filename = paste(substring(file, 1, nchar(file)-4),"_", out_lastdate_orig,"_raw.dat", sep = "")

        if(file.exists(paste(output_dir_data,orig_filename,sep = ""))){
          j=0
          repeat{
            j=j+1
            out_filename_orig_new = paste(substring(orig_filename,1, nchar(orig_filename)-8),"_raw_",j,".dat",sep = "")
            if(!file.exists(paste(output_dir_data,out_filename_orig_new,sep = ""))){
              break
            }
          }
        } else {
          out_filename_orig_new = orig_filename
        }

        write.csv(orig_wihtout_dupli,paste(output_dir_data,out_filename_orig_new,sep = ""),quote = F,row.names = F, na = "NaN")      # <- write "origina data"

        overlap <- detect_overlap(DATA = mydata,DATETIME_HEADER = datetime_header, RECORD_HEADER = record_header)          # <- Detect overlap


        if(length(overlap) != 0){

          flag_overlap = 1
          overlap[,1]<- overlap[,1] + data_from_row - 1
          colnames(overlap)[1]= "File Row"

        }else{

          flag_overlap = 0

          if(record_check == 1){
            rec_miss  <- missing_record(DATA = mydata, DATETIME_HEADER = datetime_header, RECORD_HEADER = record_header, DATETIME_SAMPLING = datetime_sampling, DATETIME_FORMAT = datetime_format)  # <- fill missing dates with NA
            flag_missing_records = rec_miss[[1]]
            records_missing = rec_miss[[2]]
            records_restart = rec_miss[[3]]
          }else{
            flag_missing_records = 50
          }

          if(flag_missing_records != 1){

            missing  <- missing_dates(DATA = mydata, DATETIME_HEADER = datetime_header, RECORD_HEADER = record_header, DATETIME_SAMPLING = datetime_sampling)  # <- fill missing dates with NA
            mydata = missing[[1]]
            missing_index_date = missing[[2]]

            rm(missing)


            range <- exclude_out_of_range(DATA = mydata,DATETIME_HEADER = datetime_header, RANGE_DIR = range_dir, RANGE_FILE = range_file) # <- Substitute with NA data out of phisical range
            mydata = range[[1]]
            check_out_of_range = range[[2]]
            variable_new = range[[3]]
            variable_to_set = range[[4]]

            rm(range)
            # ..... Flags .....................................................................................................................................

            if(length(variable_to_set) != 0){
              flag_range_variable_to_set = 1
            }else{
              flag_range_variable_to_set = 0
            }

            if(length(variable_new) != 0){
              flag_range_variable_new = 1
            }else{
              flag_range_variable_new = 0
            }


            if(1 %in% unique(unlist(apply(X = check_out_of_range[,-which(colnames(check_out_of_range) == datetime_header)],MARGIN = 2, unique)))){
              flag_out_of_range = 1
            }else{
              if(-1 %in% unique(unlist(apply(X = check_out_of_range[,-which(colnames(check_out_of_range) == datetime_header)],MARGIN = 2, unique)))){
                flag_out_of_range = 1
              }else{
                flag_out_of_range = 0
              }
            }


            time_tot = as.POSIXct(mydata[,which(colnames(mydata) == datetime_header)], format = datetime_format, tz = 'Etc/GMT-1')
            time_missing = missing_index_date[,2]

            if(length(which(time_tot %in% time_missing )) == 0){
              flag_missing_dates = 0      # No missing dates
            }else{
              flag_missing_dates = 1      # YES missing dates
            }

            mydata <- time_to_char(DATA = mydata, DATETIME_HEADER = datetime_header, DATETIME_FORMAT = datetime_format)

          }
        }
      }
    }
  }
}


# ..... Output ..........................................................................................................................................

if(flag_empty == 0){
  if(flag_logger_number == 0){
    if(flag_error_df == 0){
      if(flag_date == 0){
        if(flag_overlap == 0){
          if(flag_missing_records != 1){
            if(write_output_files == TRUE){
              #~~~~~~~~~~
              colnames(header) = header[1,]

              out_my = mydata
              colnames(out_my) = colnames(header)

              out_mydata=rbind(header[-1,],out_my)

              out_date = paste(substring(mydata[nrow(mydata),which(colnames(mydata) == datetime_header)],1,4),
                               substring(mydata[nrow(mydata),which(colnames(mydata) == datetime_header)],6,7),
                               substring(mydata[nrow(mydata),which(colnames(mydata) == datetime_header)],9,10),
                               # # "_",
                               # substring(mydata[nrow(mydata),which(colnames(mydata) == datetime_header)],12,13),
                               # substring(mydata[nrow(mydata),which(colnames(mydata) == datetime_header)],15,16),
                               sep = "")


              out_filename_data = paste(station_name,"_",out_date,".csv",sep = "")

              if(file.exists(paste(output_dir_data,out_filename_data,sep = ""))){
                j=0
                repeat{
                  j=j+1
                  out_filename_data_new = paste(substring(out_filename_data,1, nchar(out_filename_data)-4),"_",j,".csv",sep = "")
                  if(!file.exists(paste(output_dir_data,out_filename_data_new,sep = ""))){
                    break
                  }
                }
              } else {
                out_filename_data_new = out_filename_data
              }



              write.csv(out_mydata,paste(output_dir_data,out_filename_data_new,sep = ""),quote = F,row.names = F, na = "NaN")

              rm(out_my)
              rm(out_mydata)

              #~~~~~~~~~~

              # out_filename_dupli = paste("Duplicated_",substring(file,1,nchar(file)-4),"_",out_date,".csv",sep = "")
              # 
              # output_dir_data_DQC_OK = paste(output_dir_data, "DQC_OK/",sep = "")
              # ifelse(test = !dir.exists(output_dir_data_DQC_OK),yes = dir.create(output_dir_data_DQC_OK),no = FALSE)
              # 
              # output_dir_data_duplicated = paste(output_dir_data, "Duplicated/",sep = "")
              # ifelse(test = !dir.exists(output_dir_data_duplicated),yes = dir.create(output_dir_data_duplicated),no = FALSE)

              # out_duplicated = duplicated_data
              # colnames(out_duplicated) = colnames(header)
              # 
              # out_duplicated_data=rbind(header[-1,],out_duplicated)
              # write.csv(out_duplicated_data,paste(output_dir_data_duplicated,out_filename_dupli,sep = ""),quote = F,row.names = F, na = "NaN")
              # rm(out_duplicated)
              # rm(out_duplicated_data)
            }
          }
        }
      }
    }
  }
}


flags_names = c("flag_empty","flag_logger_number","flag_error_df","flag_date","flag_duplicates_rows","flag_overlap","flag_missing_records","flag_missing_dates","flag_range_variable_to_set","flag_range_variable_new","flag_out_of_range")
flags_df = data.frame(flags_names, rep(NA,times = length(flags_names)))
colnames(flags_df) = c("flag_names", "value")

for(i in 1: nrow(flags_df)){
  if(exists(flags_names[i])){
    flags_df$value[i] = eval(parse(text = flags_names[i]))
  }
}

---

INPUT info:

File selected: r file_name

Station selected: r station_name

You have also select these parameters:

• Data start from row: r data_from_row
• The name of column is on row: r header_row_number
• The datetime header is: r datetime_header
• The record header is: r record_header
• The datetime format is: r datetime_format
• The sampling interval is: r datetime_sampling

The folders are:

• Input data folder: r input_dir
• Output data folder: r output_dir_data
• Output report folder: r output_dir_report
• Project folder: r project_dir

Range file in r range_dir is called: r range_file

You decide: r if(write_output_files == TRUE){paste("to write output file here:", output_dir_data)} else{paste(("to don't write output file"))}

And: r if(write_output_report == TRUE){paste("to write output report here:", output_dir_report)} else{paste(("to don't write output report"))}

r if(record_check == 1){paste("Record check enabled! To disable set record_check = 0 in download_table")} else{paste("Record check disabled! To enable set record_check = 1 in download_table")}

---

OUTPUT/ISSUE:

r if(!is.na(flag_empty) & flag_empty != 0){paste("Error!")} r if(!is.na(flag_empty) & flag_empty != 0){paste("Issue: EMPTY FILE")}

r if(!is.na(flag_empty) & flag_empty != 0){paste("Description: ",file_name,"is empty")}

r if(!is.na(flag_logger_number) & flag_logger_number == 1){paste("Error!")} r if(!is.na(flag_logger_number) & flag_logger_number == 1){paste("Issue: LOGGER NUMBER")}

r if(!is.na(flag_logger_number) & flag_logger_number == 1){paste("Logger number in data table (",logger_number,") don't match with Logger number in file: /Process/Logger_number_and_software.csv. (", logger_info[,2] ,") ")}

r if(!is.na(flag_error_df)){if(flag_error_df == 1 | flag_error_df == -1 ){paste("Error!")}} r if(!is.na(flag_error_df)){if(flag_error_df == 1 | flag_error_df == -1 ){paste("Issue: DATA STRUCTURE")}}

r if(!is.na(flag_error_df)){if(flag_error_df == -1){paste("Description: There is more headers than data!")}else{if(flag_error_df == 1){paste("Description: Missing headers, there is more data than headers!! Possible problems: 1. row shifted above. 2. new data with old headers. 3. other file manipulation errors")}}}

r if(!is.na(flag_date) & flag_date == 1){paste("Error!")} r if(!is.na(flag_date) & flag_date == 1){paste("Issue: DATE")}

r if(!is.na(flag_date) & flag_date == 1){paste("Description: File already process!")}

r if(!is.na(flag_duplicates_rows) & flag_duplicates_rows == 1){paste("Warning!")} r if(!is.na(flag_duplicates_rows) & flag_duplicates_rows == 1){paste("Issue: DUPLICATE ROWS:")}

r if(!is.na(flag_duplicates_rows) & flag_duplicates_rows == 1){paste("Description: There are duplicated rows! DataQualityCheck removes automatically duplicate row ")}

r if(!is.na(flag_overlap) & flag_overlap == 1){paste("Error!")} r if(!is.na(flag_overlap) & flag_overlap == 1){paste("Issue: OVERLAP")}

r if(!is.na(flag_overlap) & flag_overlap == 1){paste("Description: There are the following ovelap")}

if(flag_empty == 0){
  if(flag_logger_number == 0){
    if(flag_error_df == 0){
      if(flag_date == 0){
        if(flag_overlap == 1){

          datatable(overlap,rownames = F)

          # kable(overlap, format = "html",align = "c",row.names = F)%>%
          #   kable_styling() %>%
          #   scroll_box( height = "200px")

        }
      }
    }
  }
}

r if(!is.na(flag_missing_records) & flag_missing_records == 1){paste("Error!")} r if(!is.na(flag_missing_records) & flag_missing_records == 1){paste("Issue: MISSING RECORDS")}

r if(!is.na(flag_missing_records) & flag_missing_records == 1){paste("Description: There are the following missing records. Can you recover manually?")}

r if(!is.na(flag_missing_records) & flag_missing_records == 1){if(nrow(records_missing) >= 1){paste("Missing record between 2 date")}}

if(flag_empty == 0){
  if(flag_logger_number == 0){
    if(flag_error_df == 0){
      if(flag_date == 0){
        if(flag_overlap == 0){
          if(flag_missing_records == 1){
            if(nrow(records_missing) >= 1){
            datatable(records_missing)
            }
          }
        }
      }
    }
  }
}

r if(!is.na(flag_missing_records) & flag_missing_records == 1){if(nrow(records_restart) >= 1){paste("Missing record between data and restared software")}}

if(flag_empty == 0){
  if(flag_logger_number == 0){
    if(flag_error_df == 0){
      if(flag_date == 0){
        if(flag_overlap == 0){
          if(flag_missing_records == 1){
            if(nrow(records_restart) >= 1){
            datatable(records_restart)
            }
          }
        }
      }
    }
  }
}

if(flag_empty == 0){
  if(flag_logger_number == 0){
    if(flag_error_df == 0){
      if(flag_date == 0){
        if(flag_overlap == 0){
          if(flag_missing_records != 1){

            time_tot <- as.POSIXct(mydata[,which(colnames(mydata) == datetime_header)], format = datetime_format, tz = 'Etc/GMT-1' )
            time_missing <- missing_index_date[,2]
            # time_missing <-as.character(time_missing)

            df_missing <- data.frame(time_tot,rep("Dates in original file",times = length(time_tot)))
            colnames(df_missing) = c("time","Status")
            df_missing[which(time_tot %in% time_missing ),2] = "Missing dates filled"
            y = rep(1, times = length(time_tot))

            Status_num = rep(1,times = length(time_tot))
            Status_num[which(time_tot %in% time_missing )] = 0

            df_missing = cbind(df_missing, y,Status_num)

            rm(time_tot)
            rm(time_missing)
            rm(y)
            rm(Status_num)


          }
        }
      }
    }
  }
}

r if(!is.na(flag_missing_dates) & flag_missing_dates == 1){paste("Warning!")} r if(!is.na(flag_missing_dates) & flag_missing_dates == 1){paste("Issue: MISSING DATES")}

r if(!is.na(flag_missing_dates) & flag_missing_dates == 1 ){paste("Description: There are the following missing dates")}

if(flag_empty == 0){
  if(flag_logger_number == 0){ 
    if(flag_error_df == 0){
      if(flag_date == 0){
        if(flag_overlap == 0){
          if(flag_missing_records != 1){
            if(flag_missing_dates == 1){
              theme_new = theme_bw()+theme(axis.title.y=element_blank(),
                                           axis.text.y=element_blank(),
                                           axis.ticks.y=element_blank(),
                                           axis.text.x = element_text(angle = 90, hjust = 1))

              tot_missing =length(which(df_missing$Status_num == 0))

              ggplot(df_missing,aes(x = time, y=y ,colour = Status)) +
                geom_point(aes(size = Status,shape = Status) )+
                scale_colour_manual(values = c("#7CAE00","#F8766D"))+
                scale_shape_manual(values = c(20,124))+
                # scale_x_datetime(name = datetime_header,date_breaks = "2 weeks" )+
                theme_new+
                # ggtitle("Time distribution of missing dates")+
                labs(title="Time distribution of missing dates",
                     subtitle=paste("Total missing dates: ", tot_missing,sep = ""))
            }
          }
        }
      }
    }
  }
}

r if(!is.na(flag_missing_dates)){if(flag_missing_dates == 1){paste("Statistics of missing dates:")}}

if(flag_empty == 0){
  if(flag_logger_number == 0){ 
    if(flag_error_df == 0){
      if(flag_date == 0){
        if(flag_overlap == 0){
          if(flag_missing_records != 1){
            if(flag_missing_dates == 1){
              Status_num_NA=df_missing
              Status_num_NA = Status_num_NA[,-c(2,3)]

              differ = c(0,diff(Status_num_NA$Status_num))
              start = which(differ == -1)
              end  = which(differ == 1) - 1
              gap_lenght = end - start + 1

              date_start = Status_num_NA$time[start]
              date_end = Status_num_NA$time[end]

              if(length(date_end) != 0){
                date_end_tmp = as.POSIXct("1990-01-01 00:00")    # this for cycle is to fix a bug on time difference
                for(k in 1:length(date_end)){

                  date_end_tmp[k] =  seq.POSIXt(date_end[k], by = datetime_sampling, length. =  2)[2]
                }
                gap_hour = difftime(time1 = date_end_tmp,time2 = date_start,units = "hours")
              }else{
                gap_hour = numeric(0)
              }


              statistic_missing = data.frame(date_start,date_end,gap_lenght,gap_hour)
              colnames(statistic_missing) = c("From", "To", "Number of Record", "Hours")
              statistic_missing[,1:2] = format(statistic_missing[,1:2], format = datetime_format)

              datatable(statistic_missing,rownames = F)

            }
          }
        }
      }
    }
  }
}

r if(!is.na(flag_range_variable_to_set) | !is.na(flag_range_variable_new) ){ if(flag_range_variable_to_set == 1 | flag_range_variable_new == 1){paste("Warning!")}} r if(!is.na(flag_range_variable_to_set) | !is.na(flag_range_variable_new) ){ if(flag_range_variable_to_set == 1 | flag_range_variable_new == 1){paste("Issue: RANGE FILE TO UPDATE")}}

r if(!is.na(flag_range_variable_to_set) | !is.na(flag_range_variable_new) ){ if(flag_range_variable_to_set == 1 | flag_range_variable_new == 1){paste("Description: Update the range of the following variables:")}}

if(flag_empty == 0){
  if(flag_logger_number == 0){ 
    if(flag_error_df == 0){
      if(flag_date == 0){
        if(flag_overlap == 0){
          if(flag_missing_records != 1){


            if(flag_range_variable_new != 0){

              if(flag_range_variable_new == 1){
                df_variable_new = data.frame(variable_new, rep("New variable. Set threshold in range file",times = length(variable_new)))
                colnames(df_variable_new) = c("Variable", "Warning")

              }else{
                df_variable_new = data.frame("---", rep("Any new variables added in range file",times = 1))
                colnames(df_variable_new) = c("Variable", "Warning")
              }

              # if(flag_range_variable_to_set == 1){
              #   df_variable_to_set = data.frame(variable_to_set, rep("Remember: update threshold in range file and disables flag *to_set* ", times = length(variable_to_set)))
              #   colnames(df_variable_to_set) = c("Variable", "Warning")
              #
              #
              # }else{
              #   df_variable_to_set = data.frame("---", rep("All variables in range file are up to date",times = 1))
              #   colnames(df_variable_to_set) = c("Variable", "Warning")
              #   # print("Any variables to set in range file.")
              # }

              # df_to_print = rbind(df_variable_new,df_variable_to_set)
              df_to_print = df_variable_new

              # if(flag_range_variable_to_set == 1 | flag_range_variable_new == 1){
              #   datatable(df_to_print,rownames = F)
              # }

              datatable(df_to_print,rownames = F)

            }
          }
        }
      }
    }
  }
}

r if(!is.na(flag_out_of_range) & flag_out_of_range == 1){paste("Warning!")} r if(!is.na(flag_out_of_range) & flag_out_of_range == 1){paste("Issue: VALUE OUT OF RANGE")}

r if(!is.na(flag_out_of_range) & flag_out_of_range == 1){paste("Description: The following variables contain values out of phisical range.")}

if(flag_empty == 0){
  if(flag_logger_number == 0){ 
    if(flag_error_df == 0){
      if(flag_date == 0){
        if(flag_overlap == 0){
          if(flag_missing_records != 1){


            for(j in 1:ncol(check_out_of_range)){
              gc(reset = T)
              if(colnames(check_out_of_range)[j] !=  datetime_header){

                # ~~~~~~ preparation data for ggplot ~~~~~~

                df_tmp = check_out_of_range[,c(which(colnames(check_out_of_range)==datetime_header), j)]
                df_data = mydata[,c(which(colnames(check_out_of_range)==datetime_header), j)]

                df_tmp_new = cbind(df_tmp, df_data[,2])
                df_tmp_new[is.na(df_data[,2]),3] = 1
                df_tmp_new[!is.na(df_data[,2]),3] = 0
                df_tmp_new[which(df_tmp[,2] != 0),3] = 0
                colnames(df_tmp_new)[3] = "na_flag"

                df_factor = df_tmp

                df_factor[,2]=as.character(df_factor[,2])

                y = rep(1,times = nrow(df_factor))
                df_factor = cbind(df_factor,y)
                colnames(df_factor) = c("time", "Variable", "y")
                df_factor$y[which(df_factor$Variable == -1)] = 0.9
                df_factor$y[which(df_factor$Variable == 1)] = 1.1
                # colnames(df_factor) =c("time","Variable","y")

                # ~~~~~~ preparation data for statistic table ~~~~~~

                c_oor = colnames(check_out_of_range)[j]

                df_oor0 = df_tmp_new[,c(1,3)]
                colnames(df_oor0)= c("time", "variable")

                nan = rep(0, times = nrow(df_oor0))

                how_many_nan = length(which(df_oor0$variable == 1))

                if(length(which(df_oor0$variable == 1)) != 0){
                  nan[which(df_oor0$variable == 1)] = 1
                }

                df_oor = df_tmp
                colnames(df_oor)= c("time", "variable")

                over_range = rep(0, times = nrow(df_oor))

                how_many_over_range = length(which(df_oor$variable == 1))

                if(length(which(df_oor$variable == 1)) != 0){
                  over_range[which(df_oor$variable == 1)] = 1
                }

                under_range = rep(0, times = nrow(df_oor))

                how_many_under_range = length(which(df_oor$variable == -1))
                if(length(which(df_oor$variable == -1)) != 0){
                  under_range[which(df_oor$variable == -1)] = 1
                }

                df_oor2 = data.frame(df_oor$time, under_range, over_range, nan)

                df_oor3 = rbind(df_oor2[1,],df_oor2,df_oor2[nrow(df_oor2),])


                df_oor3[1,2] = 0 ; df_oor3[1,3] = 0; df_oor3[1,4] = 0
                df_oor3[nrow(df_oor3),2] = 0 ; df_oor3[nrow(df_oor3),3] = 0; df_oor3[nrow(df_oor3),4] = 0

                a=as.data.frame(rbind(c(0,0),apply(df_oor3[,-1],2, diff)))
                time_a =c(df_oor$time[1],df_oor$time,df_oor$time[nrow(df_oor)])
                diff_df = cbind(time_a,a)

                if(any(unique(df_oor[,2])!= 0)){

                  # ~~~~~~ preparation data for ggplot ~~~~~~

                  theme_new2 = theme_bw()+theme(axis.title.y=element_blank(),
                                                axis.text.y=element_blank(),
                                                axis.ticks.y=element_blank(),
                                                axis.text.x = element_text(angle = 90, hjust = 1),
                                                legend.title = element_blank())


                  # set_limits = data.frame(as.POSIXct(c(df_factor$time[1], df_factor$time[nrow(df_factor)%/%2], df_factor$time[nrow(df_factor)])), c(-1,0,1), c(0,0,0))

                  set_limits = data.frame(rep(as.POSIXct("1900-01-01 00:00",format = "%Y-%m-%d %H:%M", tz = "Etc/GMT-1"),times = 4),
                                          c(-1,0,2,1), c(0.9,1,1,1.1))
                  colnames(set_limits) = colnames(df_factor)

                  df_tmp_new[,2] = rep(2, times = nrow(df_tmp_new))
                  colnames(df_tmp_new) = colnames(df_factor)
                  df_na = df_tmp_new[which(df_tmp_new[,3] == 1),]

                  df_factor = rbind(set_limits,df_factor)
                  df_factor = rbind(df_factor, df_na)
                  df_factor = df_factor[order(df_factor$time),]

                  df_factor$Variable =as.numeric(df_factor$Variable)

                  df_factor$Variable = factor(df_factor$Variable, ordered = TRUE)
                  df_factor$Variable <- factor( df_factor$Variable, levels=rev(levels( df_factor$Variable)))





                  p1 = ggplot(df_factor,aes(x = time, y = y,colour = Variable))+
                    geom_point(aes(size = Variable,shape = Variable ))+
                    scale_colour_manual(values = c("#777777","#F8766D","#7CAE00","#0000FF"),labels = c("NaN", "Above upper limit", "In the range","Below lower limit"))+
                    scale_shape_manual(values = c(124,124,20,124),labels =c("NaN","Above upper limit", "In the range","Below lower limit"))+
                    scale_size_manual(values = c(7,10,1,10),labels = c("NaN","Above upper limit", "In the range","Below lower limit"))+
                    theme_new2 +
                    scale_y_continuous(limits = c(0.7,1.3))+
                    scale_x_datetime(limits = as.POSIXct(c(df_factor$time[5], df_factor$time[nrow(df_factor)]),tz = "Etc/GMT-1") )+
                    labs(title=paste(colnames(check_out_of_range)[j]),
                         subtitle=paste("Total NaN: ", how_many_nan, "\n",
                                        "Total Above upper limit: ", how_many_over_range, "\n",
                                        "Total Below lower limit: ", how_many_under_range, sep = ""))

                  print(p1)

                  # ~~~~~~ preparation data for statistic table ~~~~~~

                  # NaN
                  nan_start_oor = which(diff_df$nan == 1) - 1
                  nan_end_oor  = which(diff_df$nan == -1) - 2


                  if(length(nan_start_oor) != 0 & length(nan_end_oor) != 0){
                    if(nan_end_oor[1] < nan_start_oor[1]){
                      nan_start_oor = c(1,nan_start_oor)
                    }
                    if(nan_start_oor[length(nan_start_oor)] > nan_end_oor[length(nan_end_oor)] ){
                      nan_end_oor = c(nan_end_oor,nrow(diff_df))
                    }
                  }

                  nan_gap_lenght_oor = nan_end_oor - nan_start_oor + 1
                  nan_date_start_oor = df_oor[nan_start_oor,1]
                  nan_date_end_oor = df_oor[nan_end_oor,1]

                  if(length(nan_date_end_oor) != 0){
                    nan_date_end_oor_tmp = as.POSIXct("1990-01-01 00:00")    # this for cycle is to fix a bug on time difference
                    for(k in 1:length(nan_date_end_oor)){

                      nan_date_end_oor_tmp[k] =  seq.POSIXt(nan_date_end_oor[k], by = datetime_sampling, length. =  2)[2]
                    }

                    nan_gap_hour_oor = difftime(time1 = nan_date_end_oor_tmp,time2 = nan_date_start_oor,units = "hours")
                  }else{
                    nan_gap_hour_oor = numeric(0)
                  }

                  nan_statistic_oor = data.frame(rep("NaN", times = length(nan_date_start_oor)),
                                                 nan_date_start_oor,
                                                 nan_date_end_oor,
                                                 nan_gap_lenght_oor,
                                                 nan_gap_hour_oor)
                  colnames(nan_statistic_oor) = c(" ","From", "To", "Number of Record", "Hours")

                  # under

                  under_start_oor = which(diff_df$under_range == 1) - 1
                  under_end_oor  = which(diff_df$under_range == -1) - 2


                  if(length(under_start_oor) != 0 & length(under_end_oor) != 0){
                    if(under_end_oor[1] < under_start_oor[1]){
                      under_start_oor = c(1,under_start_oor)
                    }
                    if(under_start_oor[length(under_start_oor)] > under_end_oor[length(under_end_oor)] ){
                      under_end_oor = c(under_end_oor,nrow(diff_df))
                    }
                  }

                  under_gap_lenght_oor = under_end_oor - under_start_oor + 1
                  under_date_start_oor = df_oor[under_start_oor,1]
                  under_date_end_oor = df_oor[under_end_oor,1]

                  if(length(under_date_end_oor) != 0){
                    under_date_end_oor_tmp = as.POSIXct("1990-01-01 00:00")    # this for cycle is to fix a bug on time difference
                    for(k in 1:length(under_date_end_oor)){

                      under_date_end_oor_tmp[k] =  seq.POSIXt(under_date_end_oor[k], by = datetime_sampling, length. =  2)[2]
                    }

                    under_gap_hour_oor = difftime(time1 = under_date_end_oor_tmp,time2 = under_date_start_oor,units = "hours")
                  }else{
                    under_gap_hour_oor = numeric(0)
                  }

                  under_statistic_oor = data.frame(rep("Under lower limit", times = length(under_date_start_oor)),
                                                   under_date_start_oor,
                                                   under_date_end_oor,
                                                   under_gap_lenght_oor,
                                                   under_gap_hour_oor)
                  colnames(under_statistic_oor) = c(" ","From", "To", "Number of Record", "Hours")

                  # over

                  over_start_oor = which(diff_df$over_range == 1) - 1
                  over_end_oor  = which(diff_df$over_range == -1) - 2


                  if(length(over_start_oor) != 0 & length(over_end_oor) != 0){
                    if(over_end_oor[1] < over_start_oor[1]){
                      over_start_oor = c(1,over_start_oor)
                    }
                    if(over_start_oor[length(over_start_oor)] > over_end_oor[length(over_end_oor)] ){
                      over_end_oor = c(over_end_oor,nrow(diff_df))
                    }
                  }

                  over_gap_lenght_oor = over_end_oor - over_start_oor + 1
                  over_date_start_oor = df_oor[over_start_oor,1]
                  over_date_end_oor = df_oor[over_end_oor,1]

                  if(length(over_date_end_oor) != 0){
                    over_date_end_oor_tmp = as.POSIXct("1990-01-01 00:00")    # this for cycle is to fix a bug on time difference
                    for(k in 1:length(over_date_end_oor)){

                      over_date_end_oor_tmp[k] =  seq.POSIXt(over_date_end_oor[k], by = datetime_sampling, length. =  2)[2]
                    }
                    over_gap_hour_oor = difftime(time1 = over_date_end_oor_tmp,time2 = over_date_start_oor,units = "hours")
                  }else{
                    over_gap_hour_oor =  numeric(0)
                  }

                  over_statistic_oor = data.frame(rep("Above upper limit", times = length(over_date_start_oor)), over_date_start_oor,over_date_end_oor,over_gap_lenght_oor, over_gap_hour_oor)
                  colnames(over_statistic_oor) = c(" ","From", "To", "Number of Record", "Hours")


                  if(nrow(under_statistic_oor) == 0){
                    statistic_oor_under_over = over_statistic_oor
                  }else{
                    if(nrow(over_statistic_oor) == 0){
                      statistic_oor_under_over = under_statistic_oor
                    }else{
                      statistic_oor_under_over= rbind(under_statistic_oor,over_statistic_oor)
                    }
                  }

                  if(nrow(nan_statistic_oor) == 0){
                    statistic_oor = statistic_oor_under_over
                  }else{
                    if(nrow(under_statistic_oor) == 0 & nrow(over_statistic_oor) == 0){
                      statistic_oor = nan_statistic_oor
                    }else{
                      statistic_oor = rbind(nan_statistic_oor,statistic_oor_under_over)
                    }
                  }


                  statistic_oor = statistic_oor[order(statistic_oor$From),]
                  statistic_oor[,2:3] = format(statistic_oor[,2:3], format = datetime_format)

                  # print(htmltools::tagList(datatable(statistic_oor)))
                  print(xtable(statistic_oor),type = "html")

                  # if(nrow(statistic_oor) == 1){
                  #   print(kable(statistic_oor, format = "html",align = "c",row.names = F)%>%
                  #           kable_styling() %>%
                  #           scroll_box( height = "120px") )
                  # }else{
                  #   if(nrow(statistic_oor) == 2){
                  #     print(kable(statistic_oor, format = "html",align = "c",row.names = F)%>%
                  #             kable_styling() %>%
                  #             scroll_box( height = "150px") )
                  #   }else{
                  #     if(nrow(statistic_oor) == 3){
                  #       print(kable(statistic_oor, format = "html",align = "c",row.names = F)%>%
                  #               kable_styling() %>%
                  #               scroll_box( height = "200px") )
                  #     }else{
                  #       if(nrow(statistic_oor) >  3){
                  #         print(kable(statistic_oor, format = "html",align = "c",row.names = F)%>%
                  #                 kable_styling() %>%
                  #                 scroll_box( height = "220px") )
                  #       }
                  #     }
                  #   }
                  # }



                }
                rm(df_tmp)
                rm(df_factor)
                rm(y)
                rm(c_oor)
                rm(df_oor)
                rm(over_range)
                rm(how_many_over_range)
                rm(under_range)
                rm(how_many_under_range)
                rm(df_oor2)
                rm(df_oor3)
                rm(a)
                rm(time_a)
                rm(diff_df)
              }
            }

          }
        }
      }
    }
  }
}

r if(all(flags_df$value == 0)){paste("No errors/warnings detected! Data doesn't contain any problems.")}

*End Report - r Sys.time() *

bridachristian/DataQualityCheckEuracAlpEnv documentation built on Oct. 27, 2019, 5:55 p.m.