Ho modificato il programma apportando le seguenti variazioni.
a) tutti i punti all'inizio partono dal centro del rettangolo (intersezione delle diagonali)
b) ogni punto ha due intorni di variabilità casuale: orizzontale e verticale.
Il programma riduce gli intervalli ad ogni miglioramento della configurazione ma quando gli intervalli sono troppo piccoli li allarga e riprende il ciclo.
Si ottiene così una struttura di punti che si espande dentro il rettangolo.
Ci sono momenti di espansione rapida alternati a momenti di stasi. Spettacolare!
Si possono raggiungere varie configurazioni finali, molto simili a quelle trovate da Panurgo.
Il prossimo passo è di aggiungere un po' di determinismo.
Ecco il programma.
Codice: Seleziona tutto
!'------------------------------------
!'Si dispongano 5 (n) punti all'interno (è compreso pure il perimetro) di un rettangolo 2x1,
!'in maniera tale che fra i punti più vicini la distanza sia massima.
!'Soluzione con una Macchina di Darwin
!'------------------------------------
!'Matrice coordinate dei punti
DIM p(50,2)
!'Matrice intorni di ogni punto
!'Il valore è l'inizio dell'intorno di ogni punto
DIM basix(50)
DIM basiy(50)
!'Lati del rettangolo in cui stanno i punti
LET b=2
LET h=1
!'Minimo generale e minimo di ogni prova
LET mingen=0
LET minatt=3
!'Contatore generale delle prove,
!'contatore dei cicli senza miglioramento,
!'contantore dei miglioramenti
LET contgen=0
LET contatt=0
LET miglioramenti=0
!'Numero di punti
LET npunti=12
!'Intorni iniziali dei punti
!'orizzontali e verticali
LET intornox=b/5
LET intornoy=h/5
FOR i=1 TO npunti
LET basix(i)=b/2-intornox/2
LET basiy(i)=h/2-intornoy/2
NEXT i
!'Minima ampiezza intorni per uscire dal programma
LET minintor=0.01
!'------------------------------------
!'DUE VARIABILI CRITICHE
!'------------------------------------
!'Ogni quanti miglioramenti si riducono gli intorni
LET nmigl=2
!'Fattore di riduzione degli intorni
LET fatrid=0.7
LET t0=TIME
RANDOMIZE
!'------------------------------------
!'INIZIO PROGRAMMA
!'------------------------------------
!'Inizio del ciclo
10 DO
!'Assegna al minimo un valore alto
!'dev'essere più alto del massimo possibile
LET minatt=3
!'Estrae coordinate del primo punto
LET p(1,1)=basix(1)+intornox*RND
IF p(1,1)<0 THEN LET p(1,1)=0
IF p(1,1)>b THEN LET p(1,1)=b
LET p(1,2)=basiy(1)+intornoy*RND
IF p(1,2)<0 THEN LET p(1,2)=0
IF p(1,2)>h THEN LET p(1,2)=h
!'Estrae coordinate dei punti successivi
!'e valuta le distanze di ciascun nuovo punto da quelli precedenti
FOR i = 2 TO npunti
LET p(i,1)=basix(i)+intornox*RND
IF p(i,1)<0 THEN LET p(i,1)=0
IF p(i,1)>b THEN LET p(i,1)=b
LET p(i,2)=basiy(i)+intornoy*RND
IF p(i,2)<0 THEN LET p(i,2)=0
IF p(i,2)>h THEN LET p(i,2)=h
!'Distanze
FOR k=1 TO i-1
LET d=SQR((p(k,1)-p(i,1))^2+(p(k,2)-p(i,2))^2)
IF d<minatt THEN LET minatt=d
IF minatt<mingen THEN EXIT FOR
NEXT k
!'Se il minimo di questa prova è minore del minimo generale è inutile continuare
IF minatt<mingen THEN
LET contatt=contatt+1
EXIT FOR
END IF
NEXT i
!'------------------------------------
!'Stampa rapporto solo se la situazione è migliorata
IF minatt>=mingen THEN
LET miglioramenti=miglioramenti+1
LET mingen=minatt
!'------------------------------------
!'Stampa situazione migliorata
CALL rapporto (n,p,mingen)
!'------------------------------------
!'Visualizza grafica
CALL grafica(mingen,n,p,basix,basiy,intornox, intornoy, b, h)
!'------------------------------------
!'Ogni nmigl miglioramenti riduce l'ampiezza dell'intorno
IF miglioramenti = nmigl THEN
LET intornox=intornox*fatrid
LET intornoy=intornoy*fatrid
FOR i=1 TO npunti
LET basix(i)=p(i,1)-intornox/2
LET basiy(i)=p(i,2)-intornoy/2
NEXT i
LET contatt = 0
PRINT "-------------------"
PRINT "Ho ridotto gli intorni"
PRINT "-------------------"
!'------------------------------------
!'Stampa situazione migliorata
CALL rapporto (n,p,mingen)
!'------------------------------------
!'Visualizza grafica
CALL grafica(mingen, n, p, basix, basiy, intornox, intornoy, b, h)
LET miglioramenti=0
LET nmigl=nmigl-1
IF nmigl<1 THEN LET nmigl=1
!'------------------------------------
!'A T T E N Z I O N E: qui c'é la possibile F I N E del programma
IF intornox<minintor THEN
PRINT "Riprendo"
LET intornox=b/5
LET intornoy=h/5
FOR i=1 TO npunti
LET basix(i)=p(i,1)-intornox/2
LET basiy(i)=p(i,2)-intornoy/2
NEXT i
LET contatt = 0
CALL grafica(mingen, n, p, basix, basiy, intornox, intornoy, b, h)
randomize
GOTO 10
END IF
!'IF intorno<minintor THEN
!' PRINT "Ho finito!"
!' GOTO 100
!' END IF
END if
END if
LET contgen=contgen+1
LOOP
!'------------------------------------
!'FINE PROGRAMMA
!'------------------------------------
!'------------------------------------
!'I N I Z I O S U B R O U T I N E S
!'------------------------------------
!'------------------------------------
!'Visualizza grafica, ogni punto e ogni intorno
SUB grafica(mingen, n, p(,), basix(), basiy(), intornox, intornoy, b, h)
SET WINDOW -1,b+2,-1,h+2
CLEAR
DRAW GRID
SET AREA COLOR 38
PLOT AREA: 0,0;0,h;b,h;b,0
SET LINE COLOR 1
PLOT LINES: 0,0;0,h;b,h;b,0;0,0
FOR n=1 TO npunti
LET x=p(n,1)
LET y=p(n,2)
LET xi=basix(n)
LET xf= xi+intornox
LET yi=basiy(n)
LET yf=yi+intornoy
LET lt=1/30
SET LINE COLOR 41
PLOT LINES: xi, y; xf,y
PLOT LINES: x, yi; x,yf
SET AREA COLOR 4
PLOT AREA: x-lt,y-lt; x+lt,y-lt;x+lt,y+lt;x-lt,y+lt
SET TEXT COLOR 1
PLOT TEXT,AT x+lt,y+lt:CHR$(64+n)
LET min$=STR$(INT(mingen*10000)/10000)
LET intornox$=STR$(INT(intornox*10000)/10000)
LET tempo$=STR$(TIME-t0)
LET testo$="Max distanza: "&min$&" Tempo di elaborazione: "&tempo$&" secondi"&" Intorno: "&intornox$
PLOT TEXT, AT 0,h+1:testo$
NEXT n
END SUB
!'------------------------------------
!'Stampa il minimo e le coordinate dei punti
SUB rapporto (npunti,p(,),mingen)
PRINT mingen
!'FOR n=1 TO npunti
!' LET x=INT(p(n,1)*1000)/1000
!' LET y=INT(p(n,2)*1000)/1000
!' PRINT CHR$(64+n);"(";x;";";y;")"
!'NEXT n
END SUB
100 END