.packageName <- "lodplot"
"chromosome.viewlinkage" <-
function(x, chrom, statistic="lod", 
                            pheno.names=NULL, 
                            min.stat=0, max.stat=4, 
                            col=1:6, lwd=2, lty=1, 
                            hpos=0.85, width=0.05, 
                            chromname.cex=1.5,   
                            units="cM", bands="major", xticdist=50,
                            show.y.axis=FALSE, new=FALSE, ...) {
# chromosome
  require(grid)
  data(chrom.bands)
  if (new) grid.newpage()
  chromdata<-subset(chrom.bands, chrom.bands$chr==chrom)
  if (nrow(chromdata)==0) stop(paste("No band data for chromosome ",chrom,"!",sep=""))
  lc<-nchar(chromdata$band)
  sel<-!(substr(chromdata$band,lc,lc) %in% letters)
  if (bands!="major") sel<-!sel
  chromdata<-chromdata[sel,]
  rm(lc,sel)
  bandcol<-gray(c(0.4,0.6,0.8,0.8,0.85))[match(chromdata$stain, 
                                          c("acen","gneg", "gpos", "gvar", "stalk"))]
  n<-nrow(chromdata)
  centromere<-which(chromdata$arm[-n]!=chromdata$arm[-1])
  idx<-c(2:(centromere-1), (centromere+2):(n-1))
  pushViewport(viewport(xscale=c(chromdata$cM.top[1]-5,chromdata$cM.bot[n]+5), 
                        yscale=c(0,1),
                        clip="on"))
  grid.rect(x=chromdata$cM.top[idx],y=hpos,
            width=chromdata$cM.bot[idx]-chromdata$cM.top[idx],
            height=width,
            just=c("left","top"),
            default.units="native", gp=gpar(fill=bandcol[idx]))
  grid.semicircle(chromdata$cM.bot[1], hpos-width, width,
                  chromdata$cM.bot[1]-chromdata$cM.top[1], 2, col=bandcol[1])
  grid.semicircle(chromdata$cM.top[n], hpos-width, width, 
                  chromdata$cM.bot[n]-chromdata$cM.top[n], 4, col=bandcol[n])
  grid.semicircle(chromdata$cM.top[centromere], hpos-width, width,
                  chromdata$cM.bot[centromere]-chromdata$cM.top[centromere], 
                  4, col=bandcol[centromere])
  grid.semicircle(chromdata$cM.bot[centromere+1], hpos-width, width, 
                  chromdata$cM.bot[centromere+1]-chromdata$cM.top[centromere+1], 
                  2, col=bandcol[centromere+1])
  grid.points(unit(chromdata$cM.bot[centromere],"native"), 
              unit(hpos-0.5*width,"native"),
              size=unit(1.5,"char"), pch=20, gp=gpar(col="white"))
  grid.points(unit(chromdata$cM.bot[centromere],"native"), 
              unit(hpos-0.5*width,"native"),
              size=unit(0.5,"char"), pch=20, gp=gpar(col="black"))
  grid.text(chrom,
            unit(0.5,"npc"),
            unit(hpos+2*width,"native"), gp=gpar(cex=chromname.cex))
# stat curve
  pos<-x$pos[x$chr %in% chrom]
  stat<-x[x$chr %in% chrom, statistic]
  hi.stat<-max(unlist(c(max.stat,stat)),na.rm=TRUE)
  if (sum(x$chr %in% chrom)>0) {
    pushViewport(viewport(x=unit(0,"native") ,y=unit(1,"lines"),
                          width=unit(max(pos, na.rm=TRUE),"native"),
                          height=unit(0.95, "npc"),
                          just=c("left","bottom"), 
                          xscale=c(0,max(pos,na.rm=TRUE)), 
                          yscale=c(min.stat,hi.stat),
                          clip="off"))
    grid.rect()
    if (is.vector(stat)) {
      grid.lines(pos, stat, default.units="native", 
      gp=gpar(col=col, lwd=lwd, lty=lty, ...))
    }else{
      if (length(col)<ncol(stat)) {
        col <- rep(col, length.out = ncol(stat))
      }
      if (length(lty)<ncol(stat)) {
        lty <- rep(lty, length.out = ncol(stat))
      }
      for(j in 1:ncol(stat)) {
        grid.lines(pos,stat[,j], default.units="native", 
        gp=gpar(col=col[j], lwd=lwd, lty=lty[j], ...))
      }
    }
    yticks <- seq(min.stat, max.stat,1)
    my.xtics(at=seq(0,max(pos,na.rm=TRUE),xticdist),length=0.25)
    grid.grill(h=yticks, v=0, default.units="native",gp=gpar(lty=3))
    if (show.y.axis || new) {
      grid.text(yticks,
              unit(rep(0.0,4),"npc")-unit(rep(0.5,4),"lines"),
              unit(0:3,"native"), gp=gpar(cex=0.75))
    }
    popViewport()
  }
  popViewport()
}

"chromosome.viewsequence" <-
function(x, chrom, statistic="lod", 
                            pheno.names=NULL, 
                            min.stat=0, max.stat=4, 
                            col=1:6, lwd=2, lty=1, 
                            hpos=0.85, width=0.05, 
                            chromname.cex=1.5,   
                            units="bp", bands="major", xticdist=5e7,
                            show.y.axis=FALSE, new=FALSE, ...) {
# chromosome
  require(grid)
  data(chrom.bands)
  if (new) grid.newpage()
  chromdata<-subset(chrom.bands, chrom.bands$chr==chrom)
  if (nrow(chromdata)==0) stop(paste("No band data for chromosome ",chrom,"!",sep=""))
  lc<-nchar(chromdata$band)
  sel<-!(substr(chromdata$band,lc,lc) %in% letters)
  if (bands!="major") sel<-!sel
  chromdata<-chromdata[sel,]
  rm(lc,sel)
  bandcol<-gray(c(0.4,0.6,0.8,0.8,0.85))[match(chromdata$stain, 
                                          c("acen","gneg", "gpos", "gvar", "stalk"))]
  n<-nrow(chromdata)
  centromere<-which(chromdata$arm[-n]!=chromdata$arm[-1])
  idx<-c(2:(centromere-1), (centromere+2):(n-1))
  pushViewport(viewport(xscale=c(chromdata$bases.top[1]-5,chromdata$bases.bot[n]+5), 
                        yscale=c(0,1),
                        clip="on"))
  grid.rect(x=chromdata$bases.top[idx],y=hpos,
            width=chromdata$bases.bot[idx]-chromdata$bases.top[idx],
            height=width,
            just=c("left","top"),
            default.units="native", gp=gpar(fill=bandcol[idx]))
  grid.semicircle(chromdata$bases.bot[1], hpos-width, width,
                  chromdata$bases.bot[1]-chromdata$bases.top[1], 2, col=bandcol[1])
  grid.semicircle(chromdata$bases.top[n], hpos-width, width, 
                  chromdata$bases.bot[n]-chromdata$bases.top[n], 4, col=bandcol[n])
  grid.semicircle(chromdata$bases.top[centromere], hpos-width, width,
                  chromdata$bases.bot[centromere]-chromdata$bases.top[centromere], 
                  4, col=bandcol[centromere])
  grid.semicircle(chromdata$bases.bot[centromere+1], hpos-width, width, 
                  chromdata$bases.bot[centromere+1]-chromdata$bases.top[centromere+1], 
                  2, col=bandcol[centromere+1])
  grid.points(unit(chromdata$bases.bot[centromere],"native"), 
              unit(hpos-0.5*width,"native"),
              size=unit(1.5,"char"), pch=20, gp=gpar(col="white"))
  grid.points(unit(chromdata$bases.bot[centromere],"native"), 
              unit(hpos-0.5*width,"native"),
              size=unit(0.5,"char"), pch=20, gp=gpar(col="black"))
  grid.text(chrom,
            unit(0.5,"npc"),
            unit(hpos+2*width,"native"), gp=gpar(cex=chromname.cex))
# stat curve
  pos<-x$pos[x$chr %in% chrom]
  stat<-x[x$chr %in% chrom, statistic]
  hi.stat<-max(unlist(c(max.stat,stat)),na.rm=TRUE)
  if (sum(x$chr %in% chrom)>0) {
    pushViewport(viewport(x=unit(0,"native") ,y=unit(1,"lines"),
                          width=unit(max(pos, na.rm=TRUE),"native"),
                          height=unit(0.95, "npc"),
                          just=c("left","bottom"), 
                          xscale=c(0,max(pos,na.rm=TRUE)), 
                          yscale=c(min.stat,hi.stat),
                          clip="off"))
    grid.rect()
    if (is.vector(stat)) {
      grid.lines(pos, stat, default.units="native", 
      gp=gpar(col=col, lwd=lwd, lty=lty, ...))
    }else{
      if (length(col)<ncol(stat)) {
        col <- rep(col, length.out = ncol(stat))
      }
      if (length(lty)<ncol(stat)) {
        lty <- rep(lty, length.out = ncol(stat))
      }
      for(j in 1:ncol(stat)) {
        grid.lines(pos,stat[,j], default.units="native", 
        gp=gpar(col=col[j], lwd=lwd, lty=lty[j], ...))
      }
    }
    yticks <- seq(min.stat, max.stat,1)
    my.xtics(at=seq(0,max(pos,na.rm=TRUE),xticdist),length=0.25)
    grid.grill(h=yticks, v=0, 
               default.units="native",gp=gpar(lty=3))
    if (show.y.axis || new) {
      grid.text(yticks,
              unit(rep(0.0,4),"npc")-unit(rep(0.5,4),"lines"),
              unit(0:3,"native"), gp=gpar(cex=0.75))
    }
    popViewport()
  }
  popViewport()
}

"grid.semicircle" <-
function(base.x, base.y, base.length,
                            height=base.length, side=1, 
                            orientation=NULL, col=NULL) {
  radius<-base.length/2
  x<-radius*seq(-1,1,length=40)
  y<-height/radius*sqrt(radius^2-x^2)
  if (is.null(orientation)) {
    co<-as.integer(cos(pi*(3-side)/2))
    so<-as.integer(sin(pi*(3-side)/2))
  }else{
    co<-cos(orientation)
    so<-sin(orientation)
  }
  tx<-co*x - so*y 
  ty<-so*x + co*y
  if (is.null(orientation)) {
    if (side==1 || side==3) {
      base.x<-base.x+radius
    }else if (side==2 || side==4) {
      base.y<-base.y+radius
    }
  }
  x<-base.x+tx
  y<-base.y+ty
  grid.polygon(x,y,default.units="native", gp=gpar(fill=col))
}

#
# random walk in affected half-sibs
#
halfsibscan <- function(N=100, grid=1) {
  chr <- c(1:22, "X")
  chr.length <- c(285, 265, 225, 210, 220, 190, 190, 175, 165, 175,
                  160, 175, 130, 120, 130, 130, 135, 135, 110, 100,
                  70, 80, 185)
  halfsibZ <- function(N, grid, chr, length) {
    phi <- 0.5*(1-exp(-0.04*grid))
    npoints <- round(length/grid)+1
    points <- seq(from=0, to=length, length.out=npoints)
    y <- double(length=npoints)
    y[1] <- sum(sample(0:1, replace=TRUE, size=N))
    for(i in 2:length) {
      y[i] <- y[i-1] - rbinom(1, y[i-1], phi) + rbinom(1, N-y[i-1], phi)
    }
    z <- (2*y-N)/sqrt(N)
    z[z<0] <- 0
    data.frame(chr=rep(chr,npoints), pos=points, lod=z^2/(2*log(10)))
  }
  res <- NULL
  for(i in 1:23) {
    res <- rbind(res, halfsibZ(N=N, grid=grid, chr=chr[i], length=chr.length[i]))
  }
  res
}
"my.xtics" <-
function(at,length=0.5) {
  tick.y0 <- unit(0,"npc")
  tick.y1 <- unit(-length, "lines")
  grid.segments(unit(at, "native"), tick.y0,
                unit(at, "native"), tick.y1)
}

"paint.chromosome" <-
function(chrom, pos=0, units="cM", width=0.4, bands="major") {
#
# base graphics semicircle 
  semicircle <- function(base.x, base.y, base.length,
                         height=base.length, side=1, orientation=NULL, col=NULL) {
    radius<-base.length/2
    x<-radius*seq(-1,1,length=40)
    y<-height/radius*sqrt(radius^2-x^2)
    if (is.null(orientation)) {
      co<-as.integer(cos(pi*(3-side)/2))
      so<-as.integer(sin(pi*(3-side)/2))
    }else{
      co<-cos(orientation)
      so<-sin(orientation)
    }
    tx<-co*x - so*y 
    ty<-so*x + co*y
    if (is.null(orientation)) {
      if (side==1 || side==3) {
        base.x<-base.x+radius
      }else if (side==2 || side==4) {
        base.y<-base.y+radius
      }
    }
    x<-base.x+tx
    y<-base.y+ty
    polygon(x,y,col=col)
  }
  data(chrom.bands)
  chromdata<-subset(chrom.bands, chrom.bands$chr==chrom)
  lc<-nchar(chromdata$band)
  sel<-!(substr(chromdata$band,lc,lc) %in% letters)
  if (bands!="major") sel<-!sel
  chromdata<-chromdata[sel,]
  rm(lc,sel)
  bandcol<-gray(c(0.4,0.6,0.8,0.8,0.85))[match(chromdata$stain, 
                                          c("acen","gneg", "gpos", "gvar", "stalk"))]
  n<-nrow(chromdata)
  centromere<-which(chromdata$arm[-n]!=chromdata$arm[-1])
  idx<-c(2:(centromere-1), (centromere+2):(n-1))
  rect(chromdata$cM.top[idx],pos,chromdata$cM.bot[idx],pos-width, col=bandcol[idx])
  semicircle(chromdata$cM.bot[1], pos-width, width,
             chromdata$cM.bot[1]-chromdata$cM.top[1], 2, col=bandcol[1])
  semicircle(chromdata$cM.top[n], pos-width, width, 
             chromdata$cM.bot[n]-chromdata$cM.top[n], 4, col=bandcol[n])
  semicircle(chromdata$cM.top[centromere], pos-width, width,
             chromdata$cM.bot[centromere]-chromdata$cM.top[centromere], 
             4, col=bandcol[centromere])
  semicircle(chromdata$cM.bot[centromere+1], pos-width, width, 
             chromdata$cM.bot[centromere+1]-chromdata$cM.top[centromere+1], 
             2, col=bandcol[centromere+1])
  points(chromdata$cM.top[centromere], pos-0.5*width, col="black", cex=3, pch=16)
  points(chromdata$cM.top[centromere], pos-0.5*width, col="white", cex=3, pch=20)
}

"plot.scan" <-
function(x, type="layout", statistic="lod", 
                      with.X=TRUE, min.stat=0, max.stat=4, pheno.names=NULL,
                      units="cM", col=1:6, lty=1, lwd=2,
                      chromname.cex=0.9, ...) {
  require(grid)
  if (with.X) {
    n.chrom<-23
    nchrom <- c(3,4,7,9)
    chroms<-c(as.character(1:22),"X")
    chrom.rel.size<- list(r1=c(5, 5, 5), 
                          r2=c(4, 4, 4, 3), 
                          r3=c(3, 2, 2, 2, 2, 2, 2),
                          r4=c(2, 2, 2, 2, 1, 1, 1, 1, 3))
  }else{
    n.chrom<-22
    nchrom <- c(3,4,7,8)
    chroms<-as.character(1:22)
    chrom.rel.size<- list(r1=c(5, 5, 5), 
                          r2=c(4, 4, 4, 3), 
                          r3=c(3, 2, 2, 2, 2, 2, 2),
                          r4=c(2, 2, 2, 2, 2, 2, 2, 2))
  }
  type<-match.arg(type,c("layout","overwrite","linear","histogram"))
  if (is.null(pheno.names)) {
    pheno.names <- statistic
  }
  if (type=="layout") {
    grid.newpage()
    chr.plot <- list(
      r1=viewport(1/2, 7/8, width=0.9, height=0.24, name="r1", 
                layout=grid.layout(nr=1, nc=3, 
                widths=unit(chrom.rel.size$r1, "null"))), 
      r2=viewport(1/2, 5/8, width=0.9, height=0.24, name="r2", 
                layout=grid.layout(nr=1, nc=4, 
                widths=unit(chrom.rel.size$r2, "null"))),
      r3=viewport(1/2, 3/8, width=0.9, height=0.24, name="r3", 
                layout=grid.layout(nr=1, nc=7, 
                widths=unit(chrom.rel.size$r3, "null"))), 
      r4=viewport(1/2, 1/8, width=0.9, height=0.24, name="r4", 
                   layout=grid.layout(nr=1, nc=length(chrom.rel.size$r4), 
                            widths=unit(chrom.rel.size$r4, "null"))))
    i.chr <- 0
    for(g in seq(along=chr.plot)) {
      pushViewport(chr.plot[[g]])
      if (units=="bp") {
        for(i in 1:nchrom[g]) {
          i.chr <- i.chr + 1
          pushViewport(viewport(layout.pos.col=i, layout.pos.row=1))
          chromosome.viewsequence(x,chroms[i.chr], statistic,col=col, 
                                  min.stat=min.stat, max.stat=max.stat, 
                                  lwd=lwd, lty=lty, 
                                  chromname.cex=chromname.cex, 
                                  show.y.axis=(i==1))
          popViewport()
        }
      }else{
        for(i in 1:nchrom[g]) {
          i.chr <- i.chr + 1
          pushViewport(viewport(layout.pos.col=i, layout.pos.row=1))
          chromosome.viewlinkage(x,chroms[i.chr],statistic,col=col, 
                                 min.stat=min.stat, max.stat=max.stat, 
                                 lwd=lwd, lty=lty, 
                                 chromname.cex=chromname.cex, 
                                 show.y.axis=(i==1))
          popViewport()
        }
      }
      popViewport()
    }
  }else if (type=="linear") {
    n.chrom<-length(unique(x$chr))
    statlod<-x[, statistic]
    hi.lod<-max(unlist(c(max.stat,lod)),na.rm=TRUE)
    pos<-x$pos
    d<-diff(pos)
    d[d<0]<-0
    pos<-c(0,cumsum(d))
    tic.pos<-0
    tic.lab<-"0"
    tic.lab.last<-0
    cur.chr<-x$chr[1]
    for (j in 1:length(pos)) {
      if (x$chr[j]!=cur.chr) {
        tic.pos<-c(tic.pos, pos[j])
        tic.lab<-c(tic.lab,"")
        tic.lab.last<-0
        cur.chr<-x$chr[j]
      }else if (pos[j]>(tic.pos[length(tic.pos)]+50)) {
        tic.pos<-c(tic.pos, tic.pos[length(tic.pos)]+50)
        tic.lab.last<-tic.lab.last+50
        tic.lab<-c(tic.lab,as.character(tic.lab.last))
      }
    }
    mid.pos<-tapply(pos, x$chr, mean, na.rm=TRUE)
    if (is.null(ncol(lod))) {
      npheno<-1
      plot(pos, lod, t="l",
           ylim=c(min.stat,hi.lod), axes=FALSE,
           xlab=paste("Genome scan position (",units,")",sep=""), 
           ylab="lod score", ...)
    }else{
      npheno <- ncol(lod)
      matplot(pos, lod, t="l",
           ylim=c(min.stat,hi.lod), axes=FALSE,
           col=col, lwd=lwd, 
           xlab=paste("Genome scan position (",units,")",sep=""), 
           ylab="lod score", ...)
    }
    box()
    if (n.chrom>15) {
      axis(1)
    }else{
      axis(1, at=tic.pos, labels=tic.lab, cex.axis=min(1,50/length(tic.pos)))
    }
    axis(2)
    abline(v=pos[d==0], lty=3)
    text(mid.pos, 3.5, names(mid.pos), cex=chromname.cex)
    abline(h=3, lty=3)
    abline(h=0, lty=3)
    if (npheno>1) {
      legend(0, max.stat+0.1, lwd=rep(2,npheno), 
             bty="o",  bg="white", 
             col=c("black","red", "blue"),
             legend=pheno.names, horiz=TRUE)
    }
  }else if (type=="histogram") {
    hist(x[,statistic],20,xlab="lod score",
         main="Distribution of lod scores across scan", ...)
  }else{
    lod<-x[, statistic[1]]
    hi.lod<-max(unlist(c(max.stat,lod)),na.rm=TRUE)
    idx<-as.numeric(as.character(x$chr))==1
    plot(x$pos[idx], lod[idx], t="l",
         ylim=c(min.stat,hi.lod), 
         xlab=paste("Map position (i",units,")",sep=""), ylab="lod score", ...)
    for (i in unique(x$chr)) {
      lty<-1
      idx<-(x$chr==i)
      if (sum(idx)>0) {
        lty<-as.numeric(as.character(i))
        lines(x$pos[idx], lod[idx], lty=lty)
      }
    }
  }
}

