Nothing
`wlet.drive` <-
function(Xamp, DT=0.008, noctave=6, nvoice=20, w0=5, STAMP=NULL)
{
if(missing(DT)) { DT=1 }
if(missing(STAMP)) { STAMP=NULL }
######## this is just a guess
TPALS = c("rainbow", "topo.colors", "terrain.colors", "heat.colors", "tomo.colors")
APALS = c("rainbow", "topo", "terrain", "heat", "tomo")
ADDBUTS = c("RAW", "LOG", "SQRT", "INFO","BOXZ", "CLIMB", "ZBOUNDS" )
NCOL = 100
labs = c("DONE", "Postscript", "ContPS", APALS, ADDBUTS)
NLABS = length(labs)
NOLAB = NLABS +1000
pfreqs = c(0.5, 1, 2,3,4,5, 10, 14)
### FUN = match.fun(TPALS[1])
### pal = FUN(NCOL)
pal = RPMG::Gcols(plow=5, phi=0, N=100, pal=TPALS[1])
scale.def = 3
colabs = c(rep(1,2) , rep(2, length(APALS) ), rep(4,length(ADDBUTS) ))
pchlabs = c(rep(1,2) , rep(2, length(APALS) ), rep(4,length(ADDBUTS) ))
NSEL = 1
### get(getOption("device"))(width=15, height=10)
dev.new(width=15, height=10)
### X11(width=15, height=10)
###
WOUT = wlet.do(Xamp, DT, noctave=noctave, nvoice=nvoice, w0=w0, zscale=scale.def, col=pal, STAMP=STAMP)
message("Finished calculation for wlet.do")
faha = WOUT$baha
PE = WOUT$PE
pwlet2freqs(faha$noctave, faha$nvoice, DT, flip=faha$flip, pfreqs , plot=TRUE)
buttons = RPMG::rowBUTTONS(labs, col=colabs, pch=pchlabs)
PEAXBoxes = NULL
#### iloc = RPMG::ilocator(1, COL=rgb(1,0.8, 0.8), NUM=FALSE , YN=NSEL, style=1)
zloc = list(x=NULL, y=NULL)
sloc = zloc
#### message(paste("Button",K, Nclick,K[Nclick] ))
while(TRUE)
{
iloc = RPMG::ilocator(1, COL=rgb(1,0.8, 0.8), NUM=FALSE , YN=1, style=0)
Nclick = length(iloc$x)
if(Nclick>0)
{
zloc = list(x=c(zloc$x,iloc$x), y=c(zloc$y, iloc$y))
zenclick = length(zloc$x)
K = RPMG::whichbutt(iloc ,buttons)
sloc = zloc
}
else
{
Nclick = 0
K = 0
buttons = RPMG::rowBUTTONS(labs, col=rep(grey(.8), length(labs)), pch=rep("NULL", length(labs)))
title("Return to Calling Program")
break;
}
if(K[Nclick] == match("DONE", labs, nomatch = NOLAB))
{
#### PE =plotwlet(faha, Xamp, DT, zscale=scale.def, col=pal, STAMP=STAMP)
#### pwlet2freqs(faha$noctave, faha$nvoice, DT, flip=faha$flip, pfreqs , plot=TRUE)
buttons = RPMG::rowBUTTONS(labs, col=rep(grey(.8), length(labs)), pch=rep("NULL", length(labs)))
title("Return to Calling Program")
break;
}
if(K[Nclick] == match("ZBOUNDS", labs, nomatch = NOLAB))
{
message("Click pairs of points in window, end with middle mouse")
zloc = plocator(COL=rgb(1,0.8, 0.8), NUM=FALSE , YN=NSEL, style=-1)
message(paste('nclicks = ', length(zloc$x) ) )
numc = ncol(faha$img)
numf = nrow(faha$img)
szi = seq(from=1, to=(length(zloc$x)-1), by=2)
MYx = rep(NA, length(szi))
MYy = rep(NA, length(szi))
j = 1
zi = length(szi)
rect(zloc$x[zi], zloc$y[zi],zloc$x[zi+1],zloc$y[zi+1], border=2)
why1 = round(numc*(zloc$y[zi]-min(PE$why))/(diff(range(PE$why))))
ex1 = round(numf*(zloc$x[zi]-min(PE$x))/(diff(range(PE$x))))
why2 = round(numc*(zloc$y[zi+1]-min(PE$why))/(diff(range(PE$why))))
ex2 = round(numf*(zloc$x[zi+1]-min(PE$x))/(diff(range(PE$x))))
MAT = faha$img[ex1:ex2, why1:why2 ]
w = which.max(MAT)
wmin = which.min(MAT)
c1 = col(MAT)[w]+why1
r1 = row(MAT)[w]+ex1
PE$x[r1]
PE$y[c1]
points(PE$x[r1], PE$why[c1])
abline(v=PE$x[r1])
MYx[j] = PE$x[r1]
MYy[j] = PE$why[c1]
j = j+1
rDUMPLOC(list(x=MYx, y=MYy))
message(paste(sep=" ", "MAX=", MAT[w], "MIN=", MAT[wmin]))
dbounds = range(MAT)
message(dbounds)
### if(FALSE) { ### this code is removed
### RIM = range(faha$img, na.rm=TRUE)
### message("Type in the upper and lower Z Bounds for the plot")
###
### JEAD = readline(prompt="ZBounds: ")
### dbounds = as.numeric(unlist(strsplit(JEAD, split=" ")))
### if(length(dbounds)<2)dbounds=NULL
### }
zloc = list(x=NULL, y=NULL)
}
#################### POSTSCRIPT ##################
if(K[Nclick] == match("Postscript", labs, nomatch = NOLAB))
{
message(paste(sep=' ' ,"Start postscript file plotwlet"))
jdev = dev.cur()
plfname = RPMG::local.file("wlet","eps")
P = round(par('pin'))
postscript(file=plfname , width=P[1], height=P[2], paper = "special", horizontal=FALSE, onefile=TRUE,print.it=FALSE)
## postscript(file=plfname, horizontal=TRUE, print.it=FALSE, onefile=FALSE)
PE =plotwlet(faha, Xamp, DT, zscale=scale.def, col=pal, ygrid=FALSE, STAMP=STAMP)
pwlet2freqs(faha$noctave, faha$nvoice, DT, flip=faha$flip, pfreqs , plot=TRUE)
message(paste(sep=' ' ,"Done creating postscript file:", plfname))
dev.off()
dev.set(jdev)
zloc = list(x=NULL, y=NULL)
}
if(K[Nclick] == match("ContPS", labs, nomatch = NOLAB))
{
message(paste(sep=' ' ,"Start postscript file plotwlet"))
jdev = dev.cur()
plfname = RPMG::local.file("wletc","eps")
dbounds = range(faha$img )
P = round(par('pin'))
postscript(file=plfname , width=P[1], height=P[2], paper = "special",
horizontal=FALSE, onefile=TRUE,print.it=FALSE)
## postscript(file=plfname, horizontal=TRUE, print.it=FALSE, onefile=FALSE)
if(is.null(PEAXBoxes) )
{
PEAX=NULL
}
else
{
PEAX=PEAXBoxes
message("bef cont: PEAX:")
message(PEAX)
}
PE =contwlet(faha, Xamp, DT, clev=0.75, NLEV=20, zscale=scale.def, zbound=dbounds,
col=col, ygrid=FALSE, PEAX=PEAX)
pwlet2freqs(faha$noctave, faha$nvoice, DT, flip=faha$flip, pfreqs , plot=TRUE)
message(paste(sep=' ' ,"Done creating postscript file:", plfname))
dev.off()
dev.set(jdev)
zloc = list(x=NULL, y=NULL)
}
if( length(which(K[Nclick] == match(APALS, labs, nomatch = NOLAB)))>0 )
{
J = match(labs[K[Nclick]] , APALS )
## FUN = match.fun(TPALS[J])
## pal = FUN(NCOL)
pal = RPMG::Gcols(plow=5, phi=0, N=100, pal=TPALS[J])
PE = plotwlet(faha, Xamp, DT, zscale=scale.def, col=pal, ygrid=FALSE, STAMP=STAMP )
pwlet2freqs(faha$noctave, faha$nvoice, DT, flip=faha$flip, pfreqs , plot=TRUE)
buttons = RPMG::rowBUTTONS(labs, col=colabs, pch=pchlabs)
zloc = list(x=NULL, y=NULL)
}
if(K[Nclick]==match("RAW", labs, nomatch = NOLAB))
{
scale.def = 1
PE =plotwlet(faha, Xamp, DT, zscale=scale.def, col=pal, STAMP=STAMP)
pwlet2freqs(faha$noctave, faha$nvoice, DT, flip=faha$flip, pfreqs , plot=TRUE)
buttons = RPMG::rowBUTTONS(labs, col=colabs, pch=pchlabs)
zloc = list(x=NULL, y=NULL)
}
if(K[Nclick]==match("LOG", labs, nomatch = NOLAB))
{
scale.def = 2
PE =plotwlet(faha, Xamp, DT, zscale=scale.def, col=pal, STAMP=STAMP)
pwlet2freqs(faha$noctave, faha$nvoice, DT, flip=faha$flip, pfreqs , plot=TRUE)
buttons = RPMG::rowBUTTONS(labs, col=colabs, pch=pchlabs)
zloc = list(x=NULL, y=NULL)
}
if(K[Nclick]==match("SQRT", labs, nomatch = NOLAB))
{
scale.def = 3
PE =plotwlet(faha, Xamp, DT, zscale=scale.def, col=pal, STAMP=STAMP)
pwlet2freqs(faha$noctave, faha$nvoice, DT, flip=faha$flip, pfreqs , plot=TRUE)
buttons = RPMG::rowBUTTONS(labs, col=colabs, pch=pchlabs)
zloc = list(x=NULL, y=NULL)
}
if(K[Nclick]==match("CLIMB", labs, nomatch = NOLAB))
{
PE = plotwlet(faha, Xamp, DT, zscale=scale.def, col=pal, STAMP=STAMP)
pwlet2freqs(faha$noctave, faha$nvoice, DT, flip=faha$flip, pfreqs , plot=TRUE)
buttons = RPMG::rowBUTTONS(labs, col=colabs, pch=pchlabs)
clHOW = crc(faha$img, nbclimb=1000)
cfHOW = cfamily(clHOW)
SH = cfHOW$ordered
SH[SH==0] = NA
image(SH, add=TRUE, col=tomo.colors(100))
zloc = list(x=NULL, y=NULL)
}
if(K[Nclick]==match("INFO", labs, nomatch = NOLAB))
{
points(zloc$x[1:(zenclick-1)], zloc$y[1:(zenclick-1)], pch =3)
whyat = min(PE$y)+(diff(range(PE$y)))*(zloc$y[1:(zenclick-1)]-min(PE$why))/(diff(range(PE$why)))
exat = min(PE$x)+(diff(range(PE$x)))*(zloc$x[1:(zenclick-1)]-min(PE$x))/(diff(range(PE$x)))
CLICKEDpts = list(x=exat, y=whyat)
rDUMPLOC(CLICKEDpts)
zloc = list(x=NULL, y=NULL)
}
if(K[Nclick]==match("BOXZ", labs, nomatch = NOLAB))
{
zloc = plocator(COL=rgb(1,0.8, 0.8), NUM=FALSE , YN=NSEL, style=-1)
message(zloc)
numc = ncol(faha$img)
numf = nrow(faha$img)
szi = seq(from=1, to=(length(zloc$x)-1), by=2)
MYx = rep(NA, length(szi))
MYy = rep(NA, length(szi))
j = 1
for(zi in szi)
{
rect(zloc$x[zi], zloc$y[zi],zloc$x[zi+1],zloc$y[zi+1], border=2)
why1 = round(numc*(zloc$y[zi]-min(PE$why))/(diff(range(PE$why))))
ex1 = round(numf*(zloc$x[zi]-min(PE$x))/(diff(range(PE$x))))
why2 = round(numc*(zloc$y[zi+1]-min(PE$why))/(diff(range(PE$why))))
ex2 = round(numf*(zloc$x[zi+1]-min(PE$x))/(diff(range(PE$x))))
MAT = faha$img[ex1:ex2, why1:why2 ]
w = which.max(MAT)
c1 = col(MAT)[w]+why1
r1 = row(MAT)[w]+ex1
PE$x[r1]
PE$y[c1]
points(PE$x[r1], PE$why[c1])
abline(v=PE$x[r1])
MYx[j] = PE$x[r1]
MYy[j] = PE$why[c1]
j = j+1
}
PEAXBoxes = list(x=MYx, y=MYy)
rDUMPLOC(PEAXBoxes)
zloc = list(x=NULL, y=NULL)
}
}
message("DONE with Wlet")
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.