R/motifs_search_plot.R

Defines functions motifs_search_plot

Documented in motifs_search_plot

#' @title Plot Motif Search Results
#'
#' @description
#' The `motifs_search_plot` function visualizes the results obtained from the `motifs_search` function.
#' It generates plots for detected motifs across multiple dimensions, displaying both the motifs and their
#' corresponding derivative curves (if available). Users can filter motifs based on frequency thresholds
#' and choose to display either all motifs or the top `n` motifs. Additionally, the function provides an
#' option to plot all underlying curves with colored motifs highlighted.
#'
#' @param motifs_search_results A list containing the output from the `motifs_search` function. This
#'   includes elements such as `V0`, `V1`, `V_frequencies`, `Y0`, `Y1`, `V_length`, `V_occurrences`,
#'   `V_mean_diss`, and `R_motifs`, which store information about the detected motifs and their properties.
#'
#' @param ylab A character string specifying the label for the y-axis in the plots. This label will be
#'   appended with the dimension number to create individual titles for each plot. Default is an empty
#'   string (`''`).
#'
#' @param freq_threshold An integer indicating the minimum frequency a motif must have to be included
#'   in the plots. Only motifs with a frequency equal to or greater than `freq_threshold` will be
#'   visualized. Default value is `5`.
#'
#' @param top_n Determines how many motifs to plot based on their frequency. If set to `'all'`, all
#'   motifs meeting the `freq_threshold` will be plotted. If an integer is provided, only the top
#'   `top_n` motifs with the highest frequencies will be displayed. Default is `'all'`.
#'
#' @param plot_curves A logical value indicating whether to plot all underlying curves with colored
#'   motifs highlighted. If `TRUE`, the function overlays motifs on the curves for better visualization.
#'   Default is `TRUE`.
#'
#'
#' @return
#' The function does not return a value but generates plots visualizing the motifs and their occurrences
#' across different dimensions. It creates separate plots for each dimension and includes legends for
#' easy identification of motifs.
#'
#' @details
#' The `motifs_search_plot` function performs the following steps:
#' \enumerate{
#'   \item Validates input parameters, ensuring that the frequency threshold and `top_n` are appropriate.
#'   \item Selects motifs that meet the frequency threshold and, if specified, limits the number of motifs
#'     to the top `n`.
#'   \item For each dimension, it plots the motif centers (`V0`) and their derivatives (`V1`, if available).
#'   \item If `plot_curves` is `TRUE`, it overlays the motifs on the original curves, highlighting them with
#'     distinct colors.
#' }
#'
#' @importFrom dplyr %>%
#' @importFrom data.table as.data.table setnames
#' @export
#' 
#' 
#' 
motifs_search_plot <- function(motifs_search_results,
                               ylab = ylab,
                               freq_threshold = 5,
                               top_n = 'all',
                               plot_curves = TRUE) {
  # Plot the results of motifs_search.
  #   motifs_search_results: output of motifs_search function.
  #   freq_threshold: plot only motifs with frequency at least equal to freq_threshold.
  #   top_n: if 'all', plot all motifs found. If top_n is an integer, then all top top_n motifs are plotted.
  #   plot_curves: if TRUE, plot all the curves with coloured motifs.
  
  
  or_data <- motifs_search_results$Y0 # original data
  der_data <- motifs_search_results$Y1 # original data
  d       <- ncol(or_data[[1]]) # dimensional
  N       <- length(motifs_search_results$Y0) # Number of curves
  index_plot <- which(motifs_search_results$V_frequencies >= freq_threshold)
  if (top_n != 'all') {
    if (length(index_plot) > top_n)
      index_plot = index_plot[seq_len(top_n)]
  }
  
  K  = length(index_plot)
  V0 = motifs_search_results$V0[index_plot] # interesting motifs
  V1 = motifs_search_results$V1[index_plot] # interesting motifs DER
  V_dom = lapply(V0, function(v)
    rowSums(!is.na(v)) != 0)
  V_length = motifs_search_results$V_length[index_plot] # motif length
  V_occurrences = motifs_search_results$V_occurrences[index_plot] # motif occurrences
  V_frequencies = motifs_search_results$V_frequencies[index_plot] # number of motif occurrences
  V_mean_diss = motifs_search_results$V_mean_diss[index_plot] # motif diss
  R_motifs = motifs_search_results$R_motifs[index_plot] # motif radius
  n_motifs <- V0 %>% length()
  
  # all occurrences as data frame
  temp <- lapply(seq_along(V_occurrences), function(x) {
    df <- V_occurrences[[x]]
    cbind(df, motif = x)
  })
  
  all_occurrences <- do.call(rbind.data.frame, temp)
  
  # The plot is composed by
  # - overview (motif centers); (DONE)
  # - overview (derivative); (DONE)
  # - single motif (all curvers) + single motif insight V0 and V1; (DONE)
  # - curve perspective; (TO ADD)
  
  # Palette fissa per tutti i motif
  motif_colors <- rainbow(K)
  
  # OVERVIEW PLOTS ------
  layout(matrix(c(seq_len(d), rep(d + 1, d)), ncol = 2), widths = c(7, 1))
  
  # Motif centers
  lapply(seq_len(d), function(j) {
    par(mar = c(3, 4, 4, 2) + 0.1)
    plot(
      V0[[1]][, j],
      type = 'l',
      col = motif_colors,
      lwd = 5,
      lty = 1,
      main = paste0("Motif centers - Dimension: ", j),
      xlim = c(1, max(V_length)),
      ylab = ylab,
      ylim = c(min(unlist(V0)), max(unlist(V0)))
    )
    mapply(
      function(v, k)
        points(
          v[, j],
          type = 'l',
          col = motif_colors[k + 1],
          lwd = 5,
          lty = 1
        ),
      V0[-1],
      seq_len(K - 1)
    )
    par(mar = c(0, 0, 0, 0))
    return(NULL)
  })
  plot.new()
  legend(
    'left',
    paste('motif', seq_len(K)),
    col = motif_colors,
    lwd = 7,
    lty = 1,
    bty = "n",
    xpd = TRUE
  )
  
  # Motif centers - derivative
  if (!is.null(V1[[1]])) {
    layout(matrix(c(seq_len(d), rep(d + 1, d)), ncol = 2), widths = c(7, 1))
    lapply(seq_len(d), function(j) {
      par(mar = c(3, 4, 4, 2) + 0.1)
      plot(
        V1[[1]][, j],
        type = 'l',
        col = motif_colors,
        lwd = 5,
        lty = 1,
        main = paste("Motif centers - Dimension: ", j, ' - derivative'),
        xlim = c(1, max(V_length)),
        ylab = ylab,
        ylim = c(min(unlist(V1)), max(unlist(V1)))
      )
      mapply(
        function(v, k)
          points(
            v[, j],
            type = 'l',
            col = motif_colors[k + 1],
            lwd = 5,
            lty = 1
          ),
        V1[-1],
        seq_len(K - 1)
      )
      par(mar = c(0, 0, 0, 0))
      return(NULL)
    })
    plot.new()
    legend(
      'left',
      paste('motif', seq_len(K)),
      col = motif_colors,
      lwd = 7,
      lty = 1,
      bty = "n",
      xpd = TRUE
    )
  }
  
  
  # LOOP SUI MOTIFS ------
  for (k in 1:K) {
    motif_occurrences <- V_occurrences[[k]]
    obs_mot_k <- nrow(motif_occurrences)
    unique_curves <- unique(motif_occurrences[, 1])
    curve_colors <- rainbow(length(unique_curves))
    
    layout(matrix(c(seq_len(d), rep(d + 1, d)), ncol = 2), widths = c(7, 1))
    mot_color <- motif_colors[k]
    
    lapply(seq_len(d), function(j) {
      par(mar = c(3, 4, 4, 2) + 0.1)
      
      # Palette fissa per le curve coinvolte
      #unique_curves <- unique(motif_occurrences[, 1])
      #curve_colors <- rainbow(length(unique_curves))
      
      # PLOT COLORATO
      par(mar = c(5, 4, 3, 2), oma = c(0, 0, 0, 7))
      
      # PLOT BASE
      plot(
        or_data[[1]],
        xlab = "",
        ylab = ylab,
        col = scales::alpha("gray30", 0.30),
        lwd = 1.5,
        type = "l",
        main = paste0(
          "Motif ",
          k,
          " - Dimension: ",
          j,
          "\n",
          "Number of instances: ",
          obs_mot_k,
          ifelse(is.null(R_motifs), "", paste0(" - Motif Radius: ", round(R_motifs[k], 3)))
        )
      )
      
      # ALTRE CURVE
      for (curve_i in 2:length(or_data)) {
        lines(or_data[[curve_i]],
              col = scales::alpha("gray30", 0.30),
              lwd = 1.5)
      }
      
      # CURVE CON ALMENO UN'OCCORRENZA
      for (i in seq_along(unique_curves)) {
        lines(or_data[[unique_curves[i]]],
              col = curve_colors[i],
              lwd = 1.5,
              lty = 2)
      }
      
      # MOTIF + RETTANGOLO TRASPARENTE
      for (i in seq_len(obs_mot_k)) {
        curve_id <- motif_occurrences[i, 1]
        shift <- motif_occurrences[i, 2]
        motif_length <- length(motifs_search_results$V0[[k]])
        x_vals <- shift:(shift + motif_length)
        y_vals <- or_data[[curve_id]][x_vals]
        
        # rettangolo trasparente dello stesso colore del motif
        rgb_vals <- col2rgb(mot_color) / 255
        rect(
          min(x_vals),
          par("usr")[3],
          max(x_vals),
          par("usr")[4],
          col = rgb(rgb_vals[1], rgb_vals[2], rgb_vals[3], alpha = 0.05),
          border = NA
        )
        
        # linea sopra
        lines(x_vals, y_vals, col = mot_color, lwd = 2.5)
      }
      
      # LEGENDA
      par(xpd = NA)
      legend(
        par("usr")[2] + diff(par("usr")[1:2]) * 0.02,
        par("usr")[4],
        legend = c(paste0("curve ", unique_curves), paste0("motif_", k)),
        col = c(curve_colors, mot_color),
        lty = c(rep(2, length(
          unique_curves
        )), 1),
        lwd = c(rep(1.5, length(
          unique_curves
        )), 3),
        bty = "n",
        cex = 0.8
      )
    })
    
    # FOCUSED PLOT
    lapply(seq_len(d), function(j) {
      par(mar = c(5, 4, 3, 2), oma = c(0, 0, 0, 7))
      
      plot(
        V0[[k]],
        type = 'l',
        col = mot_color,
        lwd = 2.5,
        xlab = "",
        ylab = ylab,
        main = paste0(
          "Motif ",
          k,
          " - Dimension: ",
          j,
          "\n",
          "Number of instances: ",
          obs_mot_k,
          ifelse(is.null(R_motifs), "", paste0(
            " - Motif Radius: ", round(R_motifs[k], 3)
          ))
        )
      )
      
      for (curve_i in seq_len(nrow(motif_occurrences))) {
        curve_id <- motif_occurrences[curve_i, 1]
        shift <- motif_occurrences[curve_i, 2]
        motif_length <- length(V0[[k]])
        x_vals <- shift:(shift + motif_length)
        y_vals <- or_data[[curve_id]][x_vals]
        lines(y_vals, col = curve_colors[curve_i], lwd = 1)
      }
      
      # linea del motif sopra le altre
      lines(V0[[k]], col = mot_color, lwd = 2.5)
      
      # LEGENDA
      par(xpd = NA)
      legend(
        par("usr")[2] + diff(par("usr")[1:2]) * 0.02,
        par("usr")[4],
        legend = c(paste0("curve ", unique_curves), paste0("motif_", k)),
        col = c(curve_colors, mot_color),
        lty = c(rep(2, length(
          unique_curves
        )), 1),
        lwd = c(rep(1.5, length(
          unique_curves
        )), 3),
        bty = "n",
        cex = 0.8
      )
    })
    
    # FOCUSED PLOT V1
    lapply(seq_len(d), function(j) {
      par(mar = c(5, 4, 3, 2), oma = c(0, 0, 0, 7))
      
      plot(
        V1[[k]],
        type = 'l',
        col = mot_color,
        lwd = 2.5,
        xlab = "",
        ylab = ylab,
        main = paste0(
          "Motif ",
          k,
          " - Dimension: ",
          j,
          "\n",
          "Number of instances: ",
          obs_mot_k,
          ifelse(is.null(R_motifs), "", paste0(
            " - Motif Radius: ", round(R_motifs[k], 3)
          ))
        )
      )
      
      for (curve_i in seq_len(nrow(motif_occurrences))) {
        curve_id <- motif_occurrences[curve_i, 1]
        shift <- motif_occurrences[curve_i, 2]
        motif_length <- length(V1[[k]])
        x_vals <- shift:(shift + motif_length)
        y_vals <- der_data[[curve_id]][x_vals]
        lines(y_vals, col = curve_colors[curve_i], lwd = 1)
      }
      
      # linea del motif sopra le altre
      lines(V1[[k]], col = mot_color, lwd = 2.5)
      
      # LEGENDA
      par(xpd = NA)
      legend(
        par("usr")[2] + diff(par("usr")[1:2]) * 0.02,
        par("usr")[4],
        legend = c(paste0("curve ", unique_curves), paste0("motif_", k)),
        col = c(curve_colors, mot_color),
        lty = c(rep(2, length(
          unique_curves
        )), 1),
        lwd = c(rep(1.5, length(
          unique_curves
        )), 3),
        bty = "n",
        cex = 0.8
      )
    })
  }
  
  # plot every single curve
  if (plot_curves == TRUE) {
    for (f in 1:N) {
      lapply(seq_len(d), function(j) {
        par(mar = c(5, 4, 3, 2), oma = c(0, 0, 0, 7))
        
        plot(
          or_data[[f]],
          type = 'l',
          col = scales::alpha("gray30", 0.30),
          lwd = 1.5,
          ylab = ylab,
          xlab = "",
          main = paste0("Curve ", f, " - Dimention: ", j)
        )
        
        # check if they have a motif, add it
        occ_inside <- all_occurrences[which(all_occurrences$curve == f), ]
        if (nrow(occ_inside) > 0) {
          for (occ_i in seq_len(nrow(occ_inside))) {
            temp_mot <- occ_inside$motif[occ_i]
            shift <- occ_inside[occ_i, 2]
            motif_length <- length(V0[[temp_mot]])
            x_vals <- shift:(shift + motif_length)
            y_vals <- or_data[[f]][x_vals]
            # plot line
            lines(x_vals, y_vals, col = motif_colors[temp_mot], lwd = 2)
          }
          
          # LEGENDA
          motifs_here <- unique(occ_inside$motif)
          
          par(xpd = NA)
          legend(
            par("usr")[2] + diff(par("usr")[1:2]) * 0.02,
            par("usr")[4],
            legend = paste0("motif_", motifs_here),
            col = motif_colors[motifs_here],
            lwd = 2,
            bty = "n",
            cex = 0.8
          )
        }
      })
    }
  }
  return()
}

#'OLD VERSION 
# motifs_search_plot <- function(motifs_search_results, ylab = '',freq_threshold = 5, top_n = 'all', plot_curves = TRUE, transformed = FALSE){
#   # Plot the results of motifs_search.
#   # motifs_search_results: output of motifs_search function.
#   # freq_threshold: plot only motifs with frequency at least equal to freq_threshold.
#   # top_n: if 'all', plot all motifs found. If top_n is an integer, then all top top_n motifs are plotted.
#   # plot_curves: if TRUE, plot all the curves with coloured motifs.
#   
#   ### check input ############################################################################################
#   # check freq_threshold
#   oldpar <- par(no.readonly = TRUE)
#   # Ensure the original settings are restored when the function exits
#   on.exit(par(oldpar))
#   if(max(motifs_search_results$V_frequencies) < freq_threshold)
#     stop('There are no motifs with frequency at least equal to freq_threshold.')
#   # check top_n
#   if(top_n != 'all'){
#     if(length(top_n) != 1)
#       stop('top_n not valid.')
#     if(top_n%%1 != 0)
#       stop('top_n should be an integer.')
#     if(top_n < 1)
#       stop('top_n should be at least 1.')
#   }
#   
#   ### select motifs to plot ##################################################################################
#   d = ncol(motifs_search_results$Y0[[1]])
#   N = length(motifs_search_results$Y0)
#   index_plot = which(motifs_search_results$V_frequencies>=freq_threshold)
#   if(top_n != 'all'){
#     if(length(index_plot) > top_n)
#       index_plot = index_plot[seq_len(top_n)]
#   }
#   K  = length(index_plot)
#   V0 = motifs_search_results$V0[index_plot]
#   V1 = motifs_search_results$V1[index_plot]
#   V_dom = lapply(V0,function(v) rowSums(!is.na(v))!=0)
#   V_length = motifs_search_results$V_length[index_plot]
#   V_occurrences = motifs_search_results$V_occurrences[index_plot]
#   V_frequencies = motifs_search_results$V_frequencies[index_plot]
#   V_mean_diss = motifs_search_results$V_mean_diss[index_plot]
#   R_motifs = motifs_search_results$R_motifs[index_plot]
#   
#   ### plot motifs ############################################################################################
#   layout(matrix(c(seq_len(d),rep(d+1,d)),ncol=2),widths=c(7,1))
#   lapply(seq_len(d),
#          function(j){
#            par(mar=c(3,4,4,2)+0.1)
#            plot(V0[[1]][,j],type='l',col=rainbow(K),lwd=5,lty=1,main=paste0(ylab,"-","Dimension:",j),xlim=c(1,max(V_length)),
#                 ylab=ylab,ylim=c(min(unlist(V0)),max(unlist(V0))))
#            mapply(function(v,k) points(v[,j],type='l',col=rainbow(K)[k+1],lwd=5,lty=1,ylab=ylab),
#                   V0[-1],seq_len(K-1))
#            par(mar=c(0,0,0,0))
#            return()})
#   plot.new()
#   legend('left',paste('motif',seq_len(K)),col=rainbow(K),lwd=7,lty=1,bty="n",xpd=TRUE)
#   if(!is.null(V1[[1]])){
#     layout(matrix(c(seq_len(d),rep(d+1,d)),ncol=2),widths=c(7,1))
#     lapply(seq_len(d),
#            function(j){
#              par(mar=c(3,4,4,2)+0.1)
#              plot(V1[[1]][,j],type='l',col=rainbow(K),lwd=5,lty=1,main=paste(ylab,"-","Dimension:",j,'derivative'),xlim=c(1,max(V_length)),
#                   ylab = ylab, ylim = c(min(unlist(V1)),max(unlist(V1))))
#              mapply(function(v,k) points(v[,j],type='l',col=rainbow(K)[k+1],lwd=5,lty=1,ylab=ylab),
#                     V1[-1],seq_len(K-1))
#              par(mar=c(0,0,0,0))
#              return()})
#     plot.new()
#     legend('left',paste('motif',seq_len(K)),col=rainbow(K),lwd=7,lty=1,bty="n",xpd=TRUE)
#   }
#   
#   ### plot motifs with matched curves ########################################################################
#   if(is.null(V1[[1]])){
#     mapply(function(v,v_dom,v_occurrences,v_frequencies,k,R_motif){
#       Y_inters_k=mapply(function(y,s_k_i,v_dom){
#         v_len=length(v_dom)
#         Y_inters_k=as.matrix(as.matrix(y[s_k_i-1+seq_len(v_len),])[v_dom,])
#         return(Y_inters_k)},  # c('curve','shift','diss')
#         motifs_search_results$Y0[v_occurrences[,1]],v_occurrences[,2],MoreArgs=list(v_dom),SIMPLIFY=FALSE)
#       layout(matrix(1:(2*d),ncol=2,byrow=TRUE),widths=c(7,1))
#       Y0_diff_k=lapply(Y_inters_k,
#                        function(Y0_inters_k){
#                          y0_min=apply(Y0_inters_k, 2, min, na.rm = TRUE)
#                          y0_max=apply(Y0_inters_k, 2, max, na.rm = TRUE)
#                          y0_diff=y0_max-y0_min
#                          return(y0_diff)
#                        })
#       lapply(seq_len(d),
#              function(j){
#                par(mar=c(3,4,4,2)+0.1)
#                y_plot=matrix(NA,nrow=length(v_dom),ncol=length(Y_inters_k))
#                if(transformed){
#                  y_plot[v_dom,]=Reduce('cbind',
#                                        mapply(function(Y_inters_k, Y_diff_k) {
#                                          y0_min=min(Y_inters_k[,j])
#                                          y0_norm = t( (t(Y_inters_k[,j]) - y0_min) / Y_diff_k[j] )
#                                          y0_const = (Y_diff_k[j] == 0)
#                                          y0_norm[,y0_const] = 0.5
#                                          return(y0_norm)},
#                                          Y_inters_k, Y0_diff_k, SIMPLIFY=FALSE) )
#                } else {
#                  y_plot[v_dom,]=Reduce('cbind',lapply(Y_inters_k,function(Y_inters_k) Y_inters_k[,j]))
#                }
#                matplot(y_plot,type='l',col=v_occurrences[,1]+1,lwd=round(-4/R_motif*v_occurrences[,3]+5,2),
#                        lty=1,ylab=ylab,main=paste0('Motif ',k,' (',v_frequencies,' occurrences) - ',ylab,"-","Dimension:",j))
#                points(v[,j],type='l',col='black',lwd=7,lty=1)
#                par(mar=c(0,0,0,0))
#                plot.new()
#                legend('left',legend='motif center',col='black',lwd=7,lty=1,bty="n",xpd=TRUE)
#              })
#       return()},V0,V_dom,V_occurrences,V_frequencies,seq_len(K),R_motifs)
#   }else{
#     mapply(function(v0,v1,v_dom,v_occurrences,v_frequencies,k,R_motif){
#       Y0_inters_k=mapply(
#         function(y,s_k_i,v_dom){
#           v_len=length(v_dom)
#           Y_inters_k=as.matrix(as.matrix(y[s_k_i-1+seq_len(v_len),])[v_dom,])
#           return(Y_inters_k)},
#         motifs_search_results$Y0[v_occurrences[,1]],v_occurrences[,2],MoreArgs=list(v_dom),SIMPLIFY=FALSE)
#       Y1_inters_k=mapply(
#         function(y,s_k_i,v_dom){
#           v_len=length(v_dom)
#           Y_inters_k=as.matrix(as.matrix(y[s_k_i-1+seq_len(v_len),])[v_dom,])
#           return(Y_inters_k)},
#         motifs_search_results$Y1[v_occurrences[,1]],v_occurrences[,2],MoreArgs=list(v_dom),SIMPLIFY=FALSE)
#       layout(matrix(1:(2*d),ncol=2,byrow=TRUE),widths=c(7,1))
#       Y0_diff_k=lapply(Y0_inters_k,
#                        function(Y0_inters_k){
#                          y0_min=apply(Y0_inters_k, 2, min, na.rm = TRUE)
#                          y0_max=apply(Y0_inters_k, 2, max, na.rm = TRUE)
#                          y0_diff=y0_max-y0_min
#                          return(y0_diff)
#                        })
#       lapply(seq_len(d),
#              function(j){
#                par(mar=c(3,4,4,2)+0.1)
#                y_plot=matrix(NA,nrow=length(v_dom),ncol=length(Y0_inters_k))
#                if(transformed){
#                  y_plot[v_dom,]=Reduce('cbind',
#                                        mapply(function(Y_inters_k, Y_diff_k) {
#                                          y0_min=min(Y_inters_k[,j])
#                                          y0_norm = t( (t(Y_inters_k[,j]) - y0_min[j]) / Y_diff_k[j] )
#                                          y0_const = (Y_diff_k[j] == 0)
#                                          y0_norm[,y0_const] = 0.5
#                                          return(y0_norm)},
#                                          Y0_inters_k, Y0_diff_k, SIMPLIFY=FALSE) 
#                  )
#                } else {
#                  y_plot[v_dom,]=Reduce('cbind',lapply(Y0_inters_k,function(Y_inters_k) Y_inters_k[,j]))
#                }
#                matplot(y_plot,type='l',col=v_occurrences[,1]+1,lwd=round(-4/R_motif*v_occurrences[,3]+5,2),
#                        lty=1,ylab=ylab,main=paste0('Motif ',k,' (',v_frequencies,' occurrences) - ',ylab,"-","Dimension:",j))
#                points(v0[,j],type='l',col='black',lwd=7,lty=1)
#                par(mar=c(0,0,0,0))
#                plot.new()
#                legend('left',legend='motif center',col='black',lwd=7,lty=1,bty="n",xpd=TRUE)
#              })
#       lapply(seq_len(d),
#              function(j){
#                par(mar=c(3,4,4,2)+0.1)
#                y_plot=matrix(NA,nrow=length(v_dom),ncol=length(Y1_inters_k))
#                if(transformed){
#                  y_plot[v_dom,]=Reduce('cbind',
#                                        mapply(function(Y1_inters_k, Y_diff_k) {
#                                          y1_norm = t( t(Y1_inters_k[,j])/ Y_diff_k[j] )
#                                          y0_const = (Y_diff_k[j] == 0)
#                                          y1_norm[,y0_const] = 0
#                                          return(y1_norm)},
#                                          Y1_inters_k, Y0_diff_k, SIMPLIFY=FALSE)
#                  ) 
#                } else {
#                  y_plot[v_dom,]=Reduce('cbind',lapply(Y1_inters_k,function(Y_inters_k) Y_inters_k[,j]))
#                }               
#                matplot(y_plot,type='l',col=v_occurrences[,1]+1,lwd=round(-4/R_motif*v_occurrences[,3]+5,2),
#                        lty=1,ylab=ylab,main=paste0('Motif ',k,' (',v_frequencies,' occurrences) - ',ylab,"-","Dimension:",j,' derivative'))
#                points(v1[,j],type='l',col='black',lwd=7,lty=1)
#                par(mar=c(0,0,0,0))
#                plot.new()
#                legend('left',legend='motif center',col='black',lwd=7,lty=1,bty="n",xpd=TRUE)
#              })
#       return()},V0,V1,V_dom,V_occurrences,V_frequencies,seq_len(K),R_motifs)
#   }
#   
#   ### plot curves with motifs ################################################################################
#   if(plot_curves){
#     if(is.null(motifs_search_results$Y1[[1]])){
#       mapply(function(y0,i){
#         s_i=lapply(V_occurrences,function(occurrences) occurrences[occurrences[,1]==i,2])
#         motifs_in_curve=rep(seq_len(K),unlist(lapply(s_i,length)))
#         s_i=unlist(s_i)
#         Y_inters_k=mapply(function(v_dom,s_i_k,y){
#           v_len=length(v_dom)
#           Y_inters_k=matrix(NA,nrow=length(v_dom),ncol=d)
#           Y_inters_k[v_dom,]=as.matrix(as.matrix(y[s_i_k-1+seq_len(v_len),])[v_dom,])
#           return(Y_inters_k)},
#           V_dom[motifs_in_curve],s_i,MoreArgs=list(y0),SIMPLIFY=FALSE)
#         layout(matrix(c(seq_len(d),rep(d+1,d)),ncol=2),widths=c(7,1))
#         lapply(seq_len(d),
#                function(j){
#                  par(mar=c(3,4,4,2)+0.1)
#                  plot(y0[,j],type='l',main=paste('Region',i,'-',ylab,"-","Dimension:",j),ylab=ylab)
#                  for(k in seq_along(motifs_in_curve)){
#                    lines(s_i[k]-1+seq_len(V_length[motifs_in_curve[k]]),Y_inters_k[[k]][,j],col=rainbow(K)[motifs_in_curve[k]],lwd=5)
#                    rect(s_i[k], min(y0[,j],na.rm=TRUE)-10, tail(s_i[k]-1+seq_len(V_length[motifs_in_curve[k]]), n=1), max(y0[,j],na.rm=TRUE)+10,
#                         border = scales::alpha(rainbow(K)[motifs_in_curve[k]], 0.05), col = scales::alpha(rainbow(K)[motifs_in_curve[k]], 0.05))
#                  }
#                })
#         plot.new()
#         if(length(motifs_in_curve)==0){
#           legend_text=''
#         }else{
#           legend_text=paste('motif',unique(motifs_in_curve))
#         }
#         legend('left',legend_text,col=rainbow(K)[unique(motifs_in_curve)],lwd=7,lty=1,bty="n",xpd=TRUE,title='Motifs')
#         return()},motifs_search_results$Y0,seq_len(N))
#     }else{
#       mapply(function(y0,y1,i){
#         s_i=lapply(V_occurrences,function(occurrences) occurrences[occurrences[,1]==i,2])
#         motifs_in_curve=rep(seq_len(K),unlist(lapply(s_i,length)))
#         s_i=unlist(s_i)
#         Y0_inters_k=mapply(function(v_dom,s_i_k,y){
#           v_len=length(v_dom)
#           Y_inters_k=matrix(NA,nrow=length(v_dom),ncol=d)
#           Y_inters_k[v_dom,]=as.matrix(as.matrix(y[s_i_k-1+seq_len(v_len),])[v_dom,])
#           return(Y_inters_k)},
#           V_dom[motifs_in_curve],s_i,MoreArgs=list(y0),SIMPLIFY=FALSE)
#         Y1_inters_k=mapply(function(v_dom,s_i_k,y){
#           v_len=length(v_dom)
#           Y_inters_k=matrix(NA,nrow=length(v_dom),ncol=d)
#           Y_inters_k[v_dom,]=as.matrix(as.matrix(y[s_i_k-1+seq_len(v_len),])[v_dom,])
#           return(Y_inters_k)},
#           V_dom[motifs_in_curve],s_i,MoreArgs=list(y1),SIMPLIFY=FALSE)
#         layout(matrix(c(seq_len(d),rep(d+1,d)),ncol=2),widths=c(7,1))
#         lapply(seq_len(d),
#                function(j){
#                  par(mar=c(3,4,4,2)+0.1)
#                  plot(y0[,j],type='l',main=paste('Region',i,'-',ylab,"-","Dimension:",j),ylab=ylab,xlab='')
#                  for(k in seq_along(motifs_in_curve)){
#                    lines(s_i[k]-1+seq_len(V_length[motifs_in_curve[k]]),Y0_inters_k[[k]][,j],col=rainbow(K)[motifs_in_curve[k]],lwd=5)
#                  }
#                })
#         plot.new()
#         if(length(motifs_in_curve)==0){
#           legend_text=''
#         }else{
#           legend_text=paste('motif',unique(motifs_in_curve))
#         }
#         legend('left',legend_text,col=rainbow(K)[unique(motifs_in_curve)],lwd=7,lty=1,bty="n",xpd=TRUE,title='Motifs')
#         lapply(seq_len(d),
#                function(j){
#                  par(mar=c(3,4,4,2)+0.1)
#                  plot(y1[,j],type='l',main=paste('Region',i,'-',paste(ylab,"-","Dimension:",j,'derivative')),ylab=ylab)
#                  for(k in seq_along(motifs_in_curve)){
#                    lines(s_i[k]-1+seq_len(V_length[motifs_in_curve[k]]),Y1_inters_k[[k]][,j],col=rainbow(K)[motifs_in_curve[k]],lwd=5)
#                  }
#                })
#         plot.new()
#         if(length(motifs_in_curve)==0){
#           legend_text=''
#         }else{
#           legend_text=paste('motif',unique(motifs_in_curve))
#         }
#         legend('left',legend_text,col=rainbow(K)[unique(motifs_in_curve)],lwd=7,lty=1,bty="n",xpd=TRUE,title='Motifs')
#         return()},motifs_search_results$Y0,motifs_search_results$Y1,seq_len(N))
#     }
#   }
#   
#   return()
# }

Try the funMoDisco package in your browser

Any scripts or data that you put into this service are public.

funMoDisco documentation built on April 22, 2026, 9:06 a.m.