% cp New Report: Thu Mar  8 15:52:37 2018 

% New Report: Fri May 13 10:17:27 2016 

% New Report: Thu May 12 15:55:04 2016 

% New Report: Tue May 20 09:39:33 2008 

% New Report: Mon May 19 20:03:59 2008 



\documentclass{article}
\usepackage{noweb}
%\usepackage{psfig}
\textwidth=16.5cm
\noweboptions{webnumbering,smallcode,longchunks}
\sloppy
\textheight=25cm
\topmargin=-30mm
\oddsidemargin=0mm
\parindent=0mm
\author{H. P. Wolf}
\date{20. Mai 2008, 180308, file: spin3R.rev} 
\title{Punktwolkenrotation}
\begin{document}
\maketitle
@

Die in diesen Abschnitt definierte Funktion ermöglicht
dem Anwender eine Punktwolke interaktiv zu drehen und
zu betrachten.

@
<<start>>=
<<definiere [[spin3R]]>>

@
<<definiere Hilfe von [[spin3R]]>>=
\name{spin3R}
\alias{spin3R}
\title{ spin3R }
\description{
  Simple spin function to rotate and to inspect 
  a 3-dimensional cloud of points
}
\usage{
  spin3R(x, alpha = 1, delay = 0.015, na.rm=FALSE)
}
\arguments{
  \item{x}{ \code{(nx3)}-matrix of points }
  \item{alpha}{ angle between successive projections }
  \item{delay}{ delay in seconds between two plots }
  \item{na.rm}{ if TRUE 'NA' values are removed otherwise exchanged by mean}
}
\details{
  \code{spin3R} computes two-dimensional projections 
  of \code{(nx3)}-matrix \code{x} and plots them
  on the graphics device. The cloud of points is rotated
  step by step. The rotation is defined by a tcl/tk control 
  widget. \code{spin3R} requires tcl/tk package of R.
}
\references{ 
   Cleveland, W. S. / McGill, M. E. (1988): Dynamic Graphics
   for Statistics. Wadsworth & Brooks/Cole, Belmont, California.
}
\author{ Peter Wolf }
\note{  version 05/2008 }
\seealso{ \code{spin} of S-Plus }
\examples{
  xyz<-matrix(rnorm(300),100,3)
  # now start:     spin3R(xyz) 
}
\keyword{misc}

@
<<definiere [[spin3R]]>>=
spin3R <- function(x, alpha=1, delay=.015, na.rm=FALSE){
 #################################################################
 # spin3R: simple spin function to rotate a 3-dim cloud of points#
 # pwolf 070831 / 080520                                             #
 #                                                               #
 # arguments:                                                    #
 #                                                               #
 #  x             (nx3)-matrix of points                         #
 #  alpha         arc of rotation                                #
 #  delay         sleeping time between rotations                #
 #                                                               #
 #################################################################
if(ncol(x)!=3) { print("Error: data matrix must have 3 columns"); return() }
 if (!requireNamespace("tcltk", quietly = TRUE)) stop("package 'tcltk' is needed") #190715
 <<generiere Steuerungsfenster>>
 <<definiere Rotationen>>
 <<initialisiere Plot>>
 <<starte Endlosschleife>>
 <<entferne Steuerungsfenster>>
} # end of spin3R

@
<<generiere Steuerungsfenster>>=
bw <- 4
topl<-tktoplevel();   tkwm.geometry(topl,"+0+500")
f1 <- tkframe(topl);f2 <- tkframe(topl);f3 <- tkframe(topl)
f4 <- tkframe(topl);f5 <- tkframe(topl);tkpack(f1,f2,f3,f4,f5)
f6 <- tkframe(topl); tkpack(f6)
b12 <- tkbutton(f1, relief="ridge",  width=bw, text="up")
b21 <- tkbutton(f2, relief="ridge",  width=bw, text="left")
b22 <- tklabel(f2,  relief="flat",   width=bw)
b23 <- tkbutton(f2, relief="ridge",  width=bw, text="right")
b32 <- tkbutton(f3, relief="ridge",  width=bw, text="down")
b41 <- tkbutton(f4, relief="ridge",  width=bw, text="clock")
b42 <- tklabel(f4,  relief="flat",   width=bw)
b43 <- tkbutton(f4, relief="ridge",  width=bw, text="cclock")
b51 <- tkbutton(f5, relief="flat", width=bw, text="------")
b52 <- tklabel(f5,  relief="flat",   width=bw, height=bw)
b53 <- tkbutton(f5, relief="flat", width=bw, text="------")
b61 <- tkbutton(f6, relief="raised", width=3*bw, text="EXIT")
tkpack(b12,b32)
tkpack(b21,b22,b41,b42,b51,b52,side="left")
tkpack(b23,b43,b53,side="right")
tkpack(b61)

@
Für die Rotation bezüglich zwei Achsen wird nur eine 2$\times$2-Rotationsmatrix
benötigt.
<<definiere Rotationen>>=
alpha<-alpha/360*2*pi; ca<-cos(alpha); sa<-sin(alpha)
rot<-matrix(c(ca,-sa,sa,ca),2,2)

@
[[x]] hält die Daten, [[x.o]] die Originaldaten, [[xa]] die 2-dim Projektionen.
Für die Anschaulichkeit wird ein Andeutung der Achsen mitgeliefert:
[[A]] beschreibt die Achsen, [[A.o]] die Originalachsen, [[Aa]] den
darzustellenden Teil.
<<initialisiere Plot>>=
n <- nrow(x)
if(any(is.na(x))){
  if(na.rm){ x<-x[!apply(is.na(x),1,any),,drop=FALSE]
    print("Warning: NA elements have been removed!!")
  }else{
    xy.means<-colMeans(x,na.rm=TRUE)
    for(j in 1:ncol(x)) x[is.na(x[,j]),j]<-xy.means[j]
    print("Warning: NA elements have been exchanged by mean values!!")
  }  
}
x  <- x - matrix(apply(x,2,min),n,3,TRUE)
x.o<-x<-x / matrix(apply(x,2,max),n,3,TRUE) - 0.5;                
xa <- x[,2:3]
A.o<-A<-0.5*matrix(c(1,0,0, 0,0,0, 0,1,0, 0,0,0, 0,0,1),5,3,TRUE)
Aa <- A[,2:3]
plot(xa, xlim=.7*c(-1,1), ylim=.7*c(-1,1),bty="n",
          pch=20, xlab="",ylab="",xaxt="n",yaxt="n",type="n")
lines(Aa)

@
<<starte Endlosschleife>>=
i <- 0               ; i.max<-60
cat("exit by button Exit\n")
delay<-.01
if(delay < 0.015) delay <- 0.005 
colors<-rev(rainbow(ncolors<-30))

# first view
ind<-c(1,3); x0 <- x; x0[,ind] <- x[,ind]%*%rot; xb <- x0[,2:3]
xcol<-colors[ceiling((x0[,1]+1)*0.5*ncolors)]
points(xb, pch=20, col=xcol,cex=2*(1.5+x0[,1]))
cex <- .3*2*(1.5+x0[,1])
points(xb + 0.005 * cex, pch=20, col="white",cex=cex^2);
xa<-x0[,2:3]
# info box
tkmessageBox(title="ready for spinning?", # icon="yesno",
             message=paste("move cursor to with the desired rotation",
                           "move cursor on 'EXIT' to exit",sep="\n"))	
# loop
repeat{
  Sys.sleep(delay) ##; if(  ((i<-i+1)>i.max) ){ break }
  cx<-tclvalue(tkwinfo("pointerx",topl))
  cy<-tclvalue(tkwinfo("pointery",topl))
  widget.id<-tclvalue(tkwinfo("containing",cx,cy))
  choice<-sub(paste(sep="",topl$ID,".*([1-6].[1-6]$)"),"\\1",widget.id)
  if(choice=="6.1") break
  switch(choice,
   "1.1" = ind<-c(1,3), "2.1" = ind<-c(2,1), "2.3" = ind<-c(1,2),
   "3.1" = ind<-c(3,1), "4.1" = ind<-c(3,2), "4.3" = ind<-c(2,3), next
  )
  x[,ind] <- x[,ind]%*%rot; A[,ind] <- A[,ind]%*%rot
  xb<-x[,2:3]; Ab<-A[,2:3] #; dcol<-c(rep("black",n),rep("white",n))
  xcol<-colors[ceiling((x[,1]+1)*0.5*ncolors)]
  dcol<-c(xcol,rep("white",n))
  points(rbind(xb,xa), pch=20, col=dcol,cex=2*c(1.5+x[,1],rep(3,n))) # 1*
#  points(xb, pch=20, col="black",cex=1.5+x[,1]); points(xa, pch=20, cex=3, col="white")
  lines(Aa, col="white",lwd=3)
  points(xb, pch=20, col=xcol,cex=2*(1.5+x[,1])) # 1*
  cex <- .3*2*(1.5+x[,1])
  points(xb + 0.005 * cex, pch=20, col="white",cex=cex^2);
  lines(Ab, col="black")
  xa<-x[,2:3]; Aa<-A[,2:3]
}
print(cex)
@
<<*>>=
axis(1); axis(2)
@
<<entferne Steuerungsfenster>>=
tkdestroy(topl)
"control widget closed"

@
Testbeispiel:

Zufallsstichprobe
<<test random sample>>=
<<definiere [[spin3R]]>>
x<-matrix(sample(1:333),111,3)
spin3R(x)

@
Randu
<<test randu>>=
# show planes of "randu" random number generator:
random.gkg<-function(n.max,m,a,r,x){
   res<-1:n.max
   for(i in 1:n.max){res[i] <- x <- (a*x+r) %% m }; res
}
# randu:
res<-random.gkg(1000, 2^31, 65539, 0, 100000)/2^31 
# define cloud of points: 
xyz<-cbind(res[-c(length(res),length(res)-1)],
              res[-c(1,length(res))],res[-c(1:2)])
spin3R(xyz)


@
<<extract R code>>=
tangleR("spin3Ra.rev",expand.roots="definiere [[spin3R]]")

@
Some tcl/tk special:
<<how to find the widget the cursor is pointing on>>=
txt<-paste("set x [winfo pointerx .]","set y [winfo pointery .]",
           "set win [winfo containing $x $y]", sep="\n")
  .Tcl(txt)
  widget.id<-tclvalue(.Tcl("set win"))
# or:
  cx<-tclvalue(tkwinfo("pointerx",topl))
  cy<-tclvalue(tkwinfo("pointery",topl))
  widget.id<-tclvalue(tkwinfo("containing",cx,cy))
# original TCL-Code:
set x [winfo pointerx .]
set y [winfo pointery .]
puts -nonewline "Mouse pointer at ($x,$y) which is "
set win [winfo containing $x $y]
if {$win eq ""} {
    puts "over no window"
} else {
    puts "over $win"
}

@

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\end{document}

@

