R/getVector1.R

Defines functions getVector1

Documented in getVector1

#' Finds and returns one vector
#'
#' @return vector
#' @export
#'
#'
getVector1 <- function() {


  again <- TRUE

  while(again) {

    again <- FALSE

    found <- FALSE

    object <- objects(pos = .GlobalEnv)[unlist(lapply(objects(pos = .GlobalEnv), FUN = function(x) {!is.function(eval(parse(text = x)))}))]

    while(!found) {

      #Initial list of objects
      if(length(object) > 1) {
        x <- 0
        while(!x %in% 1:length(object)) {
          print(object)
          x <- as.numeric(readline("Choose an object by number: "))
        }
        object <- object[x]
      }

      #Investigating object
      else if(length(object) == 1) {

        #If list
        if(class(eval(parse(text = object)))[1] == "list") {

          if(length(eval(parse(text = object))) > 0) {

            message("List entries: ")
            print(names(eval(parse(text = object))))

            x <- 0
            while(!x %in% 1:length(eval(parse(text = object)))) {
              x <- as.numeric(readline("Choose list entry by number: "))
            }

            object <- paste(object, "[[", x, "]]", sep = "")

          }

          else {
            message("There's nothing here. Try again!")
            found <- TRUE
            again <- TRUE
            message("")
          }


        }

        #If vector
        else if(is.vector(eval(parse(text = object)))) {


          message("Vector found: ")
          print(eval(parse(text = object)))

          if(ok("Vector ok?")) {

            return <- eval(parse(text = object))


            found <- TRUE
          }

          else {
            found <- TRUE
            again <- TRUE
            message("")
            message("Next try!")
          }



        }


        #Unknown
        else {
          message("Unknown object. Try again!")
          found <- TRUE
          again <- TRUE
          message("")
        }


      }

      #Wtf
      else {
        message("I don't know how you got here. Try again!")
        found <- TRUE
        again <- TRUE
        message("")
      }

    }



  }


  if(sum(is.na(return))) {
    if(ok("Remove NAs?")) {
      return <- return[!is.na(return)]
    }
  }


  return

}
nicohuttmann/htmnanalysis documentation built on Dec. 6, 2020, 3:02 a.m.