RPPA-R-code/JSON.R at master · mlist/RPPA-R-code · 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
rppa.load <- function (barcode=NA, slideIndex=NA, baseUrl = "http://localhost:8080/MIRACLE/spotExport/", filter.bad.signals=T, apply.shifts=T)
{
  require(RJSONIO)
  require(plyr)

  #check input
  if(is.na(slideIndex) && is.na(barcode)){
    cat("You have to specify either barcode or slideIndex")
    return(NA)
  }

  else if(is.na(slideIndex))
  {
    slideIndex <- scan(paste(baseUrl, "getIdFromBarcode/",
                             barcode, sep = ""), what = "integer")
    cat(paste("Barcode", barcode, "was identified as slide index", slideIndex, "\n"), sep=" ")
  }

  #read the data from database
  cat(paste("Reading spots for slide index", slideIndex, "\n"))
  spots <- ldply(fromJSON(paste(baseUrl, "exportAsJSON/", slideIndex,
                                sep = ""), simplify = T, nullValue = "NA"))
  cat(paste(dim(spots)[1], "spots read. Formatting...\n"))

  #replace "NA" with proper NA
  replace.na <- colwise(function(col) { col[col=="NA"] <- NA; return(col) })
  spots <- replace.na(spots)

  #reformat column types
  spots$FG <- as.double(spots$FG)
  spots$BG <- as.double(spots$BG)
  spots$Signal <- as.double(spots$Signal)
  spots$Diameter <- as.double(spots$Diameter)
  spots$Flag <- as.double(spots$Flag)
  spots$Block <- as.integer(spots$Block)
  spots$Row <- as.integer(spots$Row)
  spots$Column <- as.integer(spots$Column)
  spots$CellLine <- as.factor(spots$CellLine)
  spots$Treatment <- as.factor(spots$Treatment)
  spots$Inducer <- as.factor(spots$Inducer)
  spots$LysisBuffer <- as.factor(spots$LysisBuffer)
  spots$SampleName <- as.factor(spots$SampleName)
  spots$SampleType <- as.factor(spots$SampleType)
  spots$TargetGene <- as.factor(spots$TargetGene)
  spots$DilutionFactor <- as.double(spots$DilutionFactor)
  spots$PlateCol <- as.integer(spots$PlateCol)
  spots$PlateRow <- as.integer(spots$PlateRow)
  spots$PlateLayout <- as.integer(spots$PlateLayout)

  #add shifts
  if (length(fromJSON(paste(baseUrl, "exportShiftsAsJSON/",
                            slideIndex, sep = ""))) > 0) {
    shifts <- ldply(fromJSON(paste(baseUrl, "exportShiftsAsJSON/",
                                   slideIndex, sep = ""), simplify = T, nullValue = NA))
    spots <- merge(spots, shifts, by = "Block", all.x = T)
  }
  else{
    spots$vshift <- 0
    spots$hshift <- 0
  }
  #apply shifts
  spots <- rppa.vshift(spots)
  spots <- rppa.hshift(spots)

  #add depositions
  depositionPattern <- scan(paste(baseUrl, "getDepositionPattern/",
                                  slideIndex, sep = ""), what = "integer")
  depositionPattern <- gsub("\\[", "", depositionPattern)
  depositionPattern <- gsub("\\]", "", depositionPattern)
  depositionPattern <- as.integer(strsplit(depositionPattern,
                                           ",")[[1]])
  spots$Deposition <- spots$Column%%length(depositionPattern)
  spots$Deposition[spots$Deposition == 0] <- length(depositionPattern)
  spots$Deposition <- depositionPattern[spots$Deposition]

  #filter bad signals
  if(filter.bad.signals)
  {
    spots <- rppa.filter.diameter(spots)
    spots <- rppa.filter.flagged(spots)
    spots <- rppa.filter.neg.values(spots)
  }

  spots <- rppa.set.blocksPerRow(spots, as.integer(scan(paste(baseUrl, "getBlocksPerRow/",
                                                   slideIndex, sep = ""), what = "integer")))
  spots <- rppa.set.title(spots, paste(scan(paste(baseUrl, "getTitle/",
                                                   slideIndex, sep = ""), what = "character"), collapse=" "))
  spots <- rppa.set.antibody(spots, paste(scan(paste(baseUrl, "getAntibody/",
                                                   slideIndex, sep = ""), what = "character"), collapse=" "))
  cat("...done")
  return(spots)
}

rppa.filter.diameter <- function(spots)
{
  spots$Diameter <- as.double(spots$Diameter)
  spots$Signal[spots$Diameter >= 250] <- NA
  return(spots)
}

rppa.filter.neg.values <- function(spots)
{
  spots$FG <- as.double(spots$FG)
  spots$BG <- as.double(spots$BG)
  spots$Signal[(spots$FG-spots$BG <= 0)] <- NA
  return(spots)
}

rppa.filter.flagged <- function(spots)
{
  spots$Flag <- as.double(spots$Flag)
  spots$Signal[spots$Flag != 0] <- NA
  return(spots)
}