tuile <- function(mod = c(4,3), size = 40, shift = 0, linewidth = 1, cols = c("honeydew", "navy", "red")) { # Ce programme R a ete concu par Soren L. Buhl, professeur a l'Universite de Aalborg. # Vous etes libre de l'utiliser ou de le modifier a votre guise pourvu que ces trois lignes # soient presentes et que le programme ne soit pas utilise a des fins commerciales. # Les trois premiers parametres sont des entiers naturels, des entiers de Gauss # ou des paires dont les composantes sont a valeurs entieres. Exemples : # tuile(43, 86) # tuile(15 + 1i, 60, c(20, 30), cols=c("yellow", "blue", "cyan")) oldpar <- par(pty="s") if (length(mod) == 2) { mod <- mod[1] + mod[2] * 1i } if (!is.complex(mod)) { realcase <- TRUE a <- mod if (a < 1) stop("Pas un entier naturel") } else { realcase <- FALSE b <- Im(mod) if (b < 0) { a <- -b b <- Re(mod) if (b < 0) stop("La partie reelle doit etre positive") } else { a <- Re(mod) if (a < 0) stop("La partie reelle doit etre positive") } } if (length(size) == 1) m <- n <- size else { m <- size[1] n <- size[2] } if (length(shift) == 1) c <- d <- shift else { c <- shift[1] d <- shift[2] } if (realcase) M <- rtile(a, m, n, c, d) else M <- ctile(a, b, m, n, c, d) image(0:m + c, 0:n + d, M, col = cols, xlab = "", ylab = "", zlim=c(0,2)) if (linewidth > 0) { abline(v = 0:(m+1) + c - 0.5, col = "gray", lwd = linewidth) abline(h = 0:(n+1) + d - 0.5, col = "gray", lwd = linewidth) } if (realcase) val <- a else val <- paste(a, " + ", b, "i", sep="") par(cex.main=2) title(paste("Residus quadratiques modulo", val), line=2) par(oldpar) } rtile <- function(a, m, n, c, d) { M <- matrix(0, nrow = m+1, ncol = n+1) M0 <- matrix(0, nrow = a, ncol = a) for (x in 0:(a-1)) for (y in 0:(a-1)) { u <- (x^2 - y^2) %% a v <- (2*x*y) %% a M0[u+1, v+1] <- 1 } M0[1, 1] <- 2 for (x in 0:m) for (y in 0:n) { u <- (x+c) %% a + 1 v <- (y+d) %% a + 1 M[x+1, y+1] <- M0[u, v] } M } ctile <- function(a, b, m, n, c, d) { p <- a^2 + b^2 q <- floor(sqrt(p/2)) M <- matrix(0, nrow = m+1, ncol = n+1) imax <- floor(sqrt(2*p)*m/p) jmax <- floor(sqrt(2*p)*n/p) for (x in c(1:q, (-q):(-1), 0)) for (y in q:0) { u <- x^2 - y^2 v <- 2*x*y r <- (a*(u - c) + b*(v - d)) %% p s <- (a*(v - d) - b*(u - m - c)) %% p u0 <- (a*r - b*(s - b*m))/p + c v0 <- (b*r + a*(s - b*m))/p + d for (i in 0:imax) for (j in 0:jmax) { u <- u0 + i*a - j*b v <- v0 + i*b + j*a if (u >= c && u <= m+c && v >= d && v <= n+d) M[u - c + 1, v - d + 1] <- ifelse(x==0 && y==0, 2, 1) } } M }