Stairplot

mountains2.txt

"V1","V2","V3","V4"
"Everest",8849,688.582,"Indian Ocean"
"Kanchenjunga",8586,670,"Indian Ocean"
"Chomolhari",7090,614,"Indian Ocean"
"Gangkhar Puensum",7570,605,"Indian Ocean"
"Chimborazo",6263.47,175,"Pacific"
"Mishahuanga",4118,91,"Pacific"
"Huascaran",6746,97.7,"Pacific"
"Coropuna",6405,112,"Pacific"
"El Misti",5822,103,"Pacific"
"Aconcagua",6962,135,"Pacific"
"Manua Kea",4205,28,"Pacific"
"Cameroun",4040,20,"Atlantic"
"Haydon Peak",3634,15,"Pacific"
"Logan",5959,63,"Pacific"
"Turqino",2000,6,"Atlantic"
"Seven Sisters",1070,2.3,"Atlantic"
"Fuji",3776,26,"Pacific"
"Trigo",1979,4,"Atlantic"
"Fogo",2829,5.6,"Atlantic"
"Taygetus",2407,12.5,"Atlantic"
"Etna",3329,20,"Atlantic"
"Teide",3718,15,"Atlantic"
"Cumbre Vieja",1949,5.2,"Atlantic"
"Puig Mayor",1445,4,"Atlantic"
"Gunung Binaiya",3027,15.5,"Indian Ocean"
"Pegunungan Wondiwoi",2180,8.5,"Indian Ocean"
"Talawe",1824,6.3,"Indian Ocean"
"Finisterre Range",4125,35,"Indian Ocean"
"IliLabalekang",1644,3.6,"Indian Ocean"
"Rinjani",3726,18.3,"Indian Ocean"
"Mt. Leuser",3466,37,"Indian Ocean"
"Agdleruussakasit",1763,3,"Atlantic"
"Angna Mountain",1710,4.3,"Atlantic"
"Newtontoppen",1717,12.5,"Atlantic"
"Beerenberg",2277,5.5,"Atlantic"
"Pico",2351,4.6,"Atlantic"
"Queen Mary's Peak",2060,4.9,"Atlantic"
"Paget",2934,6.8,"Atlantic"
"Ross",1850,6.8,"Atlantic"
"Pinton De Neiges",3069,21,"Indian Ocean"
"Conocranra",5822,67,"Pacific"
"Cristobal Colon",5700,46,"Atlantic"
"Grace",3212,10,"Pacific"
"Saint Elias",5489,19,"Pacific"
"Cerro Maca",2960,11,"Pacific"
"Elder",1197,2,"Pacific"
"Seattle",3154,16.6,"Pacific"
"Jette",2558,15.7,"Pacific"
"Cook, Alaska", 4196,28.7,"Pacific"
"Vancouver",4812,34.3,"Pacific"
"Aylesworth", 2830,14.2,"Pacific"
"Wade", 2439, 14.9,"Pacific"
"Margaretatoppen", 2360, 5.3,"Atlantic"
"Perserajoq",2259,3.4,"Atlantic"
"Vsevidof",2149,6.9,"Pacific"
"Chagulak", 1143, 1.4,"Pacific"
"Overlord", 1485,1.8,"Pacific"
"Jakta",1588,1.4,"Atlantic"
"Bloktinden", 1032, 0.945,"Atlantic"
"Mount Erebrus", 3794,16.3,"Pacific"
"Mount Peacock", 3210, 11, "Pacific"
"Mount Parry", 2520,4,"Pacific"
"Mount Lister", 4025,34,"Pacific"
"Mount Foster", 2105, 2.6, "Pacific"
"Mount Irving", 1950, 2.5, "Atlantic"
"Mount Melbourne", 2730,11,"Pacific"
"Mount Terror", 3230,13.2, "Pacific"
"Mount Discovery", 2681,9.7,"Pacific"
"Slogen", 1564, 1.645, "Atlantic"

plot_mountains.R

source("stairplot.R")
bd=read.csv("mountains2.txt", header=T, sep=",")
bd=subset(bd, V2>1500)
subc=rep(0,nrow(bd))
subc[which(bd[,4]=="Atlantic")]=1
subc[which(bd[,4]=="Pacific")]=2
subc[which(bd[,4]=="Indian Ocean")]=3
coll_scheme=rbind(c("deepskyblue3", "darkblue"),
                  c("red", "darkred"),
                  c("green", "darkgreen"))
a=until_then(bd[,1], as.numeric(bd[,3]), as.numeric(bd[,2]), 
           sub_cats = subc,
           increasing = T, cex=0.8,nca=43, 
           xlab="Distance from the sea (km)", 
           ylab="Highest Mountain (m)",coll_scheme =coll_scheme,
           textposition=c("NW","SE","SW","NE"),textheight=0.08,
           left_extra = 0.14, right_extra=0.07,down_extra=0.19,
           xbox_distance_slack=0,ybox_distance_slack=0,
           label_first = c("Kanchenjunga", "Perserajoq"))
legend("topleft", legend=c("Atlantic","Pacific","Indian Ocean"), pch="/", col = c("deepskyblue3","red","green"),pt.cex=1.5)
legend("topleft", legend=c("","",""), col = c("darkblue","darkred","darkgreen"),pch="-", bty='n',pt.cex=2)

stairplot.R

#This function plots a vector x against a running maximum of y. 
#First, the x,y pairs are sorted according to the values of x. 
#Each point is being labeled if possible. 
#It also returns the resulting break points of the graph as a matrix.
#
#
#Input: RowNames is a list of strings or factors of length n. 
#x is the first axis values of length n.
#y is the second axis values of length n.
#sub_cats is a vector of length n, with numbers from 1 to length(coll_scheme) indicating which color to use for that category.
#increasing is a boolean indicating whether to take maximum or minimum along the sequence. For now only maximum works.
#nca=Number of Characters Across is a measure for how much space one letter takes up. It depends on the plotting window size, and should be adjusted for each plot.
#cex= relative size of text.
#plot_first: list of the labels that should be plotted first. The order of the list determines the order to put the labels.
#coll_scheme: if vector of same length as number of sub_cats, each color will be used for each sub category. If not of the same length, the colors will be alternating from left to right. If a matrix is applied, the number of rows should correspond to the number of categories and each category will be colored according to its row, alternating between the columns. If not specified the colors will alternate between red, green and blue. 
#coll_labels: the same as coll_scheme but only applies to the labels.
#coll_points: the same as coll_scheme but only applies to the labeled points.
#coll_bars: the same as coll_scheme but only applies to the line following each labeled point.
#textposition: a prioritized list of relative position of the label to the point. Any vector of "NE","NW", "SW", and "SE" is possible.
#textheight: the relative height of the text. Depends on the window size.
#rightextra: How far beyond the points, the plotting range should extend to the right. It is relative to the total width of the plot. 
#leftextra: How far beyond the points, the plotting range should extend to the left. It is relative to the total width of the plot.
#down_extra: How far beyond the points, the plotting range should extend to up. It is relative to the total height of the plot.
#up_extra: How far beyond the points, the plotting range should extend to down. It is relative to the total height of the plot.
#point_size: the size of the points.
#lwd_redraw: the thickness of the labeled lines. 
#...: some parameters to be passed to the normal plot function.
until_then=function(RowNames, x, y, 
                    sub_cats=NULL,
                    increasing=T,
                    nca=100,cex=1.0, 
                    label_first=c(),
                    coll_scheme=NULL,coll_labels=NULL, 
                    coll_points=NULL, coll_bars=NULL,
                    textposition=c("NW","SE","SW","NE"),
                    textheight=0.04,
                    right_extra=0.2,left_extra=0.2,
                    down_extra=0, up_extra=0.05,
                    point_size=0.5,lwd_redraw=2,
                    xbox_distance_slack=0,
                    ybox_distance_slack=0,
                    ...){
  if(!is.null(sub_cats)){
    no_cats=max(sub_cats)
  }
  else{
    no_cats=1
  }
  set_col_scheme=function(input, main=F){
    if(is.null(input)){
      if(main){
        return(matrix(rep(c("blue","red","darkgreen"),no_cats), 
                      nrow=no_cats, ncol=3, byrow=T))  
      }
      return(coll_scheme)
    }
    else{
      if(is.vector(input)){
        if(length(input)==no_cats){
          return(matrix(rep(input,no_cats), 
                        nrow=no_cats, ncol=no_cats, byrow=F))
        }
        return(matrix(rep(input,no_cats), 
                      nrow=no_cats, ncol=length(input), byrow=T))
      }
      return(input)
    }
  }
  coll_scheme=set_col_scheme(coll_scheme, T)
  coll_labels=set_col_scheme(coll_labels)
  coll_bars=set_col_scheme(coll_bars)
  coll_points=set_col_scheme(coll_points)

  RowNames=as.character(RowNames)
  xpoints=numeric()
  ypoints=numeric()
  i1=!is.na(x)
  i2=!is.na(y)
  x=x[which(i1*i2==1)]
  y=y[which(i1*i2==1)]
  RowNames=RowNames[which(i1*i2==1)]
  dat=cbind(x,y)
  os=order(dat[,1])
  dat=dat[os,]
  RowNames=RowNames[os]
  sub_cats=sub_cats[os]
  xpoints[1]=dat[1,1]
  ypoints[1]=dat[1,2]
  
  #The matrix of all changes.
  single_points=matrix(c(xpoints[1],ypoints[1], RowNames[1]),nrow=1,ncol=3)
  for(i in 2:length(dat[,1])){
    xpoints[i]=dat[i,1]
    if(increasing){
      ypoints[i]=max(dat[1:i,2], na.rm=T)
    }
    else{
      ypoints[i]=min(dat[1:i,2], na.rm=T)
    }
    if(ypoints[i]!=ypoints[i-1]){
      if(xpoints[i]==single_points[nrow(single_points),1]){#if no real increase has happened, overwrite.
        single_points=single_points[-nrow(single_points),]
      }
      single_points=rbind(single_points, c(xpoints[i],ypoints[i], RowNames[i]))
    }
  }
  yspan=max(as.numeric(single_points[,2]))-min(as.numeric(single_points[,2]))
  xspan=max(as.numeric(single_points[,1]))-min(as.numeric(single_points[,1]))
  plot(c(xpoints,xpoints[length(xpoints)]+xspan), 
         c(ypoints, ypoints[length(ypoints)]), type='s', bty="n", xlim=c(xpoints[1]-xspan*left_extra, xpoints[length(xpoints)]+xspan*right_extra),
       ylim=c(ypoints[1]-yspan*down_extra, ypoints[length(ypoints)]+yspan*up_extra),...)
  
  
  importances=matrix(0,nrow=nrow(single_points),ncol=5)
  for(j in 1:nrow(single_points)){
    x1=as.numeric(single_points[j,1])
    y1=as.numeric(single_points[j,2])
    if(j<nrow(single_points)){
      x2=as.numeric(single_points[j+1,1])
    }
    else{
      x2=x1+xspan*0.2
    }
    if(j>1){
      y0=as.numeric(single_points[j-1,2])
    }
    else{
      y0=y1
    }

    importances[j,]=c(x1,x2,y0,y1, (x2-x1)/xspan+abs(y1-y0)/yspan)
    if(single_points[j,3] %in% label_first){
      importances[j,5]=3+length(label_first)-which(label_first==single_points[j,3])
    }
  }
  importances[c(1,nrow(importances)),5]=2#giving first and last point max attention.
  ord=order(importances[,5], decreasing = T)
  
  #adding the lines in the plot as "taken" spots.
  boxes=importances[,c(1,2,4,4)] #adding the lines as boxes
  boxes=rbind(boxes, importances[,c(1,1,3,4)])
  
  #indicator of the extremes should be labelled.
  draw_obs=rep(0,nrow(importances))
  
  #function that determines if the box x1,x2,y1,y2 intersects any existing box.
  is_intersect_empty=function(x1,x2,y1,y2){
    if(nrow(boxes)==0){
      return(TRUE)
    }
    for(i in 1:nrow(boxes)){
      x1b=boxes[i,1]
      x2b=boxes[i,2]
      y1b=boxes[i,3]
      y2b=boxes[i,4]
      if(!((x2-xspan*xbox_distance_slack*cex)<=x1b | 
           (x1+xspan*xbox_distance_slack*cex)>=x2b | 
           (y1+yspan*ybox_distance_slack*cex)>=y2b | 
           (y2-yspan*ybox_distance_slack*cex)<=y1b)){
        return(FALSE)
      }
    }
    return(TRUE)
  }
  
  #given a x,y-position, the label box is constructed. 
  get_box=function(x1,x2,y1,y2, textpos){
    if(substr(textpos,1,1)=="N"){
      y2=y2+yspan*textheight*cex*0.8
      y1=y1#-yspan*textheight*cex*0.2
    }
    else{
      y1=y1-yspan*textheight*cex
    }
    if(substr(textpos,2,2)=="W"){
      x1=x1-xspan_equiv
    }
    else{
      x2=x2+xspan_equiv
    }
    return(c(x1,x2,y1,y2))
  }
  
  #determining which labels, that fits.
  for(i in 1:nrow(importances)){
    numb_char=nchar(single_points[ord[i],3])
    xspan_equiv=xspan*numb_char/nca*cex #the x-length of the text.
    x1=importances[ord[i],1]
    x2=importances[ord[i],1]
    y1=importances[ord[i],4]
    y2=importances[ord[i],4]
    cv=get_box(x1,x2,y1,y2, textposition[1])
    loop=2
    while(loop<=(length(textposition)+1)){
      if(is_intersect_empty(cv[1],cv[2],cv[3],cv[4])){
        draw_obs[ord[i]]=loop-1
        boxes=rbind(boxes, c(cv[1],cv[2],cv[3],cv[4]))
        break
      }
      else{
        if(loop>length(textposition)){
          break
        }
        cv=get_box(x1,x2,y1,y2, textposition[loop])
        loop=loop+1
      }
      
    }
    
  }
  

  #variables for controlling labelling.
  plot_number=0
  next_col_num=plot_number%%ncol(coll_scheme)+1
  
  #function that takes a string and returns the right category
  row_function=function(rown){
    if(is.null(sub_cats)){
      return(1)
    }
    return(sub_cats[which(rown==RowNames)][1])
  }
  
  #here the labelling takes place
  for(j in 1:nrow(single_points)){
    if(draw_obs[j]){
      numb_char=nchar(single_points[j,3])
      xspan_equiv=xspan*numb_char/nca*cex #the x-length of the text.
      x1=importances[j,1]
      x2=importances[j,1]
      y1=importances[j,4]
      y2=importances[j,4]
      line_y=y1
      line_x1=x1
      line_x2=importances[j,2]
      if(j==nrow(single_points)){
        line_x2=line_x2+xspan
      }
      cv=get_box(x1,x2,y1,y2,textposition[draw_obs[j]])
      x1=cv[1]
      x2=cv[2]
      y1=cv[3]
      y2=cv[4]
      lab=single_points[j,3]
      text(x1+(x2-x1)/2, y1-yspan*textheight*cex*0.1,
           labels=lab,pos=3,cex=cex,col=coll_labels[row_function(lab), next_col_num], family="mono")
      points(line_x1,line_y, pch=16, cex=point_size,col=coll_points[row_function(lab), next_col_num])
      lines(c(line_x1,line_x2),c(line_y,line_y), col=coll_bars[row_function(lab),next_col_num], lwd=lwd_redraw)
      plot_number=plot_number+1
      next_col_num=plot_number%%ncol(coll_scheme)+1
      
    }
  }

  return(single_points)
}