Sezione aurea

Il forum di Base5, dove è possibile postare problemi, quiz, indovinelli, rompicapo, enigmi e quant'altro riguardi la matematica ricreativa e oltre.

Moderatori: Gianfranco, Bruno

Rispondi
Quelo
Livello 6
Livello 6
Messaggi: 569
Iscritto il: ven giu 16, 2006 3:34 pm

Sezione aurea

Messaggio da Quelo »

Immagine
.
Ho trovato questa animazione sul web e mi sono divertito a riprodurla in basic.
[Sergio]

Gianfranco
Supervisore del sito
Supervisore del sito
Messaggi: 1353
Iscritto il: ven mag 20, 2005 9:51 pm
Località: Sestri Levante
Contatta:

Re: Sezione aurea

Messaggio da Gianfranco »

Bellissimo lavoro Sergio.
Sapevo che col Decimal BASIC si può salvare la finestra grafica, ma non sapevo che si possono anche creare GIF animate. Ottima notizia!
A questo punto, la domanda sorge spontanea: come hai fatto?
Pace e bene a tutti.
Gianfranco

Quelo
Livello 6
Livello 6
Messaggi: 569
Iscritto il: ven giu 16, 2006 3:34 pm

Re: Sezione aurea

Messaggio da Quelo »

Grazie Gianfranco, purtroppo devo precisare che non ho usato Decimal Basic.
Ho utilizzato un"app: BASIC! per Android, che ha funzionalità grafiche più avanzate, poi ho catturato l'animazione sullo schermo con un'altra app, quindi ho tagliato il filmato con un'altra app ancora e alla fine ho creato la gif animata con una quarta app.
Sono curioso di vedere se riesco a riprodurre l'effetto anche in Decimal Basic.

Il programma permatte di realizzare l'animazione anche con le serzioni argentea, bronzea, ecc...
Ecco uno screenshot
IMG_20210829_182119.jpg
IMG_20210829_182119.jpg (6.58 KiB) Visto 236 volte
Vi lascio anche il listato, il codice non è ottimizzato perché programmare con il tablet non è molto pratico.

Codice: Seleziona tutto

input "Input ratio (1=golden, 2=silver, 3=bronze, ...)", z
z=int(z) 
if z<0 | z>10 then z=1
l=12
ci=50
di=200*sqr(z) 
a=pi()/3
bi=pi()/4
fi=(sqr(z^2+4)+z)/2
sfi=2/((z-2)+sqr(z^2+4))
dim c[l+1,2]
dim t[2]
dim qxy[8]

GR.OPEN ,,,,,1
inizio:         
s=100
for as= -s to s
a = pi()*as/s
if abs(as)>s/2 & mod(as,3)<>0 & abs(as)<s then f_n.continue
if abs(as)<s/2 & abs(as)>s/5 & mod(as,2)<>0 then f_n.continue
GR.COLOR ,0,255,0,0
gr.circle p, ci+di*(sfi+1-1/z), ci+di*(sfi+1-1/z), di*sqr(2)/z
GR.COLOR ,90,90,90,0

c[1,1] = ci
c[1,2] = ci
d=di
b=bi   

for i= 1 to l 
c[i+1,1] = c[i,1]+sqr(2)*d*cos(b)
c[i+1,2] = c[i,2]+sqr(2)*d*sin(b)
xm=(c[i,1]+c[i+1,1])/2
ym=(c[i,2]+c[i+1,2])/2
xd=xm-c[i,1]
yd=ym-c[i,2]
if a<>0 then
xc=xm+yd*tan(pi()/2-a/2)
yc=ym-xd*tan(pi()/2-a/2) 
endif
array.load qx[], c[i,1], xm-yd, c[i+1,1], xm+yd, c[i,1] 
array.load qy[], c[i,2], ym+xd, c[i+1,2], ym-xd, c[i,2] 
for q=1 to 4
gr.line p, qx[q], qy[q], qx[q+1], qy[q+1]
qxy[2*q-1]=qx[q]
qxy[2*q]=qy[q] 
next

LIST.CREATE n, List1
LIST.ADD.ARRAY List1, qxy[]

GR.COLOR 128, 128, 128, 128, 1
GR.POLY pt, List1
GR.COLOR ,0,0,255,0

if a=0 then
for v = ci to ci+di*(sfi+1) step 2
gr.point p, v, v
next
else
for v = 1 to 2
ux=qx[2*v-1]-xc: uy=qy[2*v-1]-yc
if ux>0 & uy>0 then t[v]=atan(uy/ux)
if ux<0 & uy>0 then t[v]=pi()-atan(uy/-ux)
if ux>0 & uy<0 then t[v]=2*pi()-atan(-uy/ux)
if ux<0 & uy<0 then t[v]=pi()+atan(uy/ux)
if uy=0 then
   if ux>0 then t[v]=0 else t[v]=pi()
endif
if ux=0 then 
   if uy>0 then t[v]=pi()/2 else t[v]=3*pi()/2
endif
next
if t[1]<0.0000001 then
   if a<0 then t[1]=0 else t[1]= 2*pi()
endif
if t[2]>6.283185 then
   if a<0 then t[2]=0 else t[2]= 2*pi()
endif
if a<0 & t[1]>t[2] then t[2]=t[2]+2*pi()
if a>0 & t[2]>t[1] then t[1]=t[1]+2*pi()
r=sqr((ux)^2+(uy)^2)
 
t0=abs(t[1]-t[2])/(2*d)
if t[1]>t[2] then t0=-t0
for t=t[1] to t[2] step t0
gr.point p, xc+r*cos(t), yc+r*sin(t) 
next
! print xc, yc, t[1], t[2]
endif

GR.COLOR ,90,90,90,0

d=d/fi
b=b-a
next
GR.RENDER
PAUSE 1000/s
if abs(as)=s/2 then
if z>1 & z<5 then
pause 250
GR.COLOR ,90,90,90,0

if as=-s/2 then
c[1,1] = ci+di
c[1,2] = ci+di*(fi+2-z)
b=bi+pi() 
else
c[1,1] = ci+di*(fi+2-z)
c[1,2] = ci+di
b=bi-pi()
endif

d=di 

for i= 1 to l 
c[i+1,1] = c[i,1]+sqr(2)*d*cos(b)
c[i+1,2] = c[i,2]+sqr(2)*d*sin(b)
xm=(c[i,1]+c[i+1,1])/2
ym=(c[i,2]+c[i+1,2])/2
xd=xm-c[i,1]
yd=ym-c[i,2]
if a<>0 then
xc=xm+yd*tan(pi()/2-a/2)
yc=ym-xd*tan(pi()/2-a/2) 
endif
array.load qx[], c[i,1], xm-yd, c[i+1,1], xm+yd, c[i,1] 
array.load qy[], c[i,2], ym+xd, c[i+1,2], ym-xd, c[i,2] 
for q=1 to 4
gr.line p, qx[q], qy[q], qx[q+1], qy[q+1]
qxy[2*q-1]=qx[q]
qxy[2*q]=qy[q] 
next
d=d/fi
b=b-a
next
gr.render

pause 1000
else
pause 1000
end if
end if
if abs(as)=s then pause 1000
if as=0 then pause 250
gr.cls
next
goto inizio
[Sergio]

Quelo
Livello 6
Livello 6
Messaggi: 569
Iscritto il: ven giu 16, 2006 3:34 pm

Re: Sezione aurea

Messaggio da Quelo »

Ho convertito il programma in Decimal Basic, ecco il listato

Codice: Seleziona tutto

INPUT  PROMPT "Input ratio (1=golden, 2=silver, 3=bronze, ...)": z
LET z=int(z)
IF z<0 OR z>10 THEN LET z=1
LET l=12
LET ci=50
LET di=200*sqr(z)
LET a=pi/3
LET bi=pi/4
LET fi=(sqr(z^2+4)+z)/2
LET sfi=2/((z-2)+sqr(z^2+4))
dim c(l+1,2)
dim t(2)
DIM qx(5)
DIM qy(5)

LET f$="D:\Setup\BASICEn\_prog\sezione\aurea"

SET WINDOW 0,1000,0,1000
10 !inizio
   LET s=100
   for as= -s to s
      LET a = pi*as/s
      IF ABS(as)>s/2 AND MOD(as,3)<>0 AND ABS(as)<s THEN GOTO 20 
      IF ABS(as)<s/2 AND ABS(as)>s/5 AND MOD(as,2)<>0 THEN GOTO 20
       
      SET LINE COLOR 3
      LET xc=ci+di*(sfi+1-1/z)
      LET yc=ci+di*(sfi+1-1/z)
      LET r=di*SQR(2)/z
      FOR u=0 TO 2*PI STEP PI/50
         PLOT LINES: xc+r*COS(u),yc+r*SIN(u);
      NEXT u
      PLOT LINES
       
      LET c(1,1) = ci
      LET c(1,2) = ci
      LET d=di
      LET b=bi
       
      for i= 1 to l
         LET c(i+1,1) = c(i,1)+sqr(2)*d*cos(b)
         LET c(i+1,2) = c(i,2)+sqr(2)*d*sin(b)
         LET xm=(c(i,1)+c(i+1,1))/2
         LET ym=(c(i,2)+c(i+1,2))/2
         LET xd=xm-c(i,1)
         LET yd=ym-c(i,2)
         if a<>0 then
            LET xc=xm+yd*tan(pi/2-a/2)
            LET yc=ym-xd*tan(pi/2-a/2)
         end if
         LET qx(1)=c(i,1)
         LET qx(2)=xm-yd
         LET qx(3)=c(i+1,1)
         LET qx(4)=xm+yd
         LET qx(5)=c(i,1)
         LET qy(1)=c(i,2)
         LET qy(2)=ym+xd
         LET qy(3)=c(i+1,2)
         LET qy(4)=ym-xd
         LET qy(5)=c(i,2)
          
         SET AREA COLOR "SILVER"
         plot AREA: qx(1), qy(1); qx(2), qy(2); qx(3), qy(3); qx(4), qy(4)
          
         SET LINE COLOR "GRAY"
          
         FOR q=1 TO 4
            PLOT LINES: qx(q), qy(q); qx(q+1), qy(q+1)
         NEXT Q
         PLOT LINES
          
         SET LINE COLOR 2
         IF a=0 THEN
            FOR v = ci TO ci+di*(sfi+1) STEP 2
               PLOT lineS: v, v
            NEXT V
         else
            for v = 1 to 2
               LET ux=qx(2*v-1)-xc
               LET uy=qy(2*v-1)-yc
               if ux>0 AND uy>0 then LET t(v)=atn(uy/ux)
               IF ux<0 AND uy>0 THEN LET t(v)=PI-atn(uy/(-ux))
               IF ux>0 AND uy<0 THEN LET t(v)=2*PI-atn(-uy/ux)
               IF ux<0 AND uy<0 THEN LET t(v)=PI+atn(uy/ux)
               if uy=0 then
                  if ux>0 then LET t(v)=0 else LET t(v)=pi
               end if
               if ux=0 then
                  if uy>0 then LET t(v)=pi/2 else LET t(v)=3*pi/2
               end if
            next V
            if t(1)<0.0000001 then
               if a<0 then LET t(1)=0 else LET t(1)= 2*pi
            end if
            if t(2)>6.283185 then
               if a<0 then LET t(2)=0 else LET t(2)= 2*pi
            end if
            if a<0 AND t(1)>t(2) then LET t(2)=t(2)+2*pi
            if a>0 AND t(2)>t(1) then LET t(1)=t(1)+2*pi
            LET r=sqr((ux)^2+(uy)^2)
             
            LET t0=abs(t(1)-t(2))/(2*d)
            if t(1)>t(2) then LET t0=-t0
             
            FOR u=t(1) TO t(2) STEP t0
               PLOT lineS: xc+r*COS(u), yc+r*SIN(u)
            NEXT U
         END IF
          
         SET LINE COLOR "GRAY"
          
         LET d=d/fi
         LET b=b-a
      next I
       
      WAIT DELAY 1/s
      IF ABS(as)=s/2 THEN
         if z>1 AND z<5 then
            WAIT DELAY .25
             
            SET LINE COLOR "GRAY"
             
            if as=-s/2 then
               LET c(1,1) = ci+di
               LET c(1,2) = ci+di*(fi+2-z)
               LET b=bi+pi
            else
               LET c(1,1) = ci+di*(fi+2-z)
               LET c(1,2) = ci+di
               LET b=bi-pi
            end if
             
            LET d=di
             
            for i= 1 to l
               LET c(i+1,1) = c(i,1)+sqr(2)*d*cos(b)
               LET c(i+1,2) = c(i,2)+sqr(2)*d*sin(b)
               LET xm=(c(i,1)+c(i+1,1))/2
               LET ym=(c(i,2)+c(i+1,2))/2
               LET xd=xm-c(i,1)
               LET yd=ym-c(i,2)
               if a<>0 then
                  LET xc=xm+yd*tan(pi/2-a/2)
                  LET yc=ym-xd*tan(pi/2-a/2)
               end if
               LET qx(1)=c(i,1)
               LET qx(2)=xm-yd
               LET qx(3)=c(i+1,1)
               LET qx(4)=xm+yd
               LET qx(5)=c(i,1)
               LET qy(1)=c(i,2)
               LET qy(2)=ym+xd
               LET qy(3)=c(i+1,2)
               LET qy(4)=ym-xd
               LET qy(5)=c(i,2)
               FOR q=1 TO 4
                  PLOT LINES: qx(q), qy(q); qx(q+1), qy(q+1)
               NEXT Q
               PLOT LINEs
               LET d=d/fi
               LET b=b-a
            NEXT i
            WAIT DELAY 1
         ELSE
            WAIT DELAY 1
         END IF
      END IF
      IF ABS(as)=s THEN WAIT DELAY 1
      IF as=0 THEN WAIT DELAY .25
      gsave f$ & right$("00" & STR$(as+s),3) & ".gif"
      CLEAR
20    !fine
   NEXT AS
END
Con la funzione GSAVE ho salvato la sequenza di immagini, dopo le ho ritagliate con programma di grafica (ho usato Xn View MP che è un image browser ma ha anche funzioni per operare su gruppi di immagini) e poi ho creato la gif con un software apposito (PhotoScape X)

Questo è il risultato
.
Immagine
.
Se il quadrato più grande ha lato 1, qual è il raggio del cerchio?
[Sergio]

Rispondi