R/r2easyR.stem_editor.R

Defines functions r2easyR.stem_editor

Documented in r2easyR.stem_editor

#'A function that optimizes the stem layout for a RNA 2-structure drawn with R2R
#'
#'This function edits a R2R Stockholm file to provide a better stem layout for most RNA. By default, R2R will place
#'adjacent stems on the same side of the line of the RNA backbone. This will cause the stems to clash in the figure
#'if the stems are to close together in the 1-sequence. The r2easyR.stem_editor prevents this by flipping every other
#'stem to the opposite side of the backbone using the R2R label line and the R2R place_explicit command. The r2easyR.stem_editor
#'currently supports optimizing the layout of up a structure with up to 26 stems.
#'
#'@param R2R.sto Path to the R2R Stockholm file that contains the drawing information you want to optimize
#'@param source Where you got the Stockholm. Did you make it with "R2easyR" or did you make it with "R2R"? Used to parse the secondary structure line.
#' @export
r2easyR.stem_editor = function(R2R.sto,
                               source = "R2easyR"){

  con <- file(R2R.sto)
  lines <- readLines(con)

  if (source == "R2easyR"){
    SS_cons <- strsplit(strsplit(lines[3], split = "\t")[[1]][2], split = "")[[1]]
  }
  if (source == "R2R"){
    SS_cons_line <- lines[which(grepl("#=GC SS_cons", lines))]
    SS_cons_line = gsub("#=GC SS_cons", "", SS_cons_line)
    SS_cons_line = gsub(" ", "", SS_cons_line)
    SS_cons = strsplit(SS_cons_line, split = "")[[1]]
    SS_cons[which(SS_cons == "(")] = "<"
    SS_cons[which(SS_cons == ")")] = ">"
  }

  open_pairs <- 0
  stems <- 0
  R2R_LABEL <- 0
  ends_in_a_helix <- FALSE
  next.N.start.stem <- FALSE
  zoro_n_juction <- c()

  open_labels <- c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
  close_labels <- c("N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")

  length(SS_cons)

  for (i in 1:length(SS_cons)){
    if(next.N.start.stem) {
      open_pairs = open_pairs + 1
      stems = stems + 1
      R2R_LABEL[i] = open_labels[(stems - 1)]
      next.N.start.stem <- FALSE
    } else {
      if (stems > 1){
        if (open_pairs != 0){
          if (SS_cons[i] == "<"){
            open_pairs = open_pairs + 1
            R2R_LABEL[i] = "."
          }
          if (SS_cons[i] == ">"){
            open_pairs = open_pairs - 1
            R2R_LABEL[i] = "."
            if (open_pairs == 0){
              if (stems %% 2 == 0){
                if (i != length(SS_cons)){
                  R2R_LABEL[i] = close_labels[(stems - 1)]
                }
                if (i != length(SS_cons)){
                  if (SS_cons[(i+1)] == "<"){
                    next.N.start.stem <- TRUE
                    zoro_n_juction[stems] <- TRUE
                  }else{
                    zoro_n_juction[stems] <- FALSE
                  }
                }
                if (i == length(SS_cons)){
                  ends_in_a_helix <- TRUE
                  next.N.start.stem <- FALSE
                }
              }else{
                if (i != length(SS_cons)){
                  if (SS_cons[(i+1)] == "<"){
                    next.N.start.stem <- TRUE
                    zoro_n_juction[stems] <- TRUE
                  }else{
                    zoro_n_juction[stems] <- FALSE
                  }
                }
                if (i == length(SS_cons)){
                  ends_in_a_helix <- TRUE
                  next.N.start.stem <- FALSE
                }
              }
            }
          }
          if (SS_cons[i] == "."){
            R2R_LABEL[i] = "."
          }
        }
        if (open_pairs == 0){
          if (SS_cons[i] == "<"){
            stems = stems + 1
            open_pairs = open_pairs + 1
            if (stems %% 2 == 0){
              R2R_LABEL[i] = open_labels[(stems - 1)]
            }else{
              R2R_LABEL[i] = "."
            }
          }
          if (SS_cons[i] == "."){
            R2R_LABEL[i] = "."
          }
        }
      }
      if (stems == 1){
        if (open_pairs != 0){
          if (SS_cons[i] == "<"){
            open_pairs = open_pairs + 1
            R2R_LABEL[i] = "."
          }
          if (SS_cons[i] == ">"){
            open_pairs = open_pairs - 1
            R2R_LABEL[i] = "."
            if (open_pairs == 0){
              if (i != length(SS_cons)){
                if (SS_cons[(i+1)] == "<"){
                  next.N.start.stem <- TRUE
                  zoro_n_juction[stems] <- TRUE
                }else{
                  zoro_n_juction[stems] <- FALSE
                }
              }
            }
          }
          if (SS_cons[i] == "."){
            R2R_LABEL[i] = "."
          }
        }
        if (open_pairs == 0){
          if (SS_cons[i] == "<"){
            stems = stems + 1
            open_pairs = open_pairs + 1
            R2R_LABEL[i] = open_labels[(stems - 1)]
          }
          if (SS_cons[i] == "."){
            R2R_LABEL[i] = "."
          }
        }
      }
      if (stems == 0){
        if (open_pairs == 0){
          if (SS_cons[i] == "<"){
            stems = stems + 1
            open_pairs = open_pairs + 1
            R2R_LABEL[i] = "."
          }
          if (SS_cons[i] != "<"){
            R2R_LABEL[i] = "."
          }
        }
      }
    }

    print(paste("i =", i))
    print(paste("open pairs", open_pairs))
    print(paste("stems", stems))
    print(next.N.start.stem)
    print(R2R_LABEL)

  }

  lines[4] <- paste("#=GC R2R_LABEL", gsub(", ", "", toString(R2R_LABEL)), sep = "\t")

  if (SS_cons[length(SS_cons)] == ">"){ends_in_a_helix == TRUE}else{ends_in_a_helix == FALSE}

  if (length(zoro_n_juction) <= 1){zoro_n_juction <- c(zoro_n_juction, c(FALSE, FALSE, FALSE, FALSE))}

  if (length(SS_cons) != length(SS_cons[which(SS_cons == ".")])){
    if (ends_in_a_helix == FALSE){
      for ( i in 1:stems){
        if (i %% 2 == 0){
          if (zoro_n_juction[i-1]){
            lines <- c(lines[1:(length(lines)-1)],
                       paste("#=GF R2R place_explicit ", open_labels[(i - 1)], " ", open_labels[(i - 1)], "-- -45 1 0 0 0 0 f", sep = ""),
                       paste("#=GF R2R place_explicit ", close_labels[(i - 1)], "++ ", close_labels[(i - 1)], " 45 1 0 0 0 90 f", sep = ""),
                       "//")
          }else{
            lines <- c(lines[1:(length(lines)-1)],
                       paste("#=GF R2R place_explicit ", open_labels[(i - 1)], " ", open_labels[(i - 1)], "-- 45 1 0 0 0 90 f", sep = ""),
                       paste("#=GF R2R place_explicit ", close_labels[(i - 1)], "++ ", close_labels[(i - 1)], " 45 1 0 0 0 90 f", sep = ""),
                       "//")
          }
        }
      }
    }
    if (ends_in_a_helix == TRUE){
      for (i in 1:(stems - 1)){
        if (i %% 2 == 0){
          if (zoro_n_juction[i-1]){
            lines <- c(lines[1:(length(lines)-1)],
                       paste("#=GF R2R place_explicit ", open_labels[(i - 1)], " ", open_labels[(i - 1)], "-- -45 1 0 0 0 0 f", sep = ""),
                       paste("#=GF R2R place_explicit ", close_labels[(i - 1)], "++ ", close_labels[(i - 1)], " 45 1 0 0 0 90 f", sep = ""),
                       "//")
          }else{
            lines <- c(lines[1:(length(lines)-1)],
                       paste("#=GF R2R place_explicit ", open_labels[(i - 1)], " ", open_labels[(i - 1)], "-- 45 1 0 0 0 90 f", sep = ""),
                       paste("#=GF R2R place_explicit ", close_labels[(i - 1)], "++ ", close_labels[(i - 1)], " 45 1 0 0 0 90 f", sep = ""),
                       "//")
          }
        }
      }
      if (zoro_n_juction[(stems-1)]){
        lines <- c(lines[1:(length(lines)-1)],
                   paste("#=GF R2R place_explicit ", open_labels[(stems - 1)], " ", open_labels[(stems - 1)], "-- -45 1 0 0 0 0 f", sep = ""),
                   "//")
      }else{

        if (grepl(open_labels[(stems - 1)], gsub(", ", "", toString(R2R_LABEL)))){
          lines <- c(lines[1:(length(lines)-1)],
                     paste("#=GF R2R place_explicit ", open_labels[(stems - 1)], " ", open_labels[(stems - 1)], "-- 45 1 0 0 0 90 f", sep = ""),
                     "//")
        }

      }
    }
  }

  print(lines)

  writeLines(lines, con)
  close(con)
}
JPSieg/R2easyR documentation built on March 2, 2024, 8:42 a.m.