LACEinterface: LACE interface

### inference_tab.R

### Inference reactiveVals ####

inf_uis = c("inf_num_iter",
            "inf_num_rs",
            "inf_n_try_bs",
            "inf_num_processes",
            "inf_seed",
            "inf_random_tree",
            "inf_marginalize",
            "inf_keep_equivalent",
            "inf_check_indistinguishable",
            "inf_show",
            "inf_learning_rate",
            "inf_error_move")


# inf_rvs = reactiveValues(inf_buttons = list(),
#                          inf_observers = list())


for (inf_ui in inf_uis)
  inputs[[inf_ui]] <- reactiveVal()

inputs[['inf_alpha']] <- reactiveVal()
inputs[['inf_beta']] <- reactiveVal()
inputs[['inf_run']] <- reactiveVal()


if (is.null(session$userData[["ed_table_react_list"]])) {
  session$userData[["ed_table_react_list"]] <- reactiveValues()
}

if (is.null(session$userData[["ed_table_react_list_obj"]])) {
  session$userData[["ed_table_react_list_obj"]] <- list()
  session$userData[["ed_table_react_list_obj"]]$obj = reactiveValues()
  session$userData[["ed_table_react_list_obj"]]$observers = list()
}


## Create empty table
if (!is.null(inputs[['m_time_column']])) {
  empty_table <-
    data.frame(matrix(0,
                      ncol = length(inputs[['m_time_column']]()),
                      nrow = 1))
  colnames(empty_table) <-
    c(inputs[['m_time_column']]())
} else {
  empty_table <- data.frame(matrix(0, ncol = 1, nrow = 1))
  colnames(empty_table) <- c('T1')
}

## print(empty_table)
ed_tables <- list()

## Create false positive and false negative UI table set to empty table
ed_tables[['inf_alpha']] <-
  ed_table('inf_alpha', empty_table, 'alpha_', session)

ed_tables[['inf_beta']] <-
  ed_table('inf_beta', empty_table, 'beta_', session)


empty_cell <- data.frame(row=-1, col=-1 , value=0)
inputs[[paste0('inf_alpha','_cell_edit')]] <- reactiveVal(empty_cell)
inputs[[paste0('inf_beta','_cell_edit')]] <- reactiveVal(empty_cell)

### End inference reactiveVals ####

### Inference functions ####
inf_exec <- function() {
  if (length(va_out_dir_()) == 0)
    return()
  if (dir.exists(va_out_dir_()))
    if (file.exists(file.path(va_out_dir_(), "D.RData"))) {
      load(file.path(va_out_dir_(),"D.RData"))

      browser()


      alpha <-
        transpose(as.data.table(session$userData[["ed_table_react_list"]][["inf_alpha"]]$x$data));
      alpha <-
        alpha[, 1:(ncol(alpha) - 1)];
      beta <-
        transpose(as.data.table(session$userData[["ed_table_react_list"]][["inf_beta"]]$x$data));
      beta <- beta[, 1:(ncol(beta) - 1)];

      ## Notes:
      ## MA: this is most likely best represented as a R
      ## 'formula'.

      string_tmp <-
        "LACE('D' = D,
                          'learning_rate' = input[['inf_learning_rate']],
                          'num_iter' = input[['inf_num_iter']],
                          'num_rs' = input[['inf_num_rs']],
                          'n_try_bs' = input[['inf_n_try_bs']],
                          'num_processes' = input[['inf_num_processes']],
                          'seed' = input[['inf_seed']],
                          'random_tree' = input[['inf_random_tree']],
                          'marginalize' = input[['inf_marginalize']],
                          'keep_equivalent' = input[['inf_keep_equivalent']],
                          'check_indistinguishable' = input[['inf_check_indistinguishable']],
                          'error_move' = input[['inf_error_move']],
                          'show' = input[['inf_show']],
                          'alpha' = as.list(alpha),
                          'beta' = as.list(beta)
                    )
                    "

      list_par <-
        list('D' = D,
             'learning_rate' = input[['inf_learning_rate']],
             'num_iter' = input[['inf_num_iter']],
             'num_rs' = input[['inf_num_rs']],
             'n_try_bs' = input[['inf_n_try_bs']],
             'num_processes' = input[['inf_num_processes']],
             'seed' = input[['inf_seed']],
             'random_tree' = input[['inf_random_tree']],
             'marginalize' = input[['inf_marginalize']],
             'keep_equivalent' = input[['inf_keep_equivalent']],
             'check_indistinguishable' = input[['inf_check_indistinguishable']],
             'error_move' = input[['inf_error_move']],
             'show' = input[['inf_show']],
             'alpha' = as.list(alpha),
             'beta' = as.list(beta)
        )

      inputs[['inf_run']](list_par)

      library(LACE)



      ##!!! ATTENZIONE QUESTO E' UN TEST FATTO CON 3 CELLULE TUTTE IN TIME_1
      ## ATTENZIONE LACE1.0 NON ACCETTA che non ci siano cellule ad un tempo
      ## OVVIO MA ANCHE NO
      ## QUI SI DUPLICANO I TEMPI VUOTI
      ## COSI NON DA ERRORE
      ## METTERE UN CHECK PRIMA DI PROCEDERE
      D$`before treatment`[1,2] <- 1
      D$`4d on treatment` <- D$`before treatment` #copia
      D$`28d on treatment` <- D$`before treatment` #copia
      D$`57d on treatment` <- D$`before treatment` #copia

      rownames(D$`4d on treatment`)= c("S1","S2","S3") #nome cellule
      rownames(D$`28d on treatment`)= c("S4","S5","S6")
      rownames(D$`57d on treatment`)= c("S9","S8","S7")

      inference_res <- LACE(D, show = F)

      ##!!! fine preparazione ATTENZIONE QUESTO E' UN TEST FATTO CON 3 CELLULE
      ## CANCELLARE QUANTO SOPRA PRIMA DI MANDARE

      show_tmp <- list_par[["show"]]
      list_par[["show"]] <- F
      #do.call('LACE',inputs[['inf_run']]())

      B <- inference_res$B
      clones_prevalence <- inference_res$clones_prevalence
      C <- inference_res$C
      error_rates <- inference_res$error_rates

      browser()
      if (show_tmp)
        lace_interface(B, clones_prevalence, C, error_rates)

      browser()
      1+1



    }
}


## inf_go

inf_go <- function() {
  av_exec()
  thr_exec()
  dp_exec()
  va_exec()
  inf_exec()
}

### End inference functions ####

### Inference observers ####

observeEvent(reactiveValuesToList(input), {
  outs <- outputOptions(output)
  lapply(names(outs), function(name) {
    outputOptions(output, name, suspendWhenHidden = FALSE)
  })
},
once = T,
priority = -1)


observe({
  inf_observers = lapply(inf_uis,
                         function(i) {
                           observeEvent(input[[i]], {
                             ## req(input)
                             inputs[[i]](input[[i]])
                           })


                           output[[i]] <- renderText(inputs[[i]]())
                         }
  )
},
priority = -1)


observeEvent(session$userData[["ed_table_react_list"]][["inf_alpha"]], {
  ## inputs[["inf_alpha"]](session$userData[['ed_table_react_list']][['inf_alpha']]$x$data)
  ## inputs[["inf_alpha"]](session$userData[['ed_table_react_list_obj']]$obj[["inf_alpha"]]$x$data)
  ## inputs[["inf_alpha"]](do.call(cbind, yaml::yaml.load(yaml::as.yaml(session$userData[['ed_table_react_list_obj']]$obj[["inf_alpha"]]$x$data))) %>% {as.data.frame((.)[,-1], row.names = (.)[,1])})

  #inputs[["inf_alpha"]](session$userData[['ed_table_react_list']][['inf_alpha']]$x$data)
  #data.frame(rownames(session$userData[['ed_table_react_list']][['inf_alpha']]$x$data), session$userData[['ed_table_react_list']][['inf_alpha']]$x$data)
  x <- data.frame(rownames(session$userData[['ed_table_react_list']][['inf_alpha']]$x$data), session$userData[['ed_table_react_list']][['inf_alpha']]$x$data, check.names=F)
  colnames(x)[1]=""
  inputs[["inf_alpha"]](x)
  #inputs[["inf_alpha"]](session$userData[["ed_table_react_list_obj"]]$obj[["inf_alpha"]]$x$data)
})


observeEvent(session$userData[["ed_table_react_list"]][["inf_beta"]], {
  x <- data.frame(rownames(session$userData[['ed_table_react_list']][['inf_beta']]$x$data), session$userData[['ed_table_react_list']][['inf_beta']]$x$data, check.names=F)
  colnames(x)[1]=""
  inputs[["inf_beta"]](x)
})


## Find out interactively the time points and use them as columns
observeEvent(inputs[['m_time_column']](), {
  if (!is.null(inputs[['m_time_points']]) &
      length(inputs[['m_time_points']]()) > 0) {
    empty_table <-
      data.frame(matrix(0,
                        ncol = length(inputs[['m_time_points']]()),
                        nrow = 1))
    colnames(empty_table) <- c(inputs[['m_time_points']]())
  } else {
    empty_table <- data.frame(matrix(0, ncol = 1, nrow = 1))
    colnames(empty_table) <- c('T1')
  }
  ## ed_tables <- list()
  ## id <- 'inf_alpha'
  for (id in c('inf_alpha', 'inf_beta')) {
    ed_tables[[id]] <-
      ed_table(id,
               empty_table,
               paste0(str_split(id,pattern = '_')[[1]][2],
                      '_'),
               session)
    ## output[[id]] <- render_dt(ed_tables[[id]])
    ## outputOptions(output, id, suspendWhenHidden = FALSE)
  }
})


## Change the order of columns accordingly to time points user
## choice
observeEvent(inputs[['m_time_points']](), {
  req(inputs[['m_time_column']]())
  id <- 'inf_alpha'
  for (id in c('inf_alpha', 'inf_beta')) {
    ## remove extra column
    mm <- isolate(session$userData[["ed_table_react_list"]][[id]]$x$data)
    extra_col <- all(mm[[1]] == rownames(mm))
    if (is.na(extra_col))
      extra_col <- FALSE
    if (extra_col)
      mm <- mm[-1]

    ## Reorder columns
    mm <- mm[,inputs[['m_time_points']](), drop = F]
    session$userData[["ed_table_react_list"]][[id]]$x$data <- mm

    ## Remove extra last row on NAN
    mm <- mm[-nrow(mm),, drop = F]

    ## Create table and render it
    ## output[[id]] <-NULL
    ed_tables[[id]] <-
      ed_table(id,
               mm,
               paste0(str_split(id,pattern = '_')[[1]][2], '_'),
               session)
    print(id)
  }
  id <- 'inf_alpha'
  ## output[['inf_alpha']] <-render_dt(ed_tables[['inf_alpha']])
  session$userData[["ed_table_react_list_obj"]]$obj[[id]] <-
    ed_tables[[id]]
  ## outputOptions(output, id, suspendWhenHidden = FALSE)
  proxy<-dataTableProxy(id)
  replaceData(proxy, mm)

  id <- 'inf_beta'
  ## output[['inf_beta']] <-render_dt(ed_tables[['inf_beta']])
  session$userData[["ed_table_react_list_obj"]]$obj[[id]] <-
    ed_tables[[id]]

  ## outputOptions(output, id, suspendWhenHidden = FALSE)
  proxy<-dataTableProxy(id)
  replaceData(proxy, mm)
  ## refresh()
})


observeEvent(input[["inf_next"]], {
  ## inf_exec()
  #browser()


  hideTab(inputId = "main_tabset", target = "SC metadata")
  hideTab(inputId = "main_tabset", target = "Annotations")
  hideTab(inputId = "main_tabset", target = "Filters")
  hideTab(inputId = "main_tabset", target = "SC sampling depths")
  hideTab(inputId = "main_tabset", target = "Variants")
  hideTab(inputId = "main_tabset", target = "Inference")
  #shinyjs::show(id="computation_idCol_div")

  inf_go()

  #shinyjs::hide(id="computation_idCol_div")
  showTab(inputId = "main_tabset", target = "SC metadata")
  showTab(inputId = "main_tabset", target = "Annotations")
  showTab(inputId = "main_tabset", target = "Filters")
  showTab(inputId = "main_tabset", target = "SC sampling depths")
  showTab(inputId = "main_tabset", target = "Variants")
  showTab(inputId = "main_tabset", target = "Inference")

},
ignoreInit = T)


observe({
  hide(id = "inf_alpha_div")
  if (file.exists(sc_metadata_label_()) )
    if (!is.null(inputs[['m_time_column']]))
      if (inputs[['m_time_column']]() > 0)
        shinyjs::show(id="inf_alpha_div")
})

observe({
  hide(id = "inf_beta_div")
  if ( file.exists(sc_metadata_label_()) )
    if (!is.null(inputs[['m_time_column']]))
      if (inputs[['m_time_column']]() > 0)
        shinyjs::show(id="inf_beta_div")
})

### End inference observes ####

### Inference outputs ####
output[['inf_alpha']] <-
  DT::renderDT(session$userData[["ed_table_react_list_obj"]]$obj[['inf_alpha']],
               server = T)
outputOptions(output, 'inf_alpha', suspendWhenHidden = FALSE)
output[['inf_beta']] <-
  DT::renderDT(session$userData[["ed_table_react_list_obj"]]$obj[['inf_beta']],
               server = T)
outputOptions(output, 'inf_beta', suspendWhenHidden = FALSE)


output[['inf_par']] <- renderPrint({
  alpha <-
    transpose(as.data.table(session$userData[["ed_table_react_list"]][["inf_alpha"]]$x$data));
  alpha <-
    alpha[, 1:(ncol(alpha) - 1)];
  beta <-
    transpose(as.data.table(session$userData[["ed_table_react_list"]][["inf_beta"]]$x$data));
  beta <-
    beta[,1:(ncol(beta)-1)];

  list("inf_learning_rate" = input[["inf_learning_rate"]],
       "inf_num_iter" = input[["inf_num_iter"]],
       "inf_num_rs" = input[['"inf_num_rs"']],
       "inf_n_try_bs" = input[["inf_n_try_bs"]],
       "inf_num_processes" = input[["inf_num_processes"]],
       "inf_seed" = input[["inf_seed"]],
       "inf_random_tree" = input[["inf_random_tree"]],
       "inf_marginalize" = input[["inf_marginalize"]],
       "inf_keep_equivalent" = input[["inf_keep_equivalent"]],
       "inf_check_indistinguishable" = input[["inf_check_indistinguishable"]],
       "inf_error_move" = input[["inf_error_move"]],
       "inf_show" = input[["inf_show"]],
       "inf_alpha" = as.list(alpha),
       "inf_beta" = as.list(beta) )
})


### End inference outputs ####


### end of file -- inference_tab.R