[R] Re:
Kjetil Halvorsen
khal at alumni.uv.es
Sun Nov 29 18:55:16 CET 1998
Try the following:
Quincunx.prg <-
function(trials = 100)
{
# graphsheet(pages = "Off")
# Init:
par(mfrow = c(1, 2))
xpoints <- seq(1, 25, 1)
ypoints <- seq(1, 25, 1)
xheights <- rep(0, 25)
mcol <- 2
xy <- expand.grid(xpoints, ypoints)
xx <- seq(1, 25, 2)
yy <- rep(0, 25)
ypos <- ypoints + 0.4
HT <- c("H", "T")
# First loop:
for(j in 1:trials) {
plot(xpoints, ypoints, type = "n", xlab = "", ylab = "", axes = F,
main =
"Galton's Quincunx")
cat("")
points(x = xy[, 1], y = xy[, 2], pch = 5, col = 1)
cat("")
marble.path <- sample(HT, 25, replace = T)
xpos <- 13
points(xpos, ypos[25], pch = 16, col = 8)
cat("")
for(i in 1:24) {
if(marble.path[i] == "H")
xpos <- xpos + 1
else xpos <- xpos - 1
if(xpos > 25)
xpos <- 25
if(xpos < 0)
xpos <- 0
points(xpos, ypos[25 - i], pch = 16, col = 8)
cat("")
}
xheights[xpos] <- xheights[xpos] + 1
text(x = xpoints[xx], y = yy[xx], labels = as.character(xheights)[xx])
cat("")
plot(xpoints[xx], xheights[xx], ylim = c(0, trials/2), type = "h",
main =
paste("Trials = ", j, sep = ""), ylab = "Frequency",
xlab = "X")
cat("")
# guiLocator(-1)
cat("")
}
}
Note all the dummy cat("") calls, after calls to functions producing
graphical output. (thats the trick Guido M. told me) It is still not
perfect, but at least works.
Kjetil Halvorsen
Niels Waller wrote:
>
> Dear Friends,
>
> Yesterday I posed a question to the list concerning the possibility of doing
> animation examples in R. Here is an example S-Plus (4.5 for Windows ) that
> I wrote to illustrate my problem. If I try this in R (comment out the
> graphsheet and guilocator calls) I don't see my results until after the
> function has iterated through the 100 trials. I would like to plot each
> iteration.
>
> Any suggestions would be greatly appreciated. I am running R 63.0 (Guido's
> latest version for Windows).
>
> Niels
>
> > Quincunx.prg
> function(trials = 100)
> {
> graphsheet(pages = "Off")
> par(mfrow = c(1, 2))
> xpoints <- seq(1, 25, 1)
> ypoints <- seq(1, 25, 1)
> xheights <- rep(0, 25)
> mcol <- 2
> xy <- expand.grid(xpoints, ypoints)
> xx <- seq(1, 25, 2)
> yy <- rep(0, 25)
> ypos <- ypoints + 0.4
> HT <- c("H", "T")
> for(j in 1:trials) {
> plot(xpoints, ypoints, type = "n", xlab = "", ylab = "", axes = F, main =
> "Galton's Quincunx")
> points(x = xy[, 1], y = xy[, 2], pch = 5, col = 1)
> marble.path <- sample(HT, 25, replace = T)
> xpos <- 13
> points(xpos, ypos[25], pch = 16, col = 8)
> for(i in 1:24) {
> if(marble.path[i] == "H")
> xpos <- xpos + 1
> else xpos <- xpos - 1
> if(xpos > 25)
> xpos <- 25
> if(xpos < 0)
> xpos <- 0
> points(xpos, ypos[25 - i], pch = 16, col = 8)
> }
> xheights[xpos] <- xheights[xpos] + 1
> text(x = xpoints[xx], y = yy[xx], labels = as.character(xheights)[xx])
> plot(xpoints[xx], xheights[xx], ylim = c(0, trials/2), type = "h", main =
> paste("Trials = ", j, sep = ""), ylab = "Frequency",
> xlab = "X")
> guiLocator(-1)
> }
> }
>
> ********************************************************************
> Niels Waller, Ph.D.
> Associate Professor
>
> Address: One Shields Avenue Phone: (530) 752-4459
> Department of Psychology
> University of California
> Davis, CA 95616
>
> Internet:
> http://psychology.ucdavis.edu/waller/default.html
>
> ********************************************************************
>
> -.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
> r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
> Send "info", "help", or "[un]subscribe"
> (in the "body", not the subject !) To: r-help-request at stat.math.ethz.ch
> _._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
More information about the R-help
mailing list