common.R (5464B)
1 source(file.path("R", "waves.R")) 2 source(file.path("R", "transform.R")) 3 4 arma.qqplot_grid <- function (dir, params, titles, ...) { 5 wave_params <- arma.load_wave_parameters(dir, params) 6 i <- 1 7 for (name in names(wave_params)) { 8 arma.qqplot(wave_params[[name]], 100, titles[[i]], ...) 9 i <- i + 1 10 } 11 } 12 13 arma.wavy_plot <- function (data, t, ...) { 14 slice <- data[data$t == t,] 15 x <- unique(slice$x) 16 y <- unique(slice$y) 17 z <- with(slice, { 18 n <- sqrt(length(z)) 19 out <- matrix(nrow=n, ncol=n) 20 out[cbind(x, y)] <- z 21 out 22 }) 23 nrz <- nrow(z) 24 ncz <- ncol(z) 25 # Create a function interpolating colors in the range of specified colors 26 jet.colors <- colorRampPalette( c("blue", "green") ) 27 # jet.colors <- colorRampPalette(c("blue", "cyan", "white")) 28 # Generate the desired number of colors from this palette 29 nbcol <- 100 30 color <- jet.colors(nbcol) 31 # Compute the z-value at the facet centres 32 zfacet <- z[-1, -1] + z[-1, -ncz] + z[-nrz, -1] + z[-nrz, -ncz] 33 # Recode facet z-values into color indices 34 facetcol <- cut(zfacet, nbcol) 35 persp(x, y, z, phi=30, theta=30, col=color[facetcol], ...) 36 } 37 38 arma.skew_normal_1_plot <- function(x, params) { 39 data <- mapply( 40 function (s, k) arma.skew_normal_1(x, s, k), 41 params$skewness, 42 params$kurtosis 43 ) 44 plot.new() 45 plot.window(xlim=range(x),ylim=range(data)) 46 axis(1); axis(2); box() 47 for (i in seq_len(ncol(data))) { 48 d <- data[,i] 49 lines(x, d, lty=paste(params$linetypes[[i]])) 50 } 51 title(xlab="x", ylab="y") 52 } 53 54 55 arma.skew_normal_2_plot <- function(x, params) { 56 data <- mapply( 57 function (a) arma.skew_normal_2(x, a), 58 params$alpha 59 ) 60 plot.new() 61 plot.window(xlim=range(x),ylim=range(data)) 62 axis(1); axis(2); box() 63 for (i in seq_len(ncol(data))) { 64 d <- data[,i] 65 lines(x, d, lty=paste(params$linetypes[[i]])) 66 } 67 title(xlab="x", ylab="y") 68 } 69 70 arma.fmt <- function(x, ndigits) { 71 format(round(x, ndigits), nsmall=ndigits) 72 } 73 74 arma.plot_partitions <- function() { 75 library("rgl") 76 part_alpha <- 0.2 77 part_col <- "grey" 78 part_size <- 2 79 sc <- 0.8 80 off <- part_size * (1-sc)/2 81 bcol <- "grey" 82 balpha <- 1.0 83 sc2 <- 1.0 - sc 84 off2 <- part_size * sc/2 85 ccol <- "red" 86 calpha <- 1.0 87 # whole parts 88 a1 <- cube3d(color=part_col, alpha=part_alpha) 89 a2 <- cube3d(color=part_col, alpha=part_alpha) 90 a3 <- cube3d(color=part_col, alpha=part_alpha) 91 shade3d(translate3d(a1, 0*part_size, 0, 0)) 92 shade3d(translate3d(a2, 1*part_size, 0, 0)) 93 shade3d(translate3d(a3, 2*part_size, 0, 0)) 94 # stripped parts 95 b1 <- scale3d(cube3d(color=bcol, alpha=balpha), sc, sc, sc) 96 b2 <- scale3d(cube3d(color=bcol, alpha=balpha), sc, sc, sc) 97 b3 <- scale3d(cube3d(color=bcol, alpha=balpha), sc, sc, sc) 98 shade3d(translate3d(b1, 0 + off, off, off)) 99 shade3d(translate3d(b2, 2 + off, off, off)) 100 shade3d(translate3d(b3, 4 + off, off, off)) 101 # overlap intervals 102 c1 <- scale3d(cube3d(color=ccol, alpha=calpha), sc2, 1, 1) 103 c2 <- scale3d(cube3d(color=ccol, alpha=calpha), sc2, 1, 1) 104 c3 <- scale3d(cube3d(color=ccol, alpha=calpha), sc2, 1, 1) 105 shade3d(translate3d(c1, 0 + off2, 0, 0)) 106 shade3d(translate3d(c2, 2 + off2, 0, 0)) 107 shade3d(translate3d(c3, 4 + off2, 0, 0)) 108 } 109 110 arma.plot_ramp_up_interval <- function(label="Ramp-up interval") { 111 zeta <- read.csv(file.path("build", "arma-benchmarks", "verification", "standing_wave", "zeta.csv")) 112 t <- round(mean(zeta$t)) 113 res <- arma.wavy_plot(zeta, t, scale=FALSE) 114 library("grDevices") 115 ax <- 7 116 ay <- 7 117 my <- max(zeta$y) 118 lines(trans3d( 119 c(0, 0, ax, ax, 0), 120 c(0, my, my, 0, 0), 121 c(0, 0, 0, 0, 0), 122 pmat=res 123 ), col="#c00000", lwd=4) 124 text(trans3d(0, my/2, max(zeta$z)*3.0, pmat=res), label, col="black", font=2) 125 from <- trans3d(0, my/2, max(zeta$z)*2.5, pmat=res) 126 to <- trans3d(0, my/2, max(zeta$z)*0.05, pmat=res) 127 arrows(from$x, from$y, to$x, to$y, lwd=2, angle=10, length=0.1, col="black") 128 } 129 130 arma.plot_factory_vs_openmp <- function(...) { 131 args <- list(...) 132 perf <- read.csv(file.path("data", "performance", "factory-vs-openmp.csv")) 133 scale <- 10 ** args$power 134 x <- perf$nt * perf$nx * perf$ny / scale 135 plot.new() 136 plot.window(xlim=range(x),ylim=range(perf[c("openmp", "factory")])) 137 pts <- pretty(x) 138 axis(1, at=pts, labels=sapply(pts, function(x) {as.expression(bquote(.(x) %.% 10 ** .(args$power)))})) 139 axis(2) 140 box() 141 lines(x, perf$openmp, lty="solid") 142 lines(x, perf$factory, lty="dashed") 143 title(xlab=args$xlab, ylab=args$ylab) 144 } 145 146 arma.plot_factory_vs_openmp_overlap <- function(...) { 147 args <- list(...) 148 openmp <- read.csv(file.path("data", "performance", "overlap-openmp.csv"), na.strings="") 149 factory <- read.csv(file.path("data", "performance", "overlap-factory.csv"), na.strings="") 150 openmp$t <- (openmp$t - min(openmp$t)) / args$scale 151 factory$t <- (factory$t - min(factory$t)) / args$scale 152 plot.new() 153 plot.window(xlim=range(c(factory$t, openmp$t)),ylim=range(0, 5)) 154 axis(1) 155 axis(2, at=c(1, 3), labels=args$labels, las=1, hadj=1) 156 # OpenMP 157 lines(openmp$t, rep.int(3, length(openmp$t))) 158 openmp_pts <- openmp[!is.na(openmp$mark),] 159 openmp_y <- rep.int(3, length(openmp_pts$t)) 160 points(openmp_pts$t, openmp_y) 161 text(openmp_pts$t, openmp_y, labels=openmp_pts$mark, pos=c(3, 3, 1, 1)) 162 # Factory 163 lines(factory$t, rep.int(1, length(factory$t))) 164 factory_pts <- factory[!is.na(factory$mark),] 165 factory_y <- rep.int(1, length(factory_pts$t)) 166 points(factory_pts$t, factory_y) 167 text(factory_pts$t, factory_y, labels=factory_pts$mark, pos=c(3, 1, 3, 1)) 168 title(xlab=args$xlab) 169 }