Fixed bug in getTissueType; updated unit test

Author: katehoffshutta

R/NetworkDataCompanion.R

@@ -547,20 +547,22 @@ NetworkDataCompanion=setRefClass("NetworkDataCompanion",
            },
 
            # return tissue type given an input barcode
-	         getTissueType = function(TCGA_barcode)
+	         getTissueType = function(TCGA_barcodes)
            {
-             this_sample = substr(str_split(TCGA_barcode,"-",simplify=T)[1,4],1,2)
-             if(!this_sample%in% sample_type_mapping$numcode)
+             these_samples = extractSampleType(TCGA_barcodes) 
+             if(length(setdiff(these_samples,sample_type_mapping$numcode)>0))
              {
-               print(paste("[NetworkDataCompanion::getTissueType()] Error: unknown sample type:",this_sample))
-               return(NA)
+               print(paste("[NetworkDataCompanion::getTissueType()] Error: unknown sample type(s):",setdiff(these_samples,sample_type_mapping$numcode)))
+               return(NULL)
              }
 
-             this_map = data.frame("TCGA_barcode"=TCGA_barcode)
-             row.names(this_map) = TCGA_barcode
-             this_match = sample_type_mapping[which(as.numeric(sample_type_mapping$numcode) == as.numeric(this_sample)),]
-
-             return(cbind.data.frame(this_map,this_match))
+             this_map = data.frame("TCGA_barcode" = TCGA_barcodes,
+                                   "numcode" = these_samples,
+                                   row.names = TCGA_barcodes)
+             
+             out_map = this_map %>% left_join(sample_type_mapping, by="numcode") %>%
+               dplyr::select("TCGA_barcode","description")
+             return(out_map)
            },
            ## access sample type map
 	         getSampleTypeMap = function(){

tests/testthat/test_getTissueType.R

@@ -1,59 +1,89 @@
 context("[NetworkDataCompanion] Testing getTissueType function ... ")
 
-test_that("Testing getTissueType",{
+numcodes <- c(
+  "01",
+  "02",
+  "03",
+  "04",
+  "05",
+  "06",
+  "07",
+  "08",
+  "09",
+  "10",
+  "11",
+  "12",
+  "13",
+  "14",
+  "15",
+  "16",
+  "20",
+  "40",
+  "50",
+  "60",
+  "61",
+  "99"
+)
+
+descriptions <- c(
+  "Primary Solid Tumor",
+  "Recurrent Solid Tumor",
+  "Primary Blood Derived Cancer - Peripheral Blood",
+  "Recurrent Blood Derived Cancer - Bone Marrow",
+  "Additional - New Primary",
+  "Metastatic",
+  "Additional Metastatic",
+  "Human Tumor Original Cells",
+  "Primary Blood Derived Cancer - Bone Marrow",
+  "Blood Derived Normal",
+  "Solid Tissue Normal",
+  "Buccal Cell Normal",
+  "EBV Immortalized Normal",
+  "Bone Marrow Normal",
+  "sample type 15",
+  "sample type 16",
+  "Control Analyte",
+  "Recurrent Blood Derived Cancer - Peripheral Blood",
+  "Cell Lines",
+  "Primary Xenograft Tissue",
+  "Cell Line Derived Xenograft Tissue",
+  "sample type 99"
+)
+my_friend = NetworkDataCompanion::CreateNetworkDataCompanionObject()
+
+test_that("Testing getTissueType for a single TCGA barcode",{
 
-  my_friend = NetworkDataCompanion::CreateNetworkDataCompanionObject()
-  numcodes <- c(
-                "01",
-                "02",
-                "03",
-                "04",
-                "05",
-                "06",
-                "07",
-                "08",
-                "09",
-                "10",
-                "11",
-                "12",
-                "13",
-                "14",
-                "15",
-                "16",
-                "20",
-                "40",
-                "50",
-                "60",
-                "61",
-                "99"
-              )
-  descriptions <- c(
-                  "Primary Solid Tumor",
-                  "Recurrent Solid Tumor",
-                  "Primary Blood Derived Cancer - Peripheral Blood",
-                  "Recurrent Blood Derived Cancer - Bone Marrow",
-                  "Additional - New Primary",
-                  "Metastatic",
-                  "Additional Metastatic",
-                  "Human Tumor Original Cells",
-                  "Primary Blood Derived Cancer - Bone Marrow",
-                  "Blood Derived Normal",
-                  "Solid Tissue Normal",
-                  "Buccal Cell Normal",
-                  "EBV Immortalized Normal",
-                  "Bone Marrow Normal",
-                  "sample type 15",
-                  "sample type 16",
-                  "Control Analyte",
-                  "Recurrent Blood Derived Cancer - Peripheral Blood",
-                  "Cell Lines",
-                  "Primary Xenograft Tissue",
-                  "Cell Line Derived Xenograft Tissue",
-                  "sample type 99"
-                )
   barcode = "TCGA-A1-1234-"
   for(numcode in numcodes){
    expect_equal(as.character(my_friend$getTissueType(paste0(barcode, numcode))['description']), descriptions[numcodes == numcode])
   }
-  expect_true(is.na(as.character(my_friend$getTissueType(paste0(barcode, "53"))['description'])))
+  expect_true(is.null(my_friend$getTissueType(paste0(barcode, "53"))))
+})
+
+test_that("Testing getTissueType vectorizes properly",{
+  
+  barcode1 = "TCGA-A1-1234-01A"
+  barcode2 = "TCGA-A1-1234-10A"
+  barcode3 = "TCGA-A1-1234-10B"
+  barcode4 = "TCGA-A1-1234-02A"
+  barcodes = c(barcode1,
+               barcode2,
+               barcode3,
+               barcode4)
+  
+  expect_equal(my_friend$getTissueType(c(barcode1,
+                                         barcode2,
+                                         barcode3,
+                                         barcode4))$description,
+                                       c(descriptions[1],
+                                         descriptions[10],
+                                         descriptions[10],
+                                         descriptions[2]))
+})
+
+test_that("Testing getTissueType is not bamboozled by extra suffix items",{
+  
+  barcode = "TCGA-A1-1234-01A-1989"
+  expect_equal(my_friend$getTissueType(barcode)$description,descriptions[1])
+  
 })