################################################### ### 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 } )