###################################################
### chunk number 1: setup
###################################################
#line 25 "S4Overview-slides.Rnw"
options(width = 60)


###################################################
### chunk number 2: setClass
###################################################
#line 374 "S4Overview-slides.Rnw"
setClass("SNPLocations",
    representation(
      genome="character",  # a single string
      snpid="character",   # a character vector of length N
      chrom="character",   # a character vector of length N
      pos="integer"        # an integer vector of length N
    )
)


###################################################
### chunk number 3: SNPLocations
###################################################
#line 389 "S4Overview-slides.Rnw"
SNPLocations <- function(genome, snpid, chrom, pos)
    new("SNPLocations", genome=genome, snpid=snpid, chrom=chrom, pos=pos)


###################################################
### chunk number 4: test_SNPLocations
###################################################
#line 393 "S4Overview-slides.Rnw"
snplocs <- SNPLocations("hg19",
             c("rs0001", "rs0002"),
             c("chr1", "chrX"),
             c(224033L, 1266886L))


###################################################
### chunk number 5: length
###################################################
#line 407 "S4Overview-slides.Rnw"
setMethod("length", "SNPLocations", function(x) length(x@snpid))


###################################################
### chunk number 6: test_length
###################################################
#line 410 "S4Overview-slides.Rnw"
length(snplocs)  # just testing


###################################################
### chunk number 7: genome
###################################################
#line 418 "S4Overview-slides.Rnw"
setGeneric("genome", function(x) standardGeneric("genome"))
setMethod("genome", "SNPLocations", function(x) x@genome)


###################################################
### chunk number 8: snpid
###################################################
#line 422 "S4Overview-slides.Rnw"
setGeneric("snpid", function(x) standardGeneric("snpid"))
setMethod("snpid", "SNPLocations", function(x) x@snpid)


###################################################
### chunk number 9: chrom
###################################################
#line 426 "S4Overview-slides.Rnw"
setGeneric("chrom", function(x) standardGeneric("chrom"))
setMethod("chrom", "SNPLocations", function(x) x@chrom)


###################################################
### chunk number 10: pos
###################################################
#line 430 "S4Overview-slides.Rnw"
setGeneric("pos", function(x) standardGeneric("pos"))
setMethod("pos", "SNPLocations", function(x) x@pos)


###################################################
### chunk number 11: test_slot_getters
###################################################
#line 434 "S4Overview-slides.Rnw"
genome(snplocs)  # just testing
snpid(snplocs)   # just testing


###################################################
### chunk number 12: show
###################################################
#line 446 "S4Overview-slides.Rnw"
setMethod("show", "SNPLocations",
    function(object)
        cat(class(object), "instance with", length(object),
            "SNPs on genome", genome(object), "\n")
)


###################################################
### chunk number 13: 
###################################################
#line 453 "S4Overview-slides.Rnw"
snplocs  # just testing


###################################################
### chunk number 14: validity
###################################################
#line 461 "S4Overview-slides.Rnw"
setValidity("SNPLocations",
    function(object) {
        if (!is.character(genome(object)) ||
            length(genome(object)) != 1 || is.na(genome(object)))
            return("'genome' slot must be a single string")
        slot_lengths <- c(length(snpid(object)),
                          length(chrom(object)),
                          length(pos(object)))
        if (length(unique(slot_lengths)) != 1)
            return("lengths of slots 'snpid', 'chrom' and 'pos' differ")
        TRUE
    }
)


###################################################
### chunk number 15: set_chrom
###################################################
#line 495 "S4Overview-slides.Rnw"
setGeneric("chrom<-", function(x, value) standardGeneric("chrom<-"))
setReplaceMethod("chrom", "SNPLocations",
    function(x, value) {x@chrom <- value; validObject(x); x})


###################################################
### chunk number 16: test_slot_setters
###################################################
#line 500 "S4Overview-slides.Rnw"
chrom(snplocs) <- LETTERS[1:2]  # repair currently broken object


###################################################
### chunk number 17: setAs
###################################################
#line 518 "S4Overview-slides.Rnw"
setAs("SNPLocations", "data.frame",
    function(from)
        data.frame(snpid=snpid(from), chrom=chrom(from), pos=pos(from))
)


###################################################
### chunk number 18: test_coercion
###################################################
#line 524 "S4Overview-slides.Rnw"
as(snplocs, "data.frame")  # testing


###################################################
### chunk number 19: AnnotatedSNPs
###################################################
#line 542 "S4Overview-slides.Rnw"
setClass("AnnotatedSNPs",
    contains="SNPLocations",
    representation(
        geneid="character"  # a character vector of length N
    )
)


###################################################
### chunk number 20: slot_inheritance
###################################################
#line 553 "S4Overview-slides.Rnw"
showClass("AnnotatedSNPs")


###################################################
### chunk number 21: AnnotatedSNPs
###################################################
#line 559 "S4Overview-slides.Rnw"
AnnotatedSNPs <- function(genome, snpid, chrom, pos, geneid)
{
    new("AnnotatedSNPs",
        SNPLocations(genome, snpid, chrom, pos),
        geneid=geneid)
}


###################################################
### chunk number 22: method_inheritance
###################################################
#line 576 "S4Overview-slides.Rnw"
snps <- AnnotatedSNPs("hg19",
             c("rs0001", "rs0002"),
             c("chr1", "chrX"),
             c(224033L, 1266886L),
             c("AAU1", "SXW-23"))


###################################################
### chunk number 23: method_inheritance
###################################################
#line 587 "S4Overview-slides.Rnw"
snps


###################################################
### chunk number 24: as_data_frame_is_not_right
###################################################
#line 593 "S4Overview-slides.Rnw"
as(snps, "data.frame")  # the 'geneid' slot is ignored


###################################################
### chunk number 25: 
###################################################
#line 606 "S4Overview-slides.Rnw"
is(snps, "AnnotatedSNPs")     # 'snps' is an AnnotatedSNPs object
is(snps, "SNPLocations")      # and is also a SNPLocations object
class(snps)                   # but is *not* a SNPLocations *instance*


###################################################
### chunk number 26: automatic_coercion_method
###################################################
#line 619 "S4Overview-slides.Rnw"
as(snps, "SNPLocations")


###################################################
### chunk number 27: incremental_validity_method
###################################################
#line 633 "S4Overview-slides.Rnw"
setValidity("AnnotatedSNPs",
    function(object) {
        if (length(object@geneid) != length(object))
            return("'geneid' slot must have the length of the object")
        TRUE
    }
)