Afegit funció de visor.

chromatoR/app.R

@@ -10,23 +10,35 @@ ui <- fluidPage(
     titlePanel("ChromatoR"),
 
     # Sidebar with a slider input for number of bins 
-    sidebarLayout(
-        sidebarPanel(
-          fileInput("file1", "Sube fichero ab1", multiple = FALSE),
-          numericInput("thr", label = "Peak Threshold", value = 450),
-          numericInput("dist1", label = "1st Distance Reduction", value = 4),
-          numericInput("dist2", label = "2nd Distance Reduction", value = 7),
-          numericInput("ratio", label = "Ratio 2ary seq", value = 0.33),
-          textInput("old", label="Referencia"),
-          actionButton("calab", "Analizar")
-        ),
-
-        # Show a plot of the generated distribution
-        mainPanel(
-          tags$head(tags$style(HTML("pre,.wrap { white-space: pre-wrap; word-break: break-all; }"))),
-          verbatimTextOutput("Primseq") %>% tagAppendAttributes(class="wrap"),
-          verbatimTextOutput("align")
-        )
+    navbarPage("ChromatoR",
+        tabPanel("Detección de Bases",
+          sidebarPanel(
+            fileInput("file1", "Sube fichero ab1", multiple = FALSE),
+            numericInput("thr", label = "Peak Threshold", value = 450),
+            numericInput("dist1", label = "1st Distance Reduction", value = 4),
+            numericInput("dist2", label = "2nd Distance Reduction", value = 7),
+            numericInput("ratio", label = "Ratio 2ary seq", value = 0.33),
+            textInput("old", label="Referencia"),
+            actionButton("calab", "Analizar")
+          ),
+  
+          # Show a plot of the generated distribution
+          mainPanel(
+            tags$head(tags$style(HTML("pre,.wrap { white-space: pre-wrap; word-break: break-all; }"))),
+            verbatimTextOutput("Primseq") %>% tagAppendAttributes(class="wrap"),
+            verbatimTextOutput("align")
+          )
+      ),
+      tabPanel("Visor de Cromatograma",
+          sidebarPanel(
+            numericInput("visStart", label="Inicio", value=0),
+            numericInput("visWidth", label="Bases a mostrar", value=50),
+            actionButton("butvis", "Mostrar")
+          ),
+          mainPanel(
+            plotOutput("visor",width=1000)
+          )
+      )
     )
 )
 
@@ -177,7 +189,7 @@ server <- function(input, output) {
   output$Primseq <- renderText({
     observeEvent(obj$seq, {})
 
-    if (!is.null(obj$seq) & input$old != ""){
+    if (!is.null(obj$seq)){
       print(1)
       as.character(obj_ab@primarySeq)
     }
@@ -192,6 +204,41 @@ server <- function(input, output) {
       paste(capture.output(print(alignament, show="complete")), collapse="\n")
     }
   })
+  
+  plotvis<-eventReactive( input$butvis, {
+    if (!is.null(obj$seq)){
+      print("Inicio imagen")
+      width<-input$visWidth
+      min<-input$visStart
+      max<-min+width
+      
+      let<-obj_ab@primarySeq %>% as.character %>% strsplit("")
+      picks_x<-apply(obj_ab@peakPosMatrix, 1, max, na.rm=T)
+      
+      picks<-data.frame(rows=apply(obj_ab@peakPosMatrix, 1, max, na.rm=T), Base=let[[1]], num=1:length(let[[1]])) %>%
+        filter(num >= min & num <= max) #%>% mutate(rows=rows-min)
+      
+      ranPeaks<-range(picks$rows)
+      
+      obj$plot<-obj_ab@traceMatrix %>% as.data.frame() %>% rename(A=V1,C=V2,G=V3,T=V4) %>% add_column(rows=1:nrow(.)) %>% 
+        filter(rows >= ranPeaks[1] & rows <= ranPeaks[2]) %>% gather(Base, Value, -rows) %>% 
+        mutate(Base=factor(Base, levels=c("G","A","T","C"))) %>% 
+        ggplot(aes(rows, Value))+
+        geom_line(aes(color=Base))+
+        geom_vline(xintercept = picks_x[picks_x >= ranPeaks[1] & picks_x <= ranPeaks[2]], alpha=0.2)+
+        geom_text(data=picks, aes(label=Base, y=3800, color=factor(Base,levels=c("G","A","T","C"))))+
+        geom_text(data=picks, aes(label=num, y=4250), size=3, angle=90, hjust=0.5, vjust=0.5)+
+        scale_color_manual(values=c("G"="black", "A"="#66CC00", "T"="red","C"="blue"))+
+        geom_hline(yintercept = peakthr)+
+        theme_classic()
+      print("Final Imagen")
+    }
+  })
+  
+  output$visor <- renderPlot({
+    observeEvent(input$butvis, {plotvis()})
+    obj$plot
+  })
 
 }