MultiplePrimerEntry/server.R at main · mf-rug/MultiplePrimerEntry · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
server <- function(input, output) {

  observeEvent(input$format, {
    if (input$tabs == "Merck") {
      if (input$format != 'Dry') {
        enable('conc')
      } else {
        disable('conc')
      }
    }
  })

  d_i_t <- eventReactive(input$seqs, {
    out <- 'Delimiter between name and sequence in the input'
    if (input$seqs != '') {
      show('hidehr')
      possible_splits <- str_split(str_replace_all(input$seqs, '[A-Za-z0-9-_]+', 'a'), 'a')[[1]]
      possible_splits <- unique(possible_splits[possible_splits != ""])
      if (!identical(possible_splits, character(0))) {
        stri <- str_split(str_remove(input$seqs, '(?:\\n)*$'), '\\n')[[1]]
        stri.df <-
          sapply(1:length(possible_splits), function(y)
            sapply(stri, function(x)
              str_count(
                x, str_replace_all(possible_splits[y], '(.)', '\\\\\\1')
              ))) %>% as.data.frame()
        guess <- possible_splits[which(apply(stri.df, 2, sum) == length(stri))]
        if (length(guess) == 1) {
          updateTextInput(session = getDefaultReactiveDomain(), inputId = 'delim', value = guess)
          out <- 'Delimiter between name and sequence in the input (auto detected)'
        }
      }
    } else {
      hide('hidehr')
    }
    out
  })

  output$delim_in_text <- renderUI({
    HTML(paste0('<strong>', d_i_t(), '</strong>'))
  })

  output$clip <- renderUI({
    out <- ''
    if (input$seqs != '') {
      pat <- paste0(input$delim, '|\\n')
      process <- str_split(str_remove(gsub('  *', ' ', input$seqs), '(?:\\n)+$'), pattern = pat)[[1]]
      if (str_count(str_remove(input$seqs, '(?:\\n)+$'), '\\n') + 1 != length(process) /2) {
        out <- ''
      } else {
        process <- matrix(process, ncol = str_count(str_remove(input$seqs, '(?:\\n)+$'), '\n') +1) %>% t() %>% as.data.frame()
        sep <- sample(setdiff(str_split('_"$&+,:;=?@#|\'<>.*()%!/{}-', '')[[1]], unique(str_split(input$seqs, '')[[1]])), 1)
        if (input$tabs == "Generic") {
          out <- data.frame("name" = process[,1],
                            'seqs' = process[,2]) %>% format_delim(delim =sep, col_names = FALSE)
        } else if (input$tabs == "Merck") {
          out <- data.frame("name" = process[,1],
                            '5p' = '',
                            'seqs' = process[,2],
                            '3p' = '',
                            'scale' = input$scale,
                            'pure' = input$purification,
                            'format' = input$format,
                            'conc' = ifelse(input$format == "Dry", "None", input$conc)) %>% format_delim(delim =sep, col_names = FALSE)
        } else {
          out <- data.frame("name" = process[,1],
                            'seqs' = process[,2],
                            'scale' = input$scaleIDT,
                            'pure' = input$purificationIDT) %>% format_delim(delim =sep, col_names = FALSE)
        }
        #looks weird, but need to take care of backslashes and replace \t with actual tabs.
        print(paste('sep', sep, 'input$delim_out', input$delim_out))
        input_delim_converted <- str_replace(input$delim_out, "\\\\t", "\t")
        out <- str_replace_all(out, paste0('[',sep,']'), input_delim_converted)
      }
    }
    rclipButton("clipbtn", HTML('<small><font color="grey">Copy to clipboard</font></small>'), out, modal = FALSE, icon("copy"), )
  })

  output$out <- renderDT({
    if (input$seqs != '') {
      pat <- paste0(input$delim, '|\\n')
      process <- str_split(str_remove(gsub('  *', ' ', input$seqs), '(?:\\n)+$'), pattern = pat)[[1]]
      if (str_count(str_remove(input$seqs, '(?:\\n)+$'), '\\n') + 1 != length(process) /2) {
        hide('hidehr')
        out <- "<i>Problem parsing input</i>"
        datatable(data.frame('Problem' = out), options = list(dom = 't',
                                                              headerCallback = JS(
                                                                "function(thead, data, start, end, display){",
                                                                "  $(thead).remove();",
                                                                "}")),
                  rownames = FALSE,
                  escape = FALSE,
                  selection = 'none') %>% formatStyle(1, backgroundColor = 'white', border = 'none', color = 'grey')
      } else {
        show('hidehr')
        process <- matrix(process, ncol = str_count(str_remove(input$seqs, '(?:\\n)+$'), '\n') +1) %>% t() %>% as.data.frame()
        if (input$tabs == "Generic") {
          out <- data.frame("name" = process[,1],
                            'seqs' = process[,2])
        } else if (input$tabs == "Merck") {
          out <- data.frame("name" = process[,1],
                            '5p' = '',
                            'seqs' = process[,2],
                            '3p' = '',
                            'scale' = input$scale,
                            'pure' = input$purification,
                            'format' = input$format,
                            'conc' = ifelse(input$format == "Dry", "None", input$conc))
        } else {
          out <- data.frame("name" = process[,1],
                            'seqs' = process[,2],
                            'scale' = input$scaleIDT,
                            'pure' = input$purificationIDT)
        }
        datatable(out, options = list(dom = 't',
                                      pageLength = 50000,
                                      headerCallback = JS(
                                        "function(thead, data, start, end, display){",
                                        "  $(thead).remove();",
                                        "}")),
                  rownames = FALSE,
                  selection = 'none') %>% formatStyle(colnames(out), backgroundColor = 'white', border = 'none')
      }
    }
  })
}