# 
# drawing spirals
#


#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
spirale0 <- function(
          prh=c(0,1),
          pth=c(0,1),
          tra=c(0,0),
          nbt=2.5,
          pre=100)
{
#DESCRIPTION
# draws an elementary spiral from
# a parametric definition of a curve
# mixing polar (rho,theta) and
# cartesian defintion through
# a unique parameter that we will
# call "par".
#
# "par" is varied from 0 to nbt*(2*pi) with
#       "pre" step by (2*pi),
# from it, "rho" is defined by the polynom "prh",
#          "theta" by the polynom "pth",
# finally, each point is translated by the
#       vector "tra".
#KEYWORDS spiral, drawing
#REQUIRED ARGUMENTS
#OPTIONAL ARGUMENTS
# "prh" precises "rho" as a function of "par" 
#       (see DESCRIPTION):
#  prh[1] + prh[2]*par + ... + prh[r]*par^(r-1)
#  where r = length(prh).
#
# "pth" idem than "prh" for theta. Obviously the
#  lengths of "prh" and "pth" can differ.
#
# "tra" vector defining the final translation
#
# "nbt" number of rounds of the spiral if "pth" 
#  is c(a,1) whatever is "a". Indeed, the number
#  of rounds is with respect to "par".
#
# "pre" number of steps given to "par" to
#   a complete round. Note that small values of
#   this parameter (for instance 5) gives nice
#   angular spirals.
#VALUE
# a list of three components
# $val: a N x 2 matrix the columns of which
#   are respectively the abscissas and
#   ordinates of the desired spiral
# $spi: a character string containing
#       the 3 parameters describing the
#       spiral traits (prh,pth,tra)
# $dra: a character string containing
#       the 2 parameters describing the
#       drawing traits (nbt,pre)
#REFERENCE
#SEE ALSO
#AUTHOR J.-B. Denis
#CREATED April 26, 2002
#LAST MODIFIED April 27, 2002
#
#
# spiral arguments
aprh <- paste(as.character(prh),collapse="|");
apth <- paste(as.character(pth),collapse="|");
atra <- paste(as.character(tra),collapse="|");
aspir <- paste("prh =",aprh,
             " &  pth =",apth,
             " &  tra =",atra);
# drawing arguments
anbt <- as.character(nbt);
apre <- as.character(pre);
adraw <- paste("nbt =",anbt,
             " &  pre =",apre);
thetastep <- 2*pi / pre;
stepnumber <- pre * nbt;
res <- matrix(0,stepnumber+1,2);
res[1,] <- tra;
for (jbd in 1:stepnumber) {
 theta <- jbd * thetastep;
 prho <- 0;
 if (length(prh) > 0) {
  for (jd in 1:length(prh)) {
   prho <- prho + prh[jd]*theta^(jd-1);
   }
  }
 else {
  error("Mauvais Argument 'prh' dans spirale0");
  }
 pthe <- 0;
 if (length(pth) > 0) {
  for (jd in 1:length(pth)) {
   pthe <- pthe + pth[jd]*theta^(jd-1);
   }
  }
 else {
  error("Mauvais Argument 'pth' dans spirale0");
  }
 res[jbd+1,1] <- cos(pthe) * prho + tra[1];
 res[jbd+1,2] <- sin(pthe) * prho + tra[2];
 }
res <- list(val=res,spi=aspir,dra=adraw);
res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
spirale1 <- function(
          prh=c(0,1),
          pth=c(0,1),
          tra=c(0,0),
          nbt=2.5,
          pre=100)
{
#DESCRIPTION
# idem as "spirale0", but the elementary spiral
#      is completed by the symmetrical spiral
#      with respect to its central point.
#      In fact half a round is added to the 
#      second elementary spiral to allow and
#      easy color filling. This can changed 
#      putting into the code "suprou" to zero.
#KEYWORDS spiral, drawing
#REQUIRED ARGUMENTS
#OPTIONAL ARGUMENTS
# see "spirale0": the arguments are identical
#VALUE
# a list of three components
# $val: a N x 2 matrix the columns of which
#   are respectively the abscissas and
#   ordinates of the desired spiral.
#   Of course, the order of the points is
#   such that the a direct call to plot
#   can be made
# $spi: a character string containing
#       the 3 parameters describing the
#       spiral traits (prh,pth,tra)
# $dra: a character string containing
#       the 2 parameters describing the
#       drawing traits (nbt,pre)
#REFERENCE
#SEE ALSO spirale0
#AUTHOR J.-B. Denis
#CREATED April 27, 2002
#LAST MODIFIED April 28, 2002
#
#
suprou <- 0.5; # for color filling
#
sp1 <- spirale0(prh,pth,tra,nbt,pre);
sp2 <- spirale0(c(prh[1],-prh[2]),pth,tra,nbt+suprou,pre);
npt <- nrow(sp1$val);
res <- list(val=rbind(sp1$val[npt:1,],sp2$val),
            spi=sp1$spi,dra=sp1$dra);
res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
spirale2 <- function(nbs=5,
          prh=c(0,1),
          pth=c(0,1),
          tra=c(0,0),
          nbt=2.5,
          pre=100,
          ferm=FALSE)
{
#DESCRIPTION
# idem as "spirale0", but the elementary spiral
#      is reproduced "nbs" times in a symmetrical 
#      way.
# It is a kind of generalization of spirale1
#KEYWORDS spiral, drawing
#REQUIRED ARGUMENTS
#OPTIONAL ARGUMENTS
# "nbs" number of elementary spiral to drax
# for the following 6 arguments, see "spirale0"
# "ferm" when TRUE, the curves drawing each 
#        elementary spiral is closed allowing
#        further colorations of the strips
#        generated by every two adjacent
#        spirals.
#        It is not guaranted that for all
#        values of parameters when "pre" is
#        small that the closure will be opimal
#VALUE
# a list of three components
# $val: a N x 2 x nbs arrays. Each of the
#   nbs slices correspond to an elementary
#   spiral.
# $spi: a character string containing
#       the 4 parameters describing the
#       spiral traits (prh,pth,tra)
# $dra: a character string containing
#       the 3 parameters describing the
#       drawing traits (nbt,pre,ferm)
#REFERENCE
#SEE ALSO spirale0
#AUTHOR J.-B. Denis
#CREATED April 28, 2002
#LAST MODIFIED April 29, 2002
#
#
nbs <- max(nbs,1);
sp1 <- spirale0(prh,pth,tra,nbt,pre);
NE <- nrow(sp1$val);
NC <- round(NE - pre/nbs);
NN <- NE;
if (ferm) { NN <- NE+NC }
resu <- array(0,c(NN,2,nbs));
resu[1:NE,,1] <- sp1$val;
if (nbs > 1) {
 for (jbd in 2:nbs) {
  resu[1:NE,,jbd] <- 
      spirale0(prh,
      c(pth[1]+(2*pi/nbs)*(jbd-1),pth[2]),
                         tra,nbt,pre)$val;
  if (ferm) {
   resu[(NE+1):NN,,jbd-1] <- resu[NC:1,,jbd];
   }
  }
 if (ferm) {resu[(NE+1):NN,,nbs] <- resu[NC:1,,1];}
 }
res <- list(val=resu,
            spi=paste(
                paste("nbs =",
                      as.character(nbs),
                      sep=" "),
                       sp1$spi,sep=" & "),
            dra=paste(sp1$dra,
                paste(" & ferm =",
                      as.character(ferm),
                      sep=" ")
            ));
res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>


#########
# tests #
#########

test <- "sp02";
test <- "sp03";
test <- "sp04";
test <- "exe1";
test <- "exe2";
test <- "sp11";
test <- "sp01";
test <- "sp21";
test <- "sp22";
test <- "sp23";
test <- "exe3";

# set of standard spirals by spirale0
if (test == "sp01") {
 spirale <- spirale0();
 spi <- spirale$val;
 plot(range(spi[,1]),range(spi[,2]),type="n",
      xlab="",ylab="");
 title(spirale$spi);
 lines(spi);
 }

if (test == "sp02") {
 spirale <- spirale0();
 spi <- spirale$val;
 plot(range(spi[,1]),range(spi[,2]),type="n",
      xlab="",ylab="");
 title(spirale$spi);
 lines(spi);
 }

if (test == "sp03") {
 spi1 <- spirale0(); sp1 <- spi1$val;
 spi2 <- spirale0(prh=c(0,-1)); sp2 <- spi2$val;
 plot(range(sp1[,1],sp2[,1]),range(sp1[,2],sp2[,2]),type="n",
      xlab="",ylab="");
 title(paste(spi1$spi,"&\n",spi2$spi));
 lines(sp1);
 lines(sp2);
 }

if (test == "sp04") {
 spi1 <- spirale0(); sp1 <- spi1$val;
 spi2 <- spirale0(pth=c(pi,-1)); sp2 <- spi2$val;
 plot(range(sp1[,1],sp2[,1]),range(sp1[,2],sp2[,2]),type="n",
      xlab="",ylab="");
 title(paste(spi1$spi,"&\n",spi2$spi));
 lines(sp1);
 lines(sp2);
 }

# set of standard spirals by spirale1

if (test == "sp11") {
 spirale <- spirale1(nbt=14);
 spi <- spirale$val;
 xmin <- min(spi[,1]); xmax <- max(spi[,1]);
 ymin <- min(spi[,2]); ymax <- max(spi[,2]);
 tout <- matrix(c(xmin,xmin,xmax,xmax,xmin,
                  ymin,ymax,ymax,ymin,ymin),5);
 plot(c(xmin,xmax),c(ymin,ymax),type="n",
      xlab="",ylab="");
 title(spirale$spi);
 lines(spi);
 polygon(tout,col="green");
 polygon(spi,col="yellow");
 }


# set of standard spirals by spirale2

if (test == "sp21") {
 nbs <- 5; pre <- 50;
 spirale <- spirale2(nbs=nbs,nbt=1.4,pre=pre);
 spi <- spirale$val;
 xmin <- min(spi[,1,]); xmax <- max(spi[,1,]);
 ymin <- min(spi[,2,]); ymax <- max(spi[,2,]);
 tout <- matrix(c(xmin,xmin,xmax,xmax,xmin,
                  ymin,ymax,ymax,ymin,ymin),5);
 plot(c(xmin,xmax),c(ymin,ymax),type="n",
      xlab="",ylab="",
      axes=FALSE);
 title(spirale$spi,sub=spirale$dra);
 for (jbd in 1:nbs) {
  lines(spi[,,jbd],col=rainbow(nbs)[jbd]);
  }
 }

if (test == "sp22") {
 nbs <- 12; pre <- 7;
 spirale <- spirale2(nbs=nbs,nbt=1.4,pre=pre,ferm=TRUE);
 spi <- spirale$val;
 xmin <- min(spi[,1,]); xmax <- max(spi[,1,]);
 ymin <- min(spi[,2,]); ymax <- max(spi[,2,]);
 tout <- matrix(c(xmin,xmin,xmax,xmax,xmin,
                  ymin,ymax,ymax,ymin,ymin),5);
 plot(c(xmin,xmax),c(ymin,ymax),type="n",
      xlab="",ylab="",
      axes=FALSE);
 title(spirale$spi,sub=spirale$dra);
 for (jbd in 1:nbs) {
  polygon(spi[,,jbd],col=rainbow(nbs)[jbd]);
  lines(spi[,,jbd],col=rainbow(nbs)[jbd]);
  }
 }

if (test == "sp23") {
 nbs <- 12; pre <- 100;
 spirale <- spirale2(nbs=nbs,nbt=1,pre=pre,ferm=TRUE);
 spi <- spirale$val;
 xmin <- min(spi[,1,]); xmax <- max(spi[,1,]);
 ymin <- min(spi[,2,]); ymax <- max(spi[,2,]);
 tout <- matrix(c(xmin,xmin,xmax,xmax,xmin,
                  ymin,ymax,ymax,ymin,ymin),5);
 plot(c(xmin,xmax),c(ymin,ymax),type="n",
      xlab="",ylab="",
      axes=FALSE);
 title(spirale$spi,sub=spirale$dra);
 for (jbd in 1:nbs) {
  polygon(spi[,,jbd],col=rainbow(nbs)[jbd]);
  lines(spi[,,jbd],col=rainbow(nbs)[jbd]);
  }
 }

# exercise 1
if (test == "exe1") {
 spi1 <- spirale0(); sp1 <- spi1$val;
 spi2 <- spirale0(prh=c(0,-1)); sp2 <- spi2$val;
 spi3 <- spirale0(pth=c(pi,-1)); sp3 <- spi3$val;
 spi4 <- spirale0(prh=c(0,-1),pth=c(pi,-1)); sp4 <- spi4$val;
 plot(range(sp1[,1],sp2[,1]),range(sp1[,2],sp2[,2]),type="n",
      xlab="",ylab="");
 title("Exercise 1");
 lines(sp1);
 lines(sp2);
 lines(sp3);
 lines(sp4);
 }

# exercise 2
if (test == "exe2") {
 spi1 <- spirale0(); sp1 <- spi1$val;
 spi2 <- spirale0(prh=c(0,-1)); sp2 <- spi2$val;
 spi3 <- spirale0(pth=c(pi/2,1)); sp3 <- spi3$val;
 spi4 <- spirale0(prh=c(0,-1),pth=c(pi/2,1)); sp4 <- spi4$val;
 plot(range(sp1[,1],sp2[,1]),range(sp1[,2],sp2[,2]),type="n",
      xlab="",ylab="");
 title("Exercise 2");
 lines(sp1);
 lines(sp2);
 lines(sp3);
 lines(sp4);
 }

# exercise 3
if (test == "exe3") {
 nbspirales <- c(1,2,3,4,5,6,10,20);
 nbcotes    <- c(3,4,5,6,7,50);
# nbspirales <- 10; nbcotes <- 3;
 for (nbspi in nbspirales) { 
 for (nbco in nbcotes) { print(c(nbspi,nbco));
 for (type in c(TRUE,FALSE)) {
  if (nbspi < 10) {cnbspi <- paste("0",nbspi,sep="");}
  else {cnbspi <- as.character(nbspi);}
  if (nbco < 10) {cnbco <- paste("0",nbco,sep="");}
  else {cnbco <- as.character(nbco);}
  fi <- paste("spirale",cnbspi,cnbco,sep="_");
  fifi <- paste(fi,"jpg",sep=".");
  wi <- 600; he <- 600; posi <- 12; qua <- 80;
  if (type) { 
   fifi <- paste(fi,"red","jpg",sep=".");
   wi <- 200; he <- 200; posi <- 12; qua <- 35;
   }
  jpeg(fifi, width=wi, height=he, pointsize=posi, quality=qua);
  nbtours <- min(10,max(1,nbco / nbspi));
  spirale <- spirale2(nbs=nbspi,nbt=nbtours,pre=nbco,ferm=TRUE);
  spi <- spirale$val;
  xet <- range(spi[,1,]); yet <- range(spi[,2,]);
  plot(xet,yet,type="n",xlab="",ylab="",axes=FALSE);
  if (!type) {title(spirale$spi,sub=spirale$dra);}
  for (jbd in 1:nbspi) {
   polygon(spi[,,jbd],col=rainbow(nbspi)[jbd]);
   }
  dev.off();
  }
  }
  }
 }