[Rd] Bug or not? (PR#8977)

Jean lobry lobry at biomserv.univ-lyon1.fr
Wed Jun 14 19:55:34 CEST 2006


I think you are computing your matrix to power N+1 instead of N.
This code seems to work for me:

Rs <- function(lambda, theta, N){

   n0 <-  3.66
   n1 <-  2.4
   n2 <-  1.45
   nn <-  1.00

   lambda_ref <- 1000

   d1 <- lambda_ref / 4 / n1
   d2 <- lambda_ref / 4 / n2

   theta0 <- asin( nn / n0 * sin( theta ) )
   theta1 <- asin( nn / n1 * sin( theta ) )
   theta2 <- asin( nn / n2 * sin( theta ) )

   etha_s0 <- -n0 * cos( theta0 )
   etha_s1 <- n1 * cos( theta1 )
   etha_s2 <- n2 * cos( theta2 )
   etha_sn <- nn * cos( theta )

   delta1 <-  2 * pi / lambda * n1 * d1 * cos( theta1 )
   delta2 <-  2 * pi / lambda * n2 * d2 * cos( theta2 )

   Ms1 <-  matrix( c( cos( delta1 ) , 1i * etha_s1 * sin( delta1 ) , 
1i / etha_s1 * sin( delta1 ) , cos( delta1 ) ), 2 , 2 )
   Ms2 <-  matrix( c( cos( delta2 ) , 1i * etha_s2 * sin( delta2 ) , 
1i / etha_s2 * sin( delta2 ) , cos( delta2 ) ), 2 , 2 )

   Mstmp <- Ms2 %*% Ms1
   Msr <- Mstmp
   for(i in 1:(N-1)) Msr <- Msr %*% Mstmp

   Rs <- ( abs( ( etha_sn * ( Msr[1, 1] - etha_s0 * Msr[1, 2] ) - ( 
Msr[2 , 1]  - etha_s0 * Msr[2, 2] ) ) / ( etha_sn * ( Msr[1, 1]  - 
etha_s0 * Msr[1, 2] ) + ( Msr[2, 1]  - etha_s0 * Msr[2, 2] ) ) ) )^2

   return(Rs)
}


lambda_range <- 500:1500
s0 <- sapply(lambda_range, Rs, theta = 0, N = 5)
s75 <- sapply(lambda_range, Rs, theta = 75*pi/180, N = 5)


ref <- read.table("Mathcad2.txt", header=FALSE, col.names=c('wl','a0', 'a75'))
o0deg<-scan("o0deg.dat", "numeric", sep=" ", skip=5)
o75deg<-scan("o75deg.dat", "numeric", sep=" ", skip=5)
o0deg<-o0deg[-1]
o75deg<-o75deg[-1]

pdf(file="comparison.pdf", width=11.8, height=8.3)


par(mar = c(3.5,3.5,4,3.5))

plot(ref$wl,ref$a0,ylim=c(0, 
1),type="l",col="1",lty=2,xlab="",ylab="",axes=FALSE, lwd = 1.5)


lines(lambda_range,s0,type="l",col="2", lty=2, lwd = 2)
lines(lambda_range,o0deg,type="l",col="3", lty=2)
lines(ref$wl,ref$a75,type="l",col="1",lty=3, lwd = 1.5)
lines(lambda_range,s75,col="2", lty=3, lwd = 2)
lines(lambda_range,o75deg,col="3", lty=3)

axis(1, at=seq(lambda_min,lambda_max,20))
axis(2)
mtext("wavelength [nm]", side=1, line=2)
mtext("reflection", side=2, line=2)
mtext(paste("bragg mirror, s-polarized: central wavelength ", 
lambda_ref," nm, ", N, " pairs of layers", seq=""), side=3, line=2.5, 
cex=1.2)
mtext(paste("n0=", n0 (1), ";  n1=", n1(1),";  n2=", n2(1),";  n3=", 
nn(1)),side=3,line=1.5, cex=0.7)
legend("topleft", c("0A","75A"), lty=2:3)
legend("topright", c("Reference","R", "Octave"), col=1:3, lty=1)

dev.off()

-- 
Jean R. Lobry            (lobry at biomserv.univ-lyon1.fr)
Laboratoire BBE-CNRS-UMR-5558, Univ. C. Bernard - LYON I,
43 Bd 11/11/1918, F-69622 VILLEURBANNE CEDEX, FRANCE
allo  : +33 472 43 12 87     fax    : +33 472 43 13 88
http://pbil.univ-lyon1.fr/members/lobry/



More information about the R-devel mailing list