R/outlier_demo.R

Defines functions outlier_demo

Documented in outlier_demo outlier_demo

outlier_demo <- 
function(cex.leg=0.8) {
    par(mfrow=c(1,1))
    plot(0,0,xlim=c(0,1),col="white",ylim=c(0,1),xlab="x",ylab="y",main="click plot to add points then click END below to stop demo",cex.main=0.9)
    legend("topleft",c("without red dot","with red dot"),lty=c(1,1),col=c("black","red"),cex=cex.leg,bty="n")
    
    x <- c(); y <- c()
    r.old <- 0
    keep.going <- 1
    while (keep.going==1) {
        new.point <- unlist(locator(1))
 
        if( new.point[1] > .9 & new.point[2] < .05 & length(x)>1 ) {  #Undo
          x <- x[-length(x)]
          y <- y[-length(y)]

          plot(0,0,xlim=c(0,1),col="white",ylim=c(0,1),xlab="x",ylab="y",main="")
          rect(-1,-1,.1,.03,col="red");  text(.015,0,"END",cex=0.8)
          rect(.9,-1,2,.03,col="red");  text(0.95,.0,"UNDO",cex=0.8)
          
          legend("topleft",c("without red dot","with red dot"),lty=c(1,1),col=c("black","red"),cex=cex.leg,bty="n")
          
          points(x,y,pch=20,cex=2,col="black")

          if(length(x)>=2) { abline(lsfit(x,y),col="black",lty=1,lwd=2) }

        } else {

        if( new.point[1] > .1 | new.point[2] > .05 ) {
            plot(x,y,pch=20,cex=2,col="black",xlim=c(0,1),ylim=c(0,1),xlab="x",ylab="y",main="")
          rect(-1,-1,.1,.03,col="red");  text(.015,0,"END",cex=0.8)
          rect(.9,-1,2,.03,col="red");  text(0.95,.0,"UNDO",cex=0.8)
          
          legend("topleft",c("without red dot","with red dot"),lty=c(1,1),col=c("black","red"),cex=cex.leg,bty="n")
          
            if(length(x)>=2) { abline(lsfit(x,y),col="black",lty=1,lwd=2) }
            points(new.point[1],new.point[2],pch=20,cex=2,col="red")
            x <- c(x,new.point[1]);  y <- c(y,new.point[2])
            if(length(x)>2) {      abline(lsfit(x,y),col="red",lty=1,lwd=2) }
        } else { keep.going <- 0 }
    }
    }
}

Try the regclass package in your browser

Any scripts or data that you put into this service are public.

regclass documentation built on March 26, 2020, 8:02 p.m.