File: panel.dice.R

package info (click to toggle)
r-cran-teachingdemos 2.13-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,168 kB
  • sloc: makefile: 2
file content (29 lines) | stat: -rw-r--r-- 882 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
"panel.dice" <-
function(x,y){
  tmp.cols <- c("Red","Green","Blue","Black","Yellow",
                "Purple","Orange","Brown","Grey","White")
  box.x <- c( 0.1, 0.9, 0.9, 0.1, 0.1 )
  box.y <- c( 0.1, 0.1, 0.9, 0.9, 0.1 )
  pips.x <- c( 0.5, 0.3, 0.7, 0.3, 0.7, 0.3, 0.7 )
  pips.y <- c( 0.5, 0.7, 0.3, 0.3, 0.7, 0.5, 0.5 )
  xx <- ceiling(sqrt(length(x)))
  yy <- ceiling( length(x)/xx )
  for( i in seq(along=x) ){
    xo <- y[i] %% xx
    yo <- yy-1-(y[i] %/% xx)
    lattice::llines( box.x+xo, box.y+yo,col=tmp.cols[i] )
    which <- c( x[i] %%2 == 1, x[i] > c(1,1,3,3,5,5) )
    tmp.x <- pips.x[which]
    tmp.y <- pips.y[which]
    if( runif(1) < 0.5 ) {
      tmp.x <- 1-tmp.x
    }
    if( runif(1) < 0.5 ) {
      tmp <- tmp.x
      tmp.x <- tmp.y
      tmp.y <- tmp
    }
    lattice::lpoints( tmp.x+xo, tmp.y+yo, pch=16,col='black')
  }
}