# variables and functions
# plot_* : constants and functions
# list_* : functions to make list for *
# data_* : data for *
# expression_conv : LaTeX-like command to R-expression

plot_col<-c( #col
"'black'","'red'","'blue'","'green'",
"'cyan'","'yellow'","'magenta'",
"rainbow(%d)[%d]","heat.colors(%d)[%d]","terrain.colors(%d)[%d]",
"topo.colors(%d)[%d]","cm.colors(%d)[%d]")

plot_type<-c( #type
"p","l","o","b","c","h","s","S","n")
plot_type_string<-c(
"points", #"p"
"lines", #"l"
"both overplotted", #"o"
"both points and lines", #"b"
"the lines part alone", #"c"
"histogram", #"h"
"steps", #"s"
"other steps", #"S"
"no plotting") #"n"

plot_lwd<-1:5 # line width

plot_lty<-c( #LineType 0:6
"blank","solid","dashed","dotted",
"datdash","longdash","twodash") 

plot_pch<-c( #PlottingCharacter 1:126
"circle","triangle point up","cross","crisscross","diamond", #5
"triangle point down","square X","cross X","diamond cross","circle cross", #10
"two triangles","square cross","circle X","square V","filled square", #15
"filled circle","filled triangle","filled diamond","filled circle","filled bullet", #20
"circle","square","diamond","triangle point up","triangle point down", #25
"","","","","",#30
"","blank","!",'"',"#","$","%","&","'","(", #40
")","*","+",",","-",".","/","0","1","2", #50
"3","4","5","6","7","8","9",":",";","<", #60
"=",">","?","@","A","B","C","D","E","F", #70
"G","H","I","J","K","L","M","N","O","P", #80
"Q","R","S","T","U","V","W","X","Y","Z", #90
"[","\\","]","^","_","`","a","b","c","d", #100
"e","f","g","h","i","j","k","l","m","n", #110
"o","p","q","r","s","t","u","v","w","x", #120
"y","z","{","|","}","~") #126

# parameters to set with par
plot_tcl<-c(0.5,-0.5) #Tick
plot_tcl_string<-c("inside","outside")

#label
plot_las<-c( #LabelStyle 0:3
"parallel to the axis","horizontal",
"perpendicular to the axis","vertical")

plot_side<-c( #1:4
"bottom","left","top","right")

#box
plot_bty<-c("o","l","7","c","u","]","n")
plot_box_string<-c("all",
"left and bottom","top and right",
"except right","except top","except left",
"none")


expression_conv <- function(str){
  r<-paste('"',str,'"',sep="")
  r<-gsub('\\\\pm\\{\\}', "\",phantom() %+-% phantom(),\"", r) # pm
  r<-gsub('\\\\times\\{\\}', "\",phantom() %*% phantom(),\"", r) # times
  r<-gsub('\\\\div\\{\\}', "\",phantom() %/% phantom(),\"", r) # div
  r<-gsub('\\\\propto\\{\\}', "\",phantom() %prop% phantom(),\"", r) # propto
  r<-gsub('\\\\perp\\{\\}', "\",symbol(\"\\\\136\"),\"", r) # perp
  r<-gsub('\\\\infty\\{\\}', " infinity ", r) # infty
  r<-gsub('\\\\(\\w+)\\{\\}', "\",\\1,\"", r) # greek
#  r<-gsub('\\\\(\\w+)\\b', "\",\\1,\"", r,perl=TRUE) # greek
  r<-gsub('\\{([^\\}]*[+-])\\}', "{\\1 phantom()}", r) # for last + or -
  r<-gsub('_\\{([^\\}]*)\\}', "\",phantom()[\\1],\"", r) #sub
  r<-gsub('\\^\\{([^\\}]*)\\}', "\",phantom()^{\\1},\"", r) #super
  r<-gsub('\\\\(\\w+)\\{(\\w+)\\}', "\",\\1(\\2),\"", r) # italic,bold,sqrt,bar
  r<-gsub('"",', "", r)
  r<-gsub(',""', "", r)
  if(regexpr("[\\\\_\\^]",str)>0){
    r<-paste("expression(paste(",r,"))")
  }
  return(r)
}


plot_new <- function(){
  data_plot <<- list()
  data_axis <<- list(NA,NA,NA,NA)
  data_label <<- list(list_label("x"),list_label("y"),NA,NA)
  data_legend <<- list_legend()
  data_text <<- list()
}
plot_range <- function(side=1){
  r<-data_axis[[side]]
  if(! is.na(r)[1] ){
    if(any( is.na(r$lim) )){
      data<-c()
      for(i in data_plot){
        if(i$xside==side){data<-c(data,i$x)}
        if(i$yside==side){data<-c(data,i$y)}
        }
      data<-paste("c(",paste(data,collapse=","),")")
      rr<-range(eval(parse(text=data)))
      if(! is.na(r$lim)[1]){rr[1]<-r$lim[1]}
      if(! is.na(r$lim)[2]){rr[2]<-r$lim[2]}
    }else{rr<-r$lim}
  }else{rr<-c(0,0)}
  return(rr)
}
plot_mar <- function(side=1){
  if( is.na(data_label[[side]])[1] ){
    r<-1
    if(! is.na(data_axis[[side]])[1] ){
      if(data_axis[[side]]$labels==1){r<-4}
      }
  }else{
    r<-data_label[[side]]$line+1
  }
  return(r)
}


list_plot <- function(x,y,type=1,lwd=1,lty=0,pch=1,col=1,xside=1,yside=2){
  return(list(x=x,y=y,type=type,lwd=lwd,lty=lty,pch=pch,col=col,
    xside=xside,yside=yside))
}
plot_cols <- function(n){
  l<-length(data_plot)
  col<-plot_col[data_plot[[n]]$col+1]
  cols<-sprintf(col,l,n)
  return(cols)
}
plot_plot <- function(p,l=0,n=0){ #length,index
  xlim<-""
  ylim<-""
  lim<-plot_range(p$xside)
  if(all(! is.na(lim))){
    xlim<-sprintf(",xlim=c(%f,%f)",lim[1],lim[2])
    }
  lim<-plot_range(p$yside)
  if(all(! is.na(lim))){
    ylim<-sprintf(",ylim=c(%f,%f)",lim[1],lim[2])
    }
  log<-""
  if((data_axis[[p$xside]])$log==1){log<-paste(log,"x",sep="")}
  if((data_axis[[p$yside]])$log==1){log<-paste(log,"y",sep="")}
  cols<-plot_cols(n)
  r<-sprintf(
    "plot(%s,%s,type='%s',lwd=%d,lty=%d,pch=%d,col=%s,log='%s',%s%s%s)\n",
      p$x,p$y,plot_type[p$type+1],
      p$lwd+1,p$lty,p$pch+1,cols,
      log,"ann=FALSE,axes=FALSE",xlim,ylim
    )
  r<-paste(r,sprintf("par(new=TRUE)\n"))
cat(r)
  return(r)
}

#list_axis <- function(tcl=0,las=1,labels=1,tick=1,lim=NA,log=0){
#list_axis <- function(tcl=0,las=1,labels=1,tick=1,lim=c(NA,NA),log=0){
list_axis <- function(tcl=0,las=1,labels=1,tick=1,lim=c(NA,NA),log=0,padj=0){
#  list(tcl=tcl,las=las,labels=labels,tick=tick,lim=lim,log=log)
  list(tcl=tcl,las=las,labels=labels,tick=tick,lim=lim,log=log,padj=padj)
}
plot_axis <- function(side=1){
  p<-data_axis[[side]]
  lim<-plot_range(side)
  if(p$log==1){log<-"xy"}else{log<-""}
  r<-paste("par(new=TRUE)\n")
  r<-paste(r,"plot.new()\n")
  r<-paste(r,sprintf("plot.window(xlim=c(%f,%f),ylim=c(%f,%f),log='%s')\n",
    lim[1],lim[2],lim[1],lim[2],log) )
  r<-paste(r,sprintf("par(tcl=%.1f,las=%d)\n",plot_tcl[p$tcl+1],p$las))
#  r<-paste(r,sprintf("axis(side=%d,labels=%s,tick=%s)\n",
#    side,p$labels==1,p$tick==1) )
#  r<-paste(r,sprintf("axis(side=%d,labels=%s,tick=%s,padj=%s)\n",
#    side,p$labels==1,p$tick==1,p$padj) )
  r<-paste(r,sprintf("axis(side=%d,labels=FALSE,tick=%s)\n",
    side,p$tick==1) )
  r<-paste(r,sprintf("axis(side=%d,labels=%s,tick=FALSE,line=%s)\n",
    side,p$labels==1,p$padj) )
  return(r)
}

list_label <- function(text="",las=0,line=3){
  return(list(text=text,las=las,line=line))
}
plot_label <- function(side=1){
  p<-data_label[[side]]
  r<-sprintf("par(las=%d)\n",p$las)
  r<-paste(r,
    sprintf("mtext(%s,side=%d,line=%.1f)\n",
      expression_conv(p$text),side,p$line))
  return(r)
}

list_legend <- function(x=0,y=0,legend=c(),bty=6){
  return(list(x=x,y=y,legend=legend,bty=bty))
}
plot_legend <- function(){
  if(length(data_legend$legend)>0){
    lty<-c()
    lwd<-c()
    pch<-c()
    col<-c()
#    for(i in data_plot){
    for(n in seq(length.out=length(data_plot))){
      i<-data_plot[[n]]
      lwd<-c(lwd,i$lwd+1)
      temp<-i$lty
      if(i$type==0){temp<-0}
      lty<-c(lty,temp)
      temp<-i$pch+1
      if(i$type==1){temp<-32}
      pch<-c(pch,temp)
#      col<-c(col,plot_col[i$col+1])
      col<-c(col,plot_cols(n))
    }
    if(all(lty==0)){lwd<-""}
    else{
      lwd<-paste(",lwd=c(",paste(lwd,collapse=","),")",sep="")
    }
    lty<-paste("c(",paste(lty,collapse=","),")",sep="")
    pch<-paste("c(",paste(pch,collapse=","),")",sep="")
#    col<-paste("c('",paste(col,collapse="','"),"')",sep="")
    col<-paste("c(",paste(col,collapse=","),")",sep="")
    lgnd<-c()
    for(i in data_legend$legend){
      lgnd<-c(lgnd,expression_conv(i))
    }
    lgnd<-paste("c(",paste(lgnd,collapse=","),")",sep="")
    r<-sprintf(
      "legend(%f,%f,legend=%s,col=%s,lty=%s%s,pch=%s,bty='%s')\n",
      as.numeric(data_legend$x),as.numeric(data_legend$y),
      lgnd,col,lty,lwd,pch,plot_bty[data_legend$bty+1])
    return(r)
  }
}

list_text <- function(x=0,y=0,label=""){
  return(list(x=x,y=y,label=label))
}
plot_text <- function(p){
  r<-sprintf("text(%f,%f,%s)\n",
      as.numeric(p$x),as.numeric(p$y),expression_conv(p$label) )
  return(r)
}

plot_all <- function(){
  r<-""
#plot
  r<-paste(r,sprintf("par(xaxs='i',yaxs='i')\n"))
  r<-paste(r,sprintf("par(mar=c(%.1f,%.1f,%.1f,%.1f))\n",
    plot_mar(1),plot_mar(2),plot_mar(3),plot_mar(4) ))
#  for(i in data_plot){
  for(n in seq(length.out=length(data_plot))){
    i<-data_plot[[n]]
    if(is.na(data_axis[[i$xside]][1])){
      data_axis[[i$xside]]<<-list_axis()
      }
    if(is.na(data_axis[[i$yside]][1])){
      data_axis[[i$yside]]<<-list_axis()
      }
    r<-paste(r,plot_plot(i,length(data_plot),n))
  }
  r<-paste(r,"box()\n")
#axis
  for(side in 1:4){
    if( ! is.na(data_axis[[side]])[1] ){
      r<-paste(r,plot_axis(side))
    }
  }
#label
  for(side in 1:4){
    if( ! is.na(data_label[[side]])[1] ){
      r<-paste(r,plot_label(side))
    }
  }
  r<-paste(r,"par(new=TRUE)\n")
  r<-paste(r,"plot.new()\n")
  r<-paste(r,"plot.window(xlim=c(0,1),ylim=c(0,1),log='')\n")
#legend
  r<-paste(r,plot_legend())
#text
  for(i in data_text){
    r<-paste(r,plot_text(i))
  }
  r<-paste(r,sprintf("par(new=FALSE)\n"))
  return(r)
}


# change log
# 2008.6.16 alpha version
# 2010.8.25-9.3 several corrections
# 2010.9.8 plot_mar
# 2010.9.10 add plot.new()
# 2012.5.1 bug fix for legend and text
# 2012.5.2 bug fix for autorange multiplot
# 2012.5.8 bug fix for superscript
# 2015.9.10 autoscale from zero, adjust axis position
# 2016.10.16 propto,perp,infty
# 2016.10.29 colors