SciCodePile/SciCode-Domain-Code
DATA1: Domain-Specific Code Dataset Dataset Overview DATA1 is a large-scale domain-specific code dataset focusing on code samples from interdisciplinary fields such as biology, chemistry, materials science, and related areas. The dataset is collected and organized from GitHub repositories, covering 178 different domain topics with over 1.1 billion lines of code. Dataset Statistics Total Datasets: 178 CSV files Total Data Size: ~115 GB Total Lines… See the full description on the dataset page: https://huggingface.co/datasets/SciCodePile/SciCode-Domain-Code.
42.4k
1"keyword","repo_name","file_path","file_extension","file_size","line_count","content","language"
2"Lipidomics","martijnmolenaar/LION-web","OntologyApp/server.R",".R","76663","2089","options(stringsAsFactors = FALSE,shiny.sanitize.errors = F)3 4 5## examples6 7cluster_example <- read.csv(file = ""data/clusters_lipids.csv"")8PM <- read.csv(file = ""data/PM-ER_pvalues.csv"")9MT <- read.csv(file = ""data/Mito-pvalues.csv"")10ER <- read.csv(file = ""data/ER_KLA-ER_CON_pvalues.csv"")11 12LIONterms_rules <- read.csv(file = 'data/20191008 LIONterms_rules.csv', header = T)13LIONterms_rules$RULE1[LIONterms_rules$RULE1 == """"] <- ""-""14LIONterms_FAs <- read.csv(file = 'data/20191008 LIONterms_FAs.csv', header = T)15 16#change_log <- readLines('https://raw.githubusercontent.com/martijnmolenaar/lipidontology.com/master/README.md')17#change_log <- paste(change_log[-c(1:2)], collapse = ""\n"", sep = """")18 19backgroundlist_example <- paste(cluster_example$lipids, ""\n"", collapse = '', sep = """")20 21sublist_example1 <- paste(cluster_example$lipids[cluster_example$cluster == 6], ""\n"", collapse = '', sep = """")22sublist_example2 <- paste(cluster_example$lipids[cluster_example$cluster == 7], ""\n"", collapse = '', sep = """")23sublist_example3 <- paste(cluster_example$lipids[cluster_example$cluster == 8], ""\n"", collapse = '', sep = """")24 25pvalueExample1 <- paste( paste(PM$lipids, ""\t"", PM$pvalues, sep = """"), ""\n"", collapse = '', sep = """" )26pvalueExample2 <- paste( paste(MT$lipids, ""\t"", MT$pvalues, sep = """"), ""\n"", collapse = '', sep = """" )27pvalueExample3 <- paste( paste(ER$lipids, ""\t"", ER$pvalues, sep = """"), ""\n"", collapse = '', sep = """" )28 29FA_composition_table <- read.csv(file = 'data/FA_composition_table.csv')30 31source(file = ""data/20191010 LION_tree_structure.R"")32 33#### libraries34 35require(shiny)36require(visNetwork)37require(data.table)38require(igraph)39require(ggplot2)40require(ggthemes)41library(shinyTree)42library(shinyWidgets)43library(shinyBS)44library(httr)45library(formattable)46library(jsonlite)47library(ggrepel)48library(shinycssloaders)49 50 51 52 53## loading lipid ontology data54require(RSQLite)55require(topOnto)56require('topOnto.LION.db')57topOnto::initONT('LION')58 59 60associationFile <- ""data/20190704 LION_association.txt""61 62 63## load define functions64source('data/20191008 LIONweb functions.R')65 66 67## read associations68lipidID2TERM <- readMappings(file = associationFile) ## topOnto function, but removes spaces69 70 71# Define server logic for random distribution application72function(input, output, session) {73 74 showNotification(ui = """",75 action = p(""By using this app you agree with the"", a('Terms of Usage.',76 href=""https://martijnmolenaar.github.io/lipidontology.com/faq.html#basics"", 77 target=""_blank"")),78 duration = 14, type = ""default"")79 80 ### hide tabs at start-up81 hideTab(inputId = ""tabs"", target = ""LION input"")82 hideTab(inputId = ""tabs"", target = ""LION enrichment table"")83 hideTab(inputId = ""tabs"", target = ""LION enrichment graph"")84 hideTab(inputId = ""tabs"", target = ""LION network view"")85 86 observe({87 query <- parseQueryString(session$clientData$url_search)88 89 if(!is.null(query[['studyid']])){90 updatePrettyRadioButtons(91 session,92 inputId = ""file_input"",93 selected = ""load external dataset""94 )95 96 }97 })98 99 100 ## pre-processing with CSVs:101 102 input_data <- reactive({103 104 105 ifelse(input$file_input==""file input"",106 req(input$file1),107 req(input$MWfile1))108 109 110 111 112 isolate(if(input$file_input == ""file input""){113 file_location <- input$file1$datapath114 metadata <- input$file1$name115 } else if(input$file_input == ""load external dataset""){116 file_location <- paste(""https://www.metabolomicsworkbench.org/rest/study/study_id/"",117 input$MWfile1,118 ""/lion/"", sep = """")119 120 metadata <- fromJSON(paste(""https://www.metabolomicsworkbench.org/rest/study/study_id/"",121 input$MWfile1,122 ""/summary"", sep = """"))$study_title123 })124 125 126 withProgress(message = 'loading data:', value = 0, {127 if(grepl(""metabolomicsworkbench.org/rest"", file_location)){128 incProgress(.1, detail = paste(""from Metabolomis Workbench""))129 130 df <- try(read.csv(file_location,131 header = FALSE,132 sep = "","" #, quote = """"133 ))134 135 incProgress(.9, detail = paste(""..done""))136 } else {137 138 df <- try(read.csv(file_location,139 header = FALSE,140 sep = "","" #, quote = """"141 ))142 }143 })144 145 146 ###147 148 ## error handling149 150 151 errors <- NULL152 if (!(is.data.frame(df))) {153 df <- data.frame(errors = df[1], column = 0)154 if(isolate(input$file_input) == ""load external dataset""){155 errors <- c(errors, ""ERROR: Metabolomics Workbench study ID not found"")156 } else {157 errors <- c(errors, ""ERROR: File type not supported"")158 }159 160 } else {161 if (dim(df)[2] == 1) {162 errors <- c(errors, ""ERROR: No commas found to seperate columns"")163 }164 if (dim(df)[2] > 1 & dim(df)[2] < 3) {165 errors <- c(errors, ""ERROR: Unkown error"")166 }167 if (sum(is.na(df[, -1])) > 0) {168 errors <- c(errors, ""ERROR: There are missing values"")169 }170 if (sum( df[-c(1,2),-1] == """" ) > 0) {171 errors <- c(errors, ""ERROR: Dataset contains empty cells"")172 }173 if (sum( df[-c(1,2),-1] == 0 ) > 0) {174 errors <- c(errors, ""ERROR: Dataset contains zeros"")175 }176 if (all(table(as.character(df[1, -1])) < 2)) {177 errors <- c(errors, ""ERROR: Some or all conditions are n < 2"")178 }179 if (any(duplicated(df[2, -1]))) {180 errors <-181 c(errors, ""ERROR: One or more samples names are not unique"")182 }183 if (sum(apply(df[-1,-c(1:2)],1,function(row){all(row == 0)})) > 0) {184 errors <-185 c(errors, ""ERROR: Dataset contains rows with only zeros"")186 }187 }188 errors <- paste(errors, collapse = ""<br>"")189 190 ## end error handling191 192 193 isolate(if(input$file_input == ""load external dataset""){194 studyID <- paste(input$MWfile1,"": "",sep = """")195 } else {studyID <- """"})196 197 #if(!(is.null(errors))){198 if(errors==""""){199 200 input_data <- list(df = df,201 matrix = sapply(df[-c(1,2),-1], as.numeric),202 conditions = unique(as.character(df[1,-1])),203 samples = as.character(df[2,-1]),204 meta = df[1:2,-1],205 IDs = df[-c(1,2),1],206 studyID = studyID,207 metadata = metadata,208 errors = errors)209 } else {210 input_data <-list(df = NULL,211 matrix = NULL,212 conditions = NULL,213 samples = NULL,214 meta = NULL,215 IDs = NULL,216 studyID = NULL,217 metadata = NULL,218 errors = errors)219 }220 221 return(input_data)222 223 })224 225 output$load_datasetUI <- renderUI({226 file_input <- input$file_input227 228 if (file_input == ""file input"") {229 230 fluidRow(column(offset = .3, width = 12,231 232 br(),233 strong(""Choose CSV File:""),234 fluidRow(235 236 column(offset=0,#style='margin-left:2%;' ,237 width = 10,238 popify(placement = ""bottom"", title = ""File-input info"",239 fileInput(""file1"", label = NULL,240 multiple = FALSE,241 accept = c(""text/csv"",242 ""text/comma-separated-values,text/plain"",243 "".csv"") ),244 content = 'Format your dataset as comma seperated value files (.csv), with the first column reserved for metabolites and the other columns for numeric data (containing decimal points). Use double column headers; with row 1 containing condition identifiers and row 2 containing sample identifiers. Submit at least duplicates per condition. Dataset should be normalized before submission. Download a dataset below for an example.'245 246 )),247 column(offset=0, width = 1,style = ""margin-top: 5px;"",align=""center"",248 popify(placement = ""right"", title = ""Lipid nomenclature"", options=list(container=""body""),249 el = icon(name = ""question"",lib = ""font-awesome"", ""fa-2x""),250 content = 'Format lipids in LIPIDMAPS notation style: a class-prefix followed by (summed) fatty acid(s) surrounded by parentheses. Examples are: PC(32:1); PE(18:1/16:0); SM(d18:1/18:0); TAG(54:2); etc. Check www.lipidmaps.org for more examples. LION will try to reformat alternative notation styles into LIPIDMAPS format.'))),251 252 downloadLink(""examplePre1"", ""example set 1 (organelle fractions) [1]""),253 br(),254 downloadLink(""examplePre2"", ""example set 2 (CHO-k1 incubated with several FFAs) [2]""),255 br(),256 downloadLink(""examplePre3"", ""example set 3 (CHO-k1 incubated with AA) [2]""),257 br(),258 br(),259 em(tags$small(""[1] adapted from Andreyev AY et al, 2010"")), br(),260 em(tags$small(""[2] from Molenaar MR et al, 2019"")),br(),261 #em(""[1] Andreyev AY, et al., 2010""),262 br(),263 #em(""[2] Molenaar MR, et al., 2019""),264 br(),br(),265 uiOutput(""selectLocalStatisticUI"")266 ))267 268 269 } else { ### to load Metabolomics Workbench-file270 fluidRow(column(offset = .3, width = 12,271 272 br(),273 274 fluidRow(275 276 column(offset=0,#style='margin-left:2%;' ,277 width = 10,278 popify(placement = ""bottom"", title = ""Metabolomics Workbench"",279 searchInput(280 inputId = ""MWfile1"",281 label = ""Enter Metabolomics Workbench study ID"", 282 placeholder = ""study ID"", 283 btnSearch = icon(""search""), 284 btnReset = icon(""remove""),285 width = ""100%""286 ), content = ""In this field, a study ID from the Metabolomics Workbench data repository can be entered—the dataset will be loaded directly to LION/web in the required format. To browse studies, please visit the Metabolomics Workbench website (see below). Please note that LION/web does only process lipids.""287 288 ))289 ),290 291 br(),292 em(""example: ""),br(),293 ""ST001140: "",294 a('Changes in the Canine Plasma Lipidome after Short- and Long-Term Excess Glucocorticoid Exposure', 295 href=""https://www.metabolomicsworkbench.org/data/DRCCMetadata.php?Mode=Study&StudyID=ST001140"", target=""_blank""),296 br(),br(),297 em(""For more information, please visit the"", a('Metabolomics Workbench data repository.', href=""https://www.metabolomicsworkbench.org/data/browse.php"", target=""_blank"")),298 br(),299 br(),300 uiOutput(""selectLocalStatisticUI"")301 ))302 }303 304 })305 306 307 observeEvent(input$file_input, {308 309 query <- parseQueryString(session$clientData$url_search)310 311 if(!is.null(query[['studyid']])){312 updateSearchInput(313 session,314 inputId = ""MWfile1"",315 value = query[['studyid']],316 trigger = TRUE,317 label = ""Enter Metabolomics Workbench study ID""318 319 )320 321 }322 })323 324 output$selectLocalStatisticUI <- renderUI({325 326 input_data <- input_data()327 conditions <- input_data$conditions328 329 330 if (input_data$errors == """") {331 332 wellPanel(333 tags$b(input_data$metadata),334 br(),br(),335 336 popify(placement = ""bottom"", title = ""Info"",337 radioButtons(""local_statistics"", label = h5(""Select local statistics to rank input identifiers""),338 choices = list(""one-tailed T-test (2 conditions)"" = 1, ""2-LOG[fold change] (2 conditions)"" = 2, ""one-way ANOVA F-test (>2 conditions)"" = 3), 339 selected = 1), content = 'Select a local statistic to rank the metabolites based on the provided dataset. LION-terms associated with lipids higher ranked than expected by chance will be reported as enriched.'),340 popify(341 placement = ""bottom"",342 title = ""Info"",343 checkboxInput(344 inputId = ""normalization"",345 label = ""normalize signals as percentage"",346 value = FALSE347 ),348 content = 'If checked, lipid signals are expressed as percentage of the total signal per sample. This is useful when input data is not normalized.'349 ), 350 br(),351 uiOutput(""conditionsUI"")352 )353 } else { ### if there are errors...354 HTML(paste('<font color=""red"">',355 input_data$errors,356 ""</font>"",sep=""""))357 }358 359 })360 361 output$KS2_UI<- renderUI({362 363 if(input$ks_sided == ""ks2""){364 365 fluidRow(366 column(width = 1),367 column(width = 11,368 selectizeInput(""split_direction_in_output"", 369 label = NULL, 370 choices = c(""Separate up- and downregulated terms in barchart"" = ""split"", 371 ""Combine up- and downregulated terms in barchart"" = ""combine"",372 ""Display data in volcano plot"" = ""volcano""), 373 selected = ""split""))374 )375 376 }377 378 379 380 })381 382 output$conditionsUI <- renderUI({383 input_data <- input_data()384 conditions <- input_data$conditions385 386 if (input$local_statistics == 1){ ## t-test pvalues 387 388 389 wellPanel(390 391 h5(tags$i(""a T-test p-value will be calculated for every input identifier"")),392 393 fluidRow(394 column(395 width = 6,396 selectInput(397 ""conditionA"",398 h5(""condition of interest""),399 conditions,400 selected = conditions[1]401 )402 ),403 column(404 width = 6,405 selectInput(406 ""conditionB"",407 h5(""control condition""),408 conditions,409 selected = conditions[2]410 )411 )412 ),413 actionButton(414 inputId = ""calculatePreprocessing"",415 label = "" Calculate local statistics"",416 width = NULL,417 icon = icon(""line-chart"", lib = ""font-awesome"")418 ),419 br(),420 br(),421 plotOutput(""p_value_plot""),422 br(),423 uiOutput(""conditionsUI_pB"")424 )425 } else if(input$local_statistics == 2) { ### 2log fold change426 427 wellPanel(428 429 h5(tags$i(""a 2-LOG[fold change] value will be calculated for every input identifier"")),430 431 fluidRow(432 column(433 width = 6,434 selectInput(435 ""conditionA"",436 h4(""condition of interest""),437 conditions,438 selected = conditions[1]439 )440 ),441 column(442 width = 6,443 selectInput(444 ""conditionB"",445 h4(""control condition""),446 conditions,447 selected = conditions[2]448 )449 )450 ),451 actionButton(452 inputId = ""calculatePreprocessing"",453 label = "" Calculate local statistics"",454 width = NULL,455 icon = icon(""line-chart"", lib = ""font-awesome"")456 ),457 br(),458 br(),459 plotOutput(""p_value_plot""),460 br(),461 uiOutput(""conditionsUI_pB"")462 )463 464 } else { ### F-test465 466 wellPanel(467 468 h5(tags$i(""an F-test p-value will be calculated for every input identifier"")),469 470 selectizeInput(inputId = ""selectedConditions"", h4(""conditions of interest""), 471 choices = input_data()$conditions, selected = input_data()$conditions,472 multiple = TRUE,options = list(plugins= list('remove_button'))473 ),474 475 actionButton(476 inputId = ""calculatePreprocessing"",477 label = "" Calculate local statistics"",478 width = NULL,479 icon = icon(""line-chart"", lib = ""font-awesome"")480 ),481 br(),482 br(),483 htmlOutput(""FtestError""),484 br(),485 plotOutput(""p_value_plot""),486 br(),487 uiOutput(""conditionsUI_pB"")488 )489 490 }491 })492 493 output$FtestError <- renderText({ 494 message <- ifelse(length(input$selectedConditions)<2, ""ERROR: Number of conditions should be 2 or higher"","""")495 HTML(paste('<font color=""red"">',496 message,497 ""</font>"",sep=""""))498 })499 500 501 output$conditionsUI_pB <- renderUI({502 data <- pre_processed_data()[[1]] ### show when 'pre_processed_data()' is constructed503 504 505 if(!(any(is.na(data$pValues)))){506 fluidRow(507 508 actionButton(inputId = ""submitPreprocessing"",509 label = "" Use values as local statistics"", 510 width = NULL,511 icon = icon(""share-square"", lib = ""font-awesome"")),512 downloadButton(""download_pValues"", """")513 )514 }515 516 517 })518 519 pre_processed_data <- eventReactive(input$calculatePreprocessing, {520 521 input_data <- input_data()522 523 if(isolate(input$normalization)){ ## normalization option switched on524 input_data$matrix[] <- 525 apply(input_data$matrix,2,function(i){526 i / sum(i) * 100527 })528 }529 530 531 if(any(input$local_statistics %in% c(1,2))){532 setA <- input_data$matrix[,which(input_data$meta[1,] == input$conditionA)]533 setB <- input_data$matrix[,which(input_data$meta[1,] == input$conditionB)]534 }535 536 if(input$local_statistics == 1){ ### when t-test p-values are selected537 538 pValues <- apply(cbind(setA,setB), 1, function(row){539 t.test(x=row[1:dim(setA)[2]],540 y=row[(dim(setA)[2]+1):(dim(setA)[2]+dim(setB)[2])],541 alternative = ""greater"")$p.value 542 543 })544 outputList <- list(data.frame(IDs = input_data()$IDs,545 pValues = pValues))546 547 }548 549 if(input$local_statistics == 2){ ### when 2-log FC values are selected550 551 FC_values <- apply(cbind(setA,setB), 1, function(row){552 x <- mean(row[1:dim(setA)[2]], na.rm = TRUE)553 y <- mean(row[(dim(setA)[2]+1):(dim(setA)[2]+dim(setB)[2])], na.rm = TRUE)554 log(x = x/y, base = 2)555 556 })557 outputList <- list(data.frame(IDs = input_data()$IDs,558 pValues = FC_values))559 560 }561 562 if(input$local_statistics == 3){ ### when ANOVA is selected563 564 #input_data <- input_data()565 566 if (length(input$selectedConditions) > 1) { ## minimum of 2 conditions needed567 pValues <- 568 sapply(1:length(input_data$IDs), function(lipid_nr){569 df <- do.call(""rbind"",sapply(input_data$conditions, function(condition){570 data.frame(l = NA,571 condition = condition, 572 signal = input_data$matrix[lipid_nr, unlist(input_data$meta[1,]) == condition]573 )}, simplify = FALSE))574 575 model.df <- lm(signal ~ condition, data = df)576 anova(model.df)['condition','Pr(>F)']577 })578 579 } else {pValues = NA}580 581 582 outputList <- list(data.frame(IDs = input_data()$IDs,583 pValues = pValues))584 585 }586 587 names(outputList) <- paste(""set"",isolate(input$submit),sep="""")588 outputList589 590 })591 592 output$p_value_plot <- renderPlot({593 594 df <- pre_processed_data()[[1]]595 df <- df[,2][order(df[,2])]596 597 ylab <- subset(data.frame(selection = 1:3, ylab = c('t-test p-value','2-LOG[fold change]','F-test p-value (log scale)')), 598 selection == isolate(input$local_statistics))$ylab599 600 if(ylab == 'F-test p-value (log scale)'){601 if (length(input$selectedConditions) > 1) { 602 603 ggplot(data.frame(x = 1:length(df), y=df), aes(x = x, y = y))+604 labs(x = ""metabolites"", y = ylab, title = ""Distribution local statistics"")+605 geom_point()+606 scale_y_log10()+607 geom_blank()608 609 # qplot is deprecated!! 610 # qplot(y=df, main = ""Distribution local statistics"", 611 # xlab = ""metabolites"", 612 # ylab = yla613 # log = ""y"")614 615 } else {616 ggplot(data.frame(x = 1:length(df), y=NA), aes(x = x, y = y))+617 labs(x = ""metabolites"", y = ylab, title = ""Distribution local statistics"")+618 geom_blank()619 }620 621 } else {622 623 ggplot(data.frame(x = 1:length(df), y=df), aes(x = x, y = y))+624 labs(x = ""metabolites"", y = ylab, title = ""Distribution local statistics"")+625 geom_point()+626 geom_blank()627 628 # qplot is deprecated!! 629 # qplot(y=df, main = ""Distribution local statistics"", 630 # xlab = ""metabolites"", 631 # ylab = ylab632 # )633 634 635 }636 637 638 639 })640 641 ## end of pre-processing642 643 644 ## examples by p-value645 646 observeEvent(input$submitPreprocessing, {647 pre_processed_data <- pre_processed_data()[[1]]648 pre_processed_data <- paste( paste(pre_processed_data$IDs, ""\t"", pre_processed_data$pValues, sep = """"), ""\n"", collapse = '', sep = """" )649 650 updateTextAreaInput(session, ""listwPvalues"", value = pre_processed_data)651 ### update dependent on statistics choice652 if(isolate(input$local_statistics) == 2){ ### 2 == log fold change 653 updateRadioButtons(session, ""ranking"", selected = ""descending"" )654 } else { ## in case of p-values655 updateRadioButtons(session, ""ranking"", selected = ""ascending"" )656 }657 658 ###659 updateTabsetPanel(session, ""sub_method"",660 selected = ""(ii) analysis"")661 })662 663 output$examplePre1 <- downloadHandler(664 filename <- function() {665 paste(""lipidomics set - adapted from Andreyev AY et al 2010"",""csv"",sep=""."")666 },667 668 content <- function(file) {669 file.copy(""data/lipidomics set - adapted from Andreyev AY et al 2010.csv"", file)670 },671 contentType = ""text/csv""672 )673 output$examplePre2 <- downloadHandler(674 filename <- function() {675 paste(""lipidomics set FA incorporation"",""csv"",sep=""."")676 },677 678 content <- function(file) {679 file.copy(""data/lipidomics set FA incorporation.csv"", file)680 },681 contentType = ""text/csv""682 )683 output$examplePre3 <- downloadHandler(684 filename <- function() {685 paste(""lipidomics set membrane fluidity after AA incubation"",""csv"",sep=""."")686 },687 688 content <- function(file) {689 file.copy(""data/lipidomics set membrane fluidity after AA incubation.csv"", file)690 },691 contentType = ""text/csv""692 )693 694 695 observe({696 input$download_network_bs 697 visNetworkProxy(""ontology.plot"") %>% visGetPositions() 698 })699 700 observeEvent(input$exampleB1, {701 updateTextAreaInput(session, ""listwPvalues"", value = pvalueExample1)702 })703 observeEvent(input$exampleB2, {704 updateTextAreaInput(session, ""listwPvalues"", value = pvalueExample2)705 })706 observeEvent(input$exampleB3, {707 updateTextAreaInput(session, ""listwPvalues"", value = pvalueExample3)708 })709 observeEvent(input$plot_click, { ### display term info in console710 termInfo <- dataBlock()$to_ggplot_display$data711 712 713 })714 715 ## examples by sublist716 observeEvent(input$exampleA1, {717 updateTextAreaInput(session, ""sublist"", value = sublist_example1)718 updateTextAreaInput(session, ""background"", value = backgroundlist_example)719 })720 observeEvent(input$exampleA2, {721 updateTextAreaInput(session, ""sublist"", value = sublist_example2)722 updateTextAreaInput(session, ""background"", value = backgroundlist_example)723 })724 observeEvent(input$exampleA3, {725 updateTextAreaInput(session, ""sublist"", value = sublist_example3)726 updateTextAreaInput(session, ""background"", value = backgroundlist_example)727 })728 729 observeEvent(input$submitB, {730 ## first unhide tabs731 732 input_listwPvalues <- input$listwPvalues733 734 if(grepl(""\t"", input_listwPvalues) & 735 grepl(""\n"", input_listwPvalues) &736 grepl(""\\D"",input_listwPvalues) &737 grepl(""\\d"",input_listwPvalues) ){ ## input requirements738 739 #if(input$listwPvalues!=""""){740 showTab(inputId = ""tabs"", target = ""LION input"")741 showTab(inputId = ""tabs"", target = ""LION enrichment table"")742 showTab(inputId = ""tabs"", target = ""LION enrichment graph"")743 showTab(inputId = ""tabs"", target = ""LION network view"") 744 745 dataBlock()746 747 ## goto LION input748 updateTabsetPanel(session, ""tabs"",749 selected = ""LION input"")750 } else {751 752 hideTab(inputId = ""tabs"", target = ""LION input"")753 hideTab(inputId = ""tabs"", target = ""LION enrichment table"")754 hideTab(inputId = ""tabs"", target = ""LION enrichment graph"")755 hideTab(inputId = ""tabs"", target = ""LION network view"") 756 757 updateTabsetPanel(session, ""tabs"",758 selected = ""General information"")759 showNotification(ui = """",760 action = ""No or incorrect input found. Please reformat and submit data in the text box."",761 duration = 3, type = 'error')762 }763 })764 observeEvent(input$submitA, {765 766 input_list <- c(input$sublist, input$background)767 768 if(all(grepl(""\n"", input_list) & grepl(""\\D"",input_list))){ ## input requirements769 770 #if(input$sublist!="""" & input$background!=""""){771 ## first unhide tabs772 showTab(inputId = ""tabs"", target = ""LION input"")773 showTab(inputId = ""tabs"", target = ""LION enrichment table"")774 showTab(inputId = ""tabs"", target = ""LION enrichment graph"")775 showTab(inputId = ""tabs"", target = ""LION network view"") 776 777 dataBlock()778 779 ## goto LION input780 updateTabsetPanel(session, ""tabs"",781 selected = ""LION input"")782 } else {783 784 hideTab(inputId = ""tabs"", target = ""LION input"")785 hideTab(inputId = ""tabs"", target = ""LION enrichment table"")786 hideTab(inputId = ""tabs"", target = ""LION enrichment graph"")787 hideTab(inputId = ""tabs"", target = ""LION network view"") 788 789 updateTabsetPanel(session, ""tabs"",790 selected = ""General information"")791 showNotification(ui = """",792 action = ""No or incorrect input found. Please reformat and submit data in the two text boxes."",793 duration = 3, type = 'error')794 }795 })796 797 798 799 ### enrichment analysis800 dataBlock <- reactive({801 802 errorhandling <- NULL803 804 input$submitB805 input$submitA806 807 input_listwPvalues <- isolate(input$listwPvalues)808 809 ### some lipids contain comma's, so only the last comma should be regarded as a separator810 numericPattern <- unlist(regmatches(input_listwPvalues, gregexpr("", *(\\d|\\.)+(\n|$)"", input_listwPvalues)) ) ## extract patterns to replace last comma811 812 for(p in numericPattern){ ### replace last comma of line to \t; this will be the seperator813 input_listwPvalues <- gsub(p, gsub("","", ""\t"", p), input_listwPvalues)814 }815 816 817 818 #### is input appropriate??819 820 if (isolate(input$sub_method) == ""(ii) analysis"" & input$method == ""Ranking mode"") {821 if(!(grepl(""\t"", input_listwPvalues) & 822 grepl(""\n"", input_listwPvalues) &823 grepl(""\\D"",input_listwPvalues) &824 grepl(""\\d"",input_listwPvalues) )){ ### definition of wrong input825 826 hideTab(inputId = ""tabs"", target = ""LION enrichment table"")827 hideTab(inputId = ""tabs"", target = ""LION enrichment graph"")828 hideTab(inputId = ""tabs"", target = ""LION network view"")829 830 return(NULL)831 }832 }833 834 if (isolate(input$method) == ""Target-list mode"") { 835 if( isolate(input$sublist)=="""" | isolate(input$background) == """"){ ### definition of wrong input836 hideTab(inputId = ""tabs"", target = ""LION enrichment table"")837 hideTab(inputId = ""tabs"", target = ""LION enrichment graph"")838 hideTab(inputId = ""tabs"", target = ""LION network view"")839 840 return(NULL)841 }842 }843 #### 844 845 846 847 if(isolate(input$ranking)==""ascending""){direction <- 1} else {direction <- -1}848 849 ### table 1850 851 withProgress(message = 'progress:', value = 0, {852 incProgress(.1, detail = paste(""mapping input data""))853 if (isolate(input$method) == ""Target-list mode"") {854 if ((is.null(isolate(input$sublist)) ||855 isolate(input$sublist) == """") == FALSE) {856 857 ### new 20191010858 cat(""substracting input target-list \n"")859 860 sublist <- strsplit(isolate(input$sublist), ""\n""); names(sublist) <- ""ID""861 background <- strsplit(isolate(input$background), ""\n""); names(background) <- ""ID""862 863 background = data.frame(ID = c(background$ID, sublist$ID[!sublist$ID %in% background$ID]))864 background$IDnr <- 1:length(background$ID)865 background$input <- paste(sprintf(""[#%04d]"", background$IDnr),background$ID)866 867 sublist$input <-868 do.call(""rbind"",869 sapply(unique(sublist$ID), function(ID_i){870 background[background$ID == ID_i,]871 }, simplify = FALSE))$input872 873 background$input <-874 do.call(""rbind"",875 sapply(unique(background$ID), function(ID_i){876 background[background$ID == ID_i,]877 }, simplify = FALSE))$input878 879 880 lipidExistance <- data.frame(input = background$input )881 cat(""converting input target-list \n"")882 lipidExistance$'simplified input' <- convertLipidNames(gsub(""^\\[#\\d+\\] "","""",lipidExistance$input))883 ### end new 20191010884 885 886 } else {887 lipidExistance <- data.frame(""input"")888 }889 890 }891 892 if (isolate(input$method) == ""Ranking mode"") { ## (isolate(input$sub_method) == ""(ii) analysis"") {893 if ((is.null(input_listwPvalues) ||894 input_listwPvalues == """") == FALSE) {895 896 897 pValueList <- list()898 899 pValueList$input <-900 transpose(strsplit(unlist(strsplit(901 input_listwPvalues, ""\n""902 )), ""[\t\\|]""))[[1]]903 904 pValueList$input <- paste(sprintf(""[#%04d]"", 1:length(pValueList$input)),pValueList$input)905 906 pValueList$pvalues <-907 transpose(strsplit(unlist(strsplit(908 input_listwPvalues, ""\n""909 )), ""[\t\\|]""))[[2]]910 911 if(any(is.null(pValueList$input),is.null(pValueList$pvalues))){912 errorhandling <- ""unexpected input""913 pValueList$input <- NULL914 pValueList$pvalues <- NULL915 }916 917 pValueList <- as.data.frame(pValueList)918 lipidExistance <- data.frame(input = pValueList$input)919 920 lipidExistance$'simplified input' <- convertLipidNames(gsub(""^\\[#\\d+\\] "","""",lipidExistance$input))921 922 923 } else {924 lipidExistance <- data.frame(""input"")925 }926 }927 if (length(lipidExistance$input) < 1) {928 929 } else {930 931 ##### new 20191106932 lipidExistance_list <-933 lapply(1:dim(lipidExistance)[1], function(row_i) {934 935 lipid_i <- lipidExistance[row_i, 2] ## lipid_i is lipid of this iteration936 937 LION_ID <-938 unlist(lipidID2TERM[lipid_i == names(lipidID2TERM)])939 940 if (is.null(LION_ID)) {941 ### if input is LION:xxxx942 LION_ID <-943 unlist(lipidID2TERM[lipid_i == unlist(lipidID2TERM)])944 LION_ID <-945 LION_ID[!grepl(""^SLM:|^LM..\\d+"", names(LION_ID))] ## remove SwissLipids/LIPIDMAPS IDs946 }947 948 if (!is.null(LION_ID)) {949 output_df <-950 data.frame(951 input = lipidExistance[row_i, 1],952 'simplified input' = lipid_i,953 name = names(LION_ID),954 LION = LION_ID,955 match = ""direct""956 )957 } else {958 ### no direct matching is found959 if (isolate(input$SmartMatching)) {960 ### 'smartmatching' is on961 lipid_index <-962 list(963 generalized = simplifyLipidnames(lipid_i),964 headgroup = getLipidHeadgroup(lipid_i),965 linkage = getLipidLinkage(lipid_i),966 FAs = getFAs(lipid_i)967 )968 969 generalized_LION_ID <-970 unlist(lipidID2TERM[lipid_index$generalized == names(lipidID2TERM)])971 if (!is.null(generalized_LION_ID)) {972 terms <-973 data.frame(name = names(lipidID2TERM)[lipid_index$generalized == names(lipidID2TERM)],974 LION = generalized_LION_ID)975 } else {976 ## no generalized lipid found977 LIONterms_rules_i <-978 LIONterms_rules[lipid_index$headgroup == LIONterms_rules$RULE1 ,]979 980 if (all(LIONterms_rules_i$RULE2 == """")) {981 terms <- LIONterms_rules_i[, 1:2]982 } else {983 terms <-984 LIONterms_rules_i[lipid_index$linkage == LIONterms_rules_i$RULE2,][, 1:2]985 }986 }987 988 989 terms <-990 rbind(terms, LIONterms_FAs[LIONterms_FAs$name %in% lipid_index$FAs,])991 if (dim(terms)[1] > 0) {992 output_df <-993 data.frame(input = lipidExistance[row_i, 1],994 'simplified input' = lipid_i,995 terms,996 match = ""smart matching"")997 998 } else {999 ## no match by smart matching1000 output_df <-1001 data.frame(1002 input = lipidExistance[row_i, 1],1003 'simplified input' = lipid_i,1004 name = ""not found"",1005 LION = ""not found"",1006 match = """"1007 )1008 }1009 1010 1011 } else {1012 ### 'smartmatching' is off, and no match found1013 output_df <-1014 data.frame(1015 input = lipidExistance[row_i, 1],1016 'simplified input' = lipid_i,1017 name = ""not found"",1018 LION = ""not found"",1019 match = """"1020 )1021 }1022 1023 1024 }1025 if(isolate(input$FAprediction)){ ## predict FAs if nescerrary1026 1027 lipid_index <-1028 list(1029 generalized = simplifyLipidnames(lipid_i),1030 headgroup = getLipidHeadgroup(lipid_i),1031 FAs = getFAs(lipid_i)1032 )1033 1034 if(lipid_index$generalized == lipid_i & length(lipid_index$FAs) == 1){ ## is FA prediction applicable?1035 1036 predicted_FAs <- predict_FAs(headgroup = lipid_index$headgroup, 1037 summedFA = gsub(""C"","""",lipid_index$FAs), 1038 composition_table = FA_composition_table )1039 1040 if(dim(LIONterms_FAs[LIONterms_FAs$name %in% predicted_FAs,])[1]>0){ ## any result?1041 output_df <-1042 rbind(output_df,1043 data.frame(input = lipidExistance[row_i, 1],1044 'simplified input' = lipid_i,1045 LIONterms_FAs[LIONterms_FAs$name %in% predicted_FAs,],1046 match = ""FA-prediction""))1047 } 1048 1049 1050 }1051 1052 1053 }1054 1055 return(output_df)1056 })1057 1058 matching_statistics <- data.frame(total = length(sapply(lipidExistance_list, function(lipid_i){!any(lipid_i$LION == ""not found"")})),1059 matched = sum(sapply(lipidExistance_list, function(lipid_i){!any(lipid_i$LION == ""not found"")})),1060 percent = mean(sapply(lipidExistance_list, function(lipid_i){!any(lipid_i$LION == ""not found"")}) ) * 100)1061 1062 1063 lipidExistance <- do.call(""rbind"",lipidExistance_list)1064 1065 colnames(lipidExistance) <- c('input','simplified input','LION name','LION ID', ""match"")1066 1067 1068 color_df <- data.frame(match = c(""direct"",""smart matching"", ""FA-prediction"",""""),1069 color = c(""#4f4d4d"",""#9c3c2d"",""#c4942b"",""#bdbbbf""))1070 1071 lipidExistance_toview <-1072 do.call(""rbind"", lapply(lipidExistance_list, function(lipidExistance_i) {1073 color_pattern <- color_df$color[match(lipidExistance_i$match, color_df$match)]1074 1075 data.frame(1076 input = unique(lipidExistance_i$input),1077 name = paste(""<font color='"",color_pattern,""'>"",lipidExistance_i$name,""</font>"" , sep ="""", collapse = ""<br>""),1078 #LION = paste(""<font color='"",color_pattern,""'>"",lipidExistance_i$LION,""</font>"" , sep ="""", collapse = ""<br>"")1079 LION = paste(""<a href='"",1080 'https://bioportal.bioontology.org/ontologies/LION/?p=classes&conceptid=http%3A%2F%2Fpurl.obolibrary.org%2Fobo%2F',1081 gsub("":"",""_"",lipidExistance_i$LION),1082 ""' style='color: "", color_pattern,1083 ""' target='_blank'>"",1084 lipidExistance_i$LION,1085 ""</a>"",1086 sep = """", collapse = ""<br>"")1087 1088 1089 )1090 }))1091 1092 1093 colnames(lipidExistance_toview) <- c('input','LION name','LION ID')1094 1095 lipidExistance_toview[[3]] <- gsub("" href=.+Fnot found'"","""",lipidExistance_toview[[3]])1096 1097 ##### end new 201910061098 1099 lipidExistance$'simplified input' <- NULL ## remove this column, not interesting for user1100 1101 1102 ## use matched lipids as assocation table 1103 1104 lipidExistance_feasable <- lipidExistance[lipidExistance$`LION ID` != ""not found"",]1105 1106 matched_lipidID2TERM <- 1107 sapply(unique(lipidExistance_feasable$input), function(input){1108 lipidExistance_feasable$`LION ID`[lipidExistance_feasable$input == input]1109 }, simplify = FALSE)1110 1111 1112 }1113 1114 })1115 1116 1117 if (!any(dim(lipidExistance) == c(1, 1))) {1118 ### perform when there is input (dim 1 by 1 >> no input)1119 1120 withProgress(message = 'progress:', value = 0, {1121 # Generate an HTML table view of the ontology data1122 1123 incProgress(.5, detail = paste(""submitting data""))1124 1125 if (isolate(input$method) == ""Target-list mode"") {1126 if ((is.null(isolate(input$sublist)) ||1127 isolate(input$sublist) == """") == FALSE) {1128 1129 1130 lipidIDs <-1131 list(sublist = sublist$input, #unlist(strsplit(isolate(input$sublist), ""\n"")),1132 backgroundlist = background$input #unlist(strsplit(isolate(input$background), ""\n"")) 1133 )1134 1135 1136 lipidIDlogical <-1137 factor(as.integer(lipidIDs$backgroundlist %in% lipidIDs$sublist), levels = c(0,1))1138 names(lipidIDlogical) <- lipidIDs$backgroundlist1139 1140 if( any(names(lipidIDlogical) %in% names(matched_lipidID2TERM)) &1141 sum(lipidIDlogical==""1"") > 1 ){ ### can at least one lipid be matched?1142 ONTdata <- new(1143 ""topONTdata"",1144 ontology = ""LION"",1145 allGenes = lipidIDlogical,1146 annot = annFUN.gene2GO,1147 gene2GO = matched_lipidID2TERM) 1148 } else {1149 1150 names(lipidIDlogical)[1] <- ""PC(38:1)"" ### make a fake object1151 levels(lipidIDlogical) <- c(levels(lipidIDlogical),""1"")1152 lipidIDlogical[1] <- ""1""1153 1154 ONTdata <- new(1155 ""topONTdata"",1156 ontology = ""LION"",1157 allGenes = lipidIDlogical,1158 annot = annFUN.gene2GO,1159 gene2GO = lipidID2TERM)1160 }1161 1162 1163 resultFis <-1164 runTest(ONTdata,1165 algorithm = ""classic"",1166 statistic = ""fisher"")1167 1168 1169 1170 to_display <-1171 GenTable(ONTdata,1172 'p-value' = resultFis,1173 topNodes = 2000)1174 1175 to_display <-1176 to_display[grep(""LION"", to_display$TERM.ID), ]1177 1178 LUT <- data.frame(ID = names(ONTdata@termName),1179 Discription = ONTdata@termName)1180 1181 to_display$Term <- LUT$Discription[match(to_display$TERM.ID, LUT$ID)] 1182 to_display <- to_display[to_display$Annotated > 2, ] ### remove terms with 1 or 2 lipids1183 1184 #### limiting by LION-term selection1185 if(isolate(input$LIONselection)){ ### switch for LION-selection1186 TermsOfInterest <- get_selected(isolate(input$tree), format = ""names"") 1187 TermsOfInterest <- unique(c(unlist(TermsOfInterest),1188 unlist(sapply(TermsOfInterest, function(element){attr(element,""ancestry"")}))1189 )) ## vector with LION-names1190 to_display <- to_display[to_display$Term %in% TermsOfInterest,] 1191 }1192 1193 ## limiting redundant/similar parent terms1194 1195 if(isolate(input$RemoveRedundantTerms)){ ### switch for LION-selection1196 ONT_DAG <- ONTdata@graph1197 ONT_DAG_lev <- buildLevels(ONT_DAG)1198 DAG.env <- ONT_DAG_lev$nodes2level1199 1200 DAGlevel <- sapply(to_display$TERM.ID, function(id) {