## ----prelim-------------------------------------------------------------------
library(beadarrayExampleData)
library(beadarray)
data(exampleBLData)

## ----eval=FALSE---------------------------------------------------------------
# BLData = readIllumina(useImages=FALSE, illuminaAnnotation = "Humanv3")

## -----------------------------------------------------------------------------
suggestAnnotation(exampleBLData,verbose=TRUE)
annotation(exampleBLData) <-"Humanv3"


## -----------------------------------------------------------------------------
class(exampleBLData)
slotNames(exampleBLData)

##Get the beadData for array-section 1
exampleBLData[[1]][1:10,]

##Alternative using accessor function
getBeadData(exampleBLData, array=1, what="Grn")[1:10]

##Get unique ProbeIDs. These are the ArrayAddressIDs
uIDs = unique(getBeadData(exampleBLData, array=1, what="ProbeID"))
uIDs[1:10]

## -----------------------------------------------------------------------------
metrics(exampleBLData)

p95(exampleBLData, "Grn")

snr(exampleBLData, "Grn")



## -----------------------------------------------------------------------------
log2(exampleBLData[[1]][1:10,2])

logGreenChannelTransform

logGreenChannelTransform(exampleBLData, array=1)[1:10]

logRedChannelTransform

## -----------------------------------------------------------------------------
imageplot(exampleBLData, array=1, low="lightgreen", high="darkgreen")


## -----------------------------------------------------------------------------
imageplot(exampleBLData, array=2, low="lightgreen", high="darkgreen")


## ----eval=FALSE---------------------------------------------------------------
# bsh = BASH(exampleBLData, array=1)

## ----eval=FALSE---------------------------------------------------------------
# for(i in 1:2){
# 
# 	BLData <- setWeights(exampleBLData, wts=bsh$wts[[i]], array=i)
# 
# }
# 
# BLData <- insertSectionData(exampleBLData, what="BASHQC", data = bsh$QC)
# 

## ----eval=FALSE---------------------------------------------------------------
# table(getBeadData(exampleBLData, array=1, what="wts"))
# table(getBeadData(exampleBLData, array=2, what="wts"))
# 

## ----eval=FALSE---------------------------------------------------------------
# showArrayMask(exampleBLData, array=2)

## -----------------------------------------------------------------------------
p <- combinedControlPlot(exampleBLData)


## ----echo=FALSE---------------------------------------------------------------
if(!is.null(p)){ 
p 
} else plot(1:10,type="n",axes=F, )



## -----------------------------------------------------------------------------
BSData <- summarize(exampleBLData)


## ----eval=FALSE---------------------------------------------------------------
# myMedian <- function(x) median(x, na.rm=TRUE)
# myMad <- function(x) mad(x, na.rm=TRUE)
# 
# greenChannel2 <- new("illuminaChannel", greenChannelTransform, illuminaOutlierMethod,
# myMedian, myMad,"G")
# 
# BSData2 <- summarize(exampleBLData, list(greenChannel2))
# 

## -----------------------------------------------------------------------------
BSData


## -----------------------------------------------------------------------------
det = calculateDetection(BSData)

head(det)

Detection(BSData) <- det