Title: Anyone seen Puente's Treasures Inside the Bell?
Post by: Rsoul on May 27, 2011, 03:35:37 PM
Hi.
Longish time lurker. At the very least somebody might find this interesting.
First thing is, I am looking for somebody who has seen Puente's 2003 book:Treasures in the Bell (http://www.amazon.com/Treasures-Inside-Bell-Hidden-Chance/dp/9812381414)
You can see an example of the type of thing HERE (http://www.mi.sanu.ac.rs/vismath/puente/index.html) and at Puente's website HERE (http://puente.lawr.ucdavis.edu/cv_biography.htm).
In the endnotes of the 2003 book Puente gives fortran code to recreate the patterns. He also presents a pattern which he says is a match for B-DNA (using binary digits of
). The code as presented is below.
1) I'd really like some help generating the patterns using this fortran program. Puente has supplied me with the binary digits file, but I've no real idea how to pull it all together. It is not inherently obvious.
2) The second code below is for a Barnsely fern in R. I did not code it. (http://www.springer.com/statistics/statistical+theory+and+methods/book/978-0-387-40273-4) It is based on the book Fractals Everywhere (http://www.amazon.com/Fractals-Everywhere-Michael-F-Barnsley/dp/0120790610) and uses IFS code (I think). I am much more comfortable with R. I would love to recreate the B-DNA package in R, using similar code.
Fun for a rainy bank holiday?
BARNSLEY FERN (Code from HERE (http://www.sci.csueastbay.edu/~esuess/psgs/Ch07CodeExPr.R)
Longish time lurker. At the very least somebody might find this interesting.
First thing is, I am looking for somebody who has seen Puente's 2003 book:Treasures in the Bell (http://www.amazon.com/Treasures-Inside-Bell-Hidden-Chance/dp/9812381414)
You can see an example of the type of thing HERE (http://www.mi.sanu.ac.rs/vismath/puente/index.html) and at Puente's website HERE (http://puente.lawr.ucdavis.edu/cv_biography.htm).
In the endnotes of the 2003 book Puente gives fortran code to recreate the patterns. He also presents a pattern which he says is a match for B-DNA (using binary digits of
1) I'd really like some help generating the patterns using this fortran program. Puente has supplied me with the binary digits file, but I've no real idea how to pull it all together. It is not inherently obvious.
2) The second code below is for a Barnsely fern in R. I did not code it. (http://www.springer.com/statistics/statistical+theory+and+methods/book/978-0-387-40273-4) It is based on the book Fractals Everywhere (http://www.amazon.com/Fractals-Everywhere-Michael-F-Barnsley/dp/0120790610) and uses IFS code (I think). I am much more comfortable with R. I would love to recreate the B-DNA package in R, using similar code.
Fun for a rainy bank holiday?
Code:
c**************************************************************************
c
program branch_sw_pi
c
c Computes dots located on the attractor of pseudo-wire defined
c by NF affine functions in three dimensions following a single
c branch of an NF-ary tree given by the binary digits of pi
c The mappings have end points:
c (xi(n),yi(n),zi(n)),
c (xr(n),yr(n),zr(n))
c The final parameters of the mappings are:
c (wa(n) 0 0)
c (we(n))
c (wc(n) wd(n) wh(n)) + (wf(n))
c (wk(n) wl(n) wm(n))
c (wg(n))
c Where the lower right matrix is:
c (rl(n)*cos(thl(n))
c (rl(n)*sin(thl(n))
c -r2(n)*sin(th2(n)))
c r2(n)*cos(th2(n)))
c+++++++++++++++++++++++++++++++++++++++
c NOTES: currently the maximum number of functions is 8
c angles are in degrees
c niter is the total number of iterations
c points stored are those between bstore and estore
c********************************************************
implicit double precision (a-h, o-z)
parameter (Pi = 3.14159265358979324d0, NF = 8)
c
dimension xl(NF), yl(NF), zl(NF), xr(NF), yr(NF), zr(NF)
dimension wa(NF), we(NF), wc(NF), wd(NF), wh(NF), wf(NF), wk(NF)
dimension wl(NF), wm(NF), wg(NF), r1(NF), r2(NF), th1(NF), th2(NF)
dimension rl(NF)
integer bstore, estore
c
character*70,file1
c
c******************************************
c Open output files:
c*****************************************
print *, '? summary file'
read *, file1
open(10, file = file1, status = 'unknown')
c
print *, '? dots file'
read *, file1
open(11, file = file1, status = 'unknown')
c
c************************************************
c Open file containing the binary digits if pi
c************************************************
open(12, file = 'filebipi', status = 'old')
c
C+++++++++++++++++++++++++++++++++++++++++++
c
c NOTE: This file may be replaced by pseudo-random numbers if desired
c+++++++++++++++++++++++++++++++++++++++++++
c
c********************************************
c Enter storage information
c********************************************
print *, '? Number of iterations'
read *, niter
write(10,*) '! Number of iterations ', niter
c
print *, '? Begining of storage'
read *, bstore
write(10,*) '! Begining of storage ', bstore
c
print *, '? End of storage'
read *, estore
write(10,*) '! End of storage ', estore
c
c*******************************************
c Enter initial geometric configuration
c*******************************************
print *, '? geometry file'
read *, file1
open(14, file = file1, status = 'old')
c+++++++++++++++++
c Read end-points
c+++++++++++++++++
c
read (14,*) nfun
do n = 1, nfun
read (14,*) xl(n), xr(n)
read (14,*) yl(n), yr(n)
read (14,*) zl(n), zr(n)
end do
c
write(10,*) ' '
write(10,*) ' ! Initial Configuration: nfun, X,Y,Z'
write(10,*) nfun
do n = 1, nfun
write(10,*) xl(n), xr(n)
write(10,*) yl(n), yr(n)
write(10,*) zl(n), zr(n)
end do
c************************************************
c Enter scalings and rotations
c***********************************************
print *, '? scalings and rotations'
print *, '? r1 '
read *, (rl(n), n = 1, nfun)
print *, '? th1'
read *, (th1(n), n = 1, nfun)
print *, '? r2'
read *, (r2(n), n = 1, nfun)
print *, '? th2'
read *, (th2(n), n = 1, nfun)
c
write(10,*) ' '
write(10,*) ' ! Scalings and rotations by mapping: (rl, th1 , r2,
+ th2)'
do n = 1, nfun
write(10,*) rl(n), th1(n), r2(n), th2(n)
end do
c
c++++++++++++++++++++++++
c
c Transform angles into radians
c++++++++++++++++++++++++
c
do n = 1, nfun
th1(n) = Pi*th1(n)/180.0D0
th2(n) = Pi*th2(n)/180.0D0
end do
c
c**************************************
cDefine free affine mapping parameters
c**************************************
do n = 1, nfun
wd(n) = rl(n)*dcos(th1(n))
wh(n) = -r2(n)*dsin(th2(n))
wl(n) = rl(n)*dsin(th1(n))
wm(n) = r2(n)*dcos(th2(n))
end do
c
c
c************************************
cFind other affine mapping parameters
c+++++++++++++++++++++++++++++++++++
c
c*******************************************
cfirst determine end points for contractions
c********************************************
xend1 = xl(1)
yend1 = yl(1)
zend1 = zl(1)
xend2 = xr(1)
yend2 = yr(1)
zend2 = zr(1)
c
do n = 2, nfun
if(xl(n).lt.xendl) then
xend1 = xl(n)
yend1 = yl(n)
zend1 = zl(n)
end if
if(xr(n).gt.xend2) then
xend2 = xr(n)
yend2 = yr(n)
zend2 = zr(n)
end if
end do
c
c++++++++++++++++++++++++
c
c now find parameters
c++++++++++++++++++++++++
c
xrange = xend2 - xend1
yrange = yend2 - yend1
zrange = zend2 - zend1
c
do n = 1, nfun
wa(n) = (xr(n) - xl(n))/xrange
wc(n) = (yr(n) - yl(n) - wd(n)*yrange - wh(n)*zrange)/xrange
wk(n) = (zr(n) - zl(n) - wl(n)*yrange - wm(n)*zrange)/xrange
we(n) = xl(n) - xend1*wa(n)
wf(n) = yl(n) - wd(n)*yend1 - wc(n)*xend1 - wh(n)*zend1
wg(n) = zl(n) - wl(n)*yend1 - wk(n)*xend1 - wm(n)*zend1
end do
c
c****************************************
c Do iterations and store when requested
c****************************************
c++++++++++++++++++++++++++++++++++++++++++
c points may be found sequentally or based on the same starting point
c++++++++++++++++++++++++++++++++++++++++++
c
print *, '? Enter 1 if sequential patterns, 0 otherwise'
read *, iseq
write(10,*) '! Sequential patterns indicator ', iseq
c
print *, '? Enter number of points per frame'
read *, nseq
write(10,*) '! Points per frame ', nseq
c
c++++++++++++++++++++++++++++++
c
c Define the starting point
C++++++++++++++++++++++++++++++
C
xx = xr(1)
yy = yr(1)
zz = zr(1)
c
nstore = estore - bstore + 1
write (11,*) nstore
c
do i = 1, niter
c
if(iseq.eq.0) then
if(mod(i,nseq).eq.0) then
xx = xr(1)
yy = yr(1)
zz = zr(1)
end if
end if
c
read(12,*) ii
n1 = ii + 1
c
xnew = wa(n1)*xx + we(n1)
ynew = wc(n1)*xx + wd(n1)*yy + wh(n1)*zz + wf(n1)
znew = wk(n1)*xx + wl(n1)*yy + wm(n1)*zz + wg(n1)
c
xx = xnew
yy = ynew
zz = znew
c
c+++++++++++++++++++++++++++++++++
c points stored in unit 11 may be plotted
c+++++++++++++++++++++++++++++++++
c
if((i. ge. bstore).and.(i. le. estore)) then
write(11,*) n1, real(yy), real(zz)
end if
c
end do
c
stop
c endstop
end
BARNSLEY FERN (Code from HERE (http://www.sci.csueastbay.edu/~esuess/psgs/Ch07CodeExPr.R)
Code:
m = 100000 # Text has 30K
a = c(0, .85, .2, -.15); b = c(0, .04, -.26, .28)
c = c(0, -.04, .23, .26); d = c(.16, .85, .22, .24)
e = c(0, 0, 0, 0); f = c(0, 1.6, 1.6, .44)
p = c(.01, .85, .07, .07)
k = sample(1:4, m, repl=T, p)
h = numeric(m); w = numeric(m); h[1] = 0; w[1] = 0
for (i in 2:m)
{
h[i] = a[k[i]]*h[i-1] + b[k[i]]*w[i-1] + e[k[i]]
w[i] = c[k[i]]*h[i-1] + d[k[i]]*w[i-1] + f[k[i]]
}
plot(w, h, pch=".", col="darkgreen") # Text has 'pch=20'
Title: Re: Anyone seen Puente's Treasures Inside the Bell?
Post by: Kali on May 27, 2011, 03:42:50 PM
Seems interesting, I will give it a deeper look later if I have the time.
Btw, Fractal Ken is the Fortran expert here... ask him in case he doesn't see this post.
Thanks for the info.
Regards,
Btw, Fractal Ken is the Fortran expert here... ask him in case he doesn't see this post.
Thanks for the info.
Regards,
Title: Re: Anyone seen Puente's Treasures Inside the Bell?
Post by: Rsoul on May 27, 2011, 04:05:27 PM
Normally I get my programming help from http://stackoverflow.com/ (http://stackoverflow.com/) but it's a bit more complicated than usual. Thus I thought I'd check out people who are used to dealing with these types of complex problems.
Thanks for the consideration. :)
Thanks for the consideration. :)