[Stpp-commits] r19 - pkg/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Oct 29 17:05:24 CET 2008


Author: barryrowlingson
Date: 2008-10-29 17:05:24 +0100 (Wed, 29 Oct 2008)
New Revision: 19

Modified:
   pkg/R/stani.R
Log:
aspect ratio now working, also returns slider values when slider dialog is killed

Modified: pkg/R/stani.R
===================================================================
--- pkg/R/stani.R	2008-10-28 14:31:54 UTC (rev 18)
+++ pkg/R/stani.R	2008-10-29 16:05:24 UTC (rev 19)
@@ -26,6 +26,9 @@
   ## start drawing again:
   par3d(skipRedraw=FALSE)
 
+  ## update the slider positions
+  .store(o)
+  
   ## and return the modified object:
   return(o)
 }
@@ -41,13 +44,13 @@
   rp.slider(stan.panel, t, title = "time", from=tlim[1], to=tlim[2], action = .stan3d.redraw,showvalue=TRUE)
   rp.slider(stan.panel, width, title = "window", from=0, to=diff(tlim), action = .stan3d.redraw,showvalue=TRUE)
   rp.button(stan.panel,action=function(p){par3d(userMatrix = rotationMatrix(0, 1,0,0));return(p)},title="align time axis")
-  rp.button(stan.panel,action=.quitStore,title="quit",quitbutton=TRUE)
+  rp.button(stan.panel,action=.store,title="quit",quitbutton=TRUE)
   rp.do(stan.panel, .stan3d.redraw)
   rp.block(stan.panel)
   return(e)
 }
 
-.quitStore = function(panel){
+.store = function(panel){
  assign("t",panel$t,env=panel$e)
  assign("width",panel$width,env=panel$e)
  return(panel)
@@ -60,7 +63,7 @@
     ## default colouring scheme:
     states=list(
       s1=list(col="blue",radius=1/80,alpha=0.5,lit=FALSE),
-      s2=list(col="red",radius=1/20,alpha=0.5,lit=FALSE),
+      s2=list(col="red",radius=1/30,alpha=0.5,lit=FALSE),
       ## still-to-come points are invisible (alpha=0)
       s3=list(col="yellow",alpha=0.0,radius=1/80,lit=FALSE)
       )
@@ -68,24 +71,28 @@
       states$s1=states$s2
     }
   }
+
+  maxRadius = max(states$s1$radius,states$s2$radius,states$s3$radius)
+  xr = range(xyt[,1],na.rm=TRUE)
+  yr = range(xyt[,2],na.rm=TRUE)
+  tr = range(xyt[,3],na.rm=TRUE)
+  diag=sqrt(diff(xr)^2+diff(yr)^2+diff(tr)^2)
+
+  states$s1$radius=states$s1$radius*diag
+  states$s2$radius=states$s2$radius*diag
+  states$s3$radius=states$s3$radius*diag
+    
+  .setPlot(xr[1],xr[2],yr[1],yr[2],tr[1],tr[2],maxRadius)
+
   xyt=data.frame(xyt)
   xyt$id=NA
   ## initially all points will need redrawing:
   xyt$state=-1
 
-  xlim=.ranger(xyt[,1])
-  ylim=.ranger(xyt[,2])
-  tlim=.ranger(xyt[,3])
-
-  plot3d(xlim,ylim,tlim,xlab="",ylab="",zlab="",axes=FALSE,type="n")
-  par3d(FOV=1)
-  ## aspect ratio...
-  AR=diff(xlim)/diff(ylim)
-  aspect3d(AR,1,1)
-  par3d(userMatrix = rotationMatrix(0, 1,0,0))
+  
   ## these points will get redrawn immediately... probably a better way to do this:
   for(i in 1:(dim(xyt)[1])){
-    xyt[i,4]=points3d(xyt[,1],xyt[,2],xyt[,3])
+    xyt[i,4]=points3d(xyt[,1],xyt[,2],xyt[,3],alpha=0.0)
   }
   env = .rp.stan3d(xyt,tlim,twid,states)
   ret=list()
@@ -101,3 +108,22 @@
   return(lim)
 }
 
+.setPlot=function(xmin,xmax,ymin,ymax,tmin,tmax,radius=1/20){
+  require(rgl)
+  diag=sqrt((xmax-xmin)^2+(ymax-ymin)^2+(tmax-tmin)^2)
+  xr=c(xmax,xmin)+c(radius*(xmax-xmin),-radius*(xmax-xmin))*10
+  yr=c(ymax,ymin)+c(radius*(ymax-ymin),-radius*(ymax-ymin))*10
+  
+
+  plot3d(xr,yr,c(tmin,tmax),type="n",col="red",box=FALSE,axes=TRUE,xlab="x",ylab="y",zlab="t")
+  axis3d('x-')
+  axis3d('y-')
+  axis3d('z-')
+  par3d(FOV=1)
+  AR=(xmax-xmin)/(ymax-ymin)
+  aspect3d(AR,1,1)
+  par3d(userMatrix = rotationMatrix(0, 1,0,0))
+
+}
+
+  



More information about the Stpp-commits mailing list