program SPIN2D; (*---------------------------------------------------------------------------*) (*------------------ Version 1.0 : 30 Juillet 1993 --------------------------*) (*--------------------------- B. YCART --------------------------------------*) (*---------------------------------------------------------------------------*) (*---------------------------------------------------------------------------*) (*------ Ce programme simule les chanes de Markov extraites associes ------*) (*------ aux systmes de spin sur un rectangle de 250 par 200. ------*) (*------ Les taux de changement en chaque site ne dpendent que du ------*) (*------ nombre de voisins du site 1 dans la configuration courante ------*) (*------ Les taux de transition, les conditions de bord ainsi que la ------*) (*------ configuration initiale sont choisis par l'utilisateur ------*) (*---------------------------------------------------------------------------*) Uses Crt,Graph; var CONFIG : array[0..249,0..199] of boolean; ALPHA,BETA,LAMBDA,P : real; TAUX, PROBA : array[0..1,0..4] of real; NITER : longint; REPPROC,REPBORD,REPINIT,REPSTOP : char; GRP,GRM : integer; (*---------------------------------------------------------------------------*) (*------ CONFIG ------*) (*------ La configuration courante. ------*) (*------ ALPHA,BETA,LAMBDA,P ------*) (*------ Paramtres des processus (Ising, Contact, Philosophes) ------*) (*------ et de la configuration initiale. ------*) (*------ TAUX, PROBA ------*) (*------ Taux et probabilits de changements en un site selon sa ------*) (*------ valeur et le nombre de ses voisins 1. ------*) (*------ NITER ------*) (*------ Indice d'itration. Une itration consiste choisir un site------*) (*------ au hasard et dcider de le changer ou non en fonction d'une ------*) (*------ probabilit lue dans le tableau PROBA. ------*) (*------ REPPROC,REPBORD,REPINIT,REPSTOP ------*) (*------ Rponses de l'utilisateur aux menus successifs. ------*) (*------ GRP,GRM ------*) (*------ Pilote et mode graphique. ------*) (*---------------------------------------------------------------------------*) (*---------------------------------------------------------------------------*) (*-----------------Procdures de choix de l'utilisateur----------------------*) (*---------------------------------------------------------------------------*) procedure CHOIX_PROCESSUS; (* Choix du type de processus simuler (Ising, Election, Contact, *) (* Philosophes ou taux dfinir par l'utilisateur) *) begin restorecrtmode; clrscr; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ SYSTEMES DE SPIN บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); writeln(' Ce programme simule des systmes de spin sur un rseau'); writeln(' de 250x200 sites. Les taux de transition en un site ne'); writeln(' dpendent que du nombre V de voisins 1 de ce site. '); writeln; writeln(' Ces taux seront nots c(0,V) et c(1,V). '); writeln; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ บ '); writeln(' บ F1 : Modle de Ising Stochastique บ '); writeln(' บ บ '); writeln(' บ F2 : Processus de Contact บ '); writeln(' บ บ '); writeln(' บ F3 : Modle d''Election บ '); writeln(' บ บ '); writeln(' บ F4 : Processus des Philosophes บ '); writeln(' บ บ '); writeln(' บ F5 : Taux saisis l''cran บ '); writeln(' บ บ '); writeln(' บ Esc : Quitter le programme. บ '); writeln(' บ บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); repeat REPPROC:=readkey until (REPPROC=#59) or (* F1 : Ising------------------------------*) (REPPROC=#60) or (* F2 : Contact----------------------------*) (REPPROC=#61) or (* F3 : Election---------------------------*) (REPPROC=#62) or (* F4 : Philosophes------------------------*) (REPPROC=#63) or (* F5 : Saisie Ecran-----------------------*) (REPPROC=#27); (* Esc : Quitter le programme---------------*) end; (*---------------------------------------------------------------------------*) procedure CHOIX_BORD; (* Choix des conditions de bord : bord 0 , bord 1 ou bord priodique. *) begin clrscr; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ CONDITIONS DE BORD บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); writeln; writeln; writeln(' Choisissez le type de conditions de bord. '); writeln; writeln; writeln; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ บ '); writeln(' บ F1 : Bord 0 บ '); writeln(' บ บ '); writeln(' บ บ '); writeln(' บ F2 : Bord 1 บ '); writeln(' บ บ '); writeln(' บ บ '); writeln(' บ F3 : Bord priodique บ '); writeln(' บ บ '); writeln(' บ บ '); writeln(' บ บ '); writeln(' บ Esc : Menu prcdent. บ '); writeln(' บ บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); repeat REPBORD:=readkey until (REPBORD=#59) or (* F1 : Bord 0 --------------------------*) (REPBORD=#60) or (* F2 : Bord 1---------------------------*) (REPBORD=#61) or (* F3 : Bord priodique--------------------*) (REPBORD=#27); (* Esc : Menu prcdent---------------------*) end; (*---------------------------------------------------------------------------*) procedure CHOIX_INIT; (* Choix de la configuration initiale *) var X,Y : integer; begin clrscr; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ CONFIGURATION INITIALE บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); writeln; writeln(' Vous pouvez choisir plusieurs configurations "dtermi-'); writeln(' nistes" ou bien une configuration o les sites seront '); writeln(' mis 1 indpendamment avec probabilit P ( saisir). '); writeln; writeln; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ บ '); writeln(' บ F1 : Carr บ '); writeln(' บ บ '); writeln(' บ F2 : Damiers บ '); writeln(' บ บ '); writeln(' บ F3 : Diagonales บ '); writeln(' บ บ '); writeln(' บ F4 : Sites indpendants บ '); writeln(' บ บ '); writeln(' บ F5 : Configuration mmorise บ '); writeln(' บ บ '); writeln(' บ Esc : Menu prcdent. บ '); writeln(' บ บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); repeat REPINIT:=readkey until (REPINIT=#59) or (* F1 : Carr------------------------------*) (REPINIT=#60) or (* F2 : Damiers----------------------------*) (REPINIT=#61) or (* F3 : Diagonales-------------------------*) (REPINIT=#62) or (* F4 : Sites indpendants-----------------*) (REPINIT=#63) or (* F5 : Configuration Mmorise------------*) (REPINIT=#27); (* Esc : Menu prcdent---------------------*) if REPINIT=#62 then (* Saisie de P -----------------------------*) begin gotoxy(34,19); writeln('Probabilit de 1 : ?'); repeat begin gotoxy(53,19); writeln(' '); gotoxy(53,19); readln(P); end; until ((P >= 0.000) and (P <= 1.000)) ; end; end; (*---------------------------------------------------------------------------*) (*---------------------Fin des procdures de choix---------------------------*) (*---------------------------------------------------------------------------*) (*-----------------Procdures de saisie des paramtres-----------------------*) (*------------------et calcul des taux de transition-------------------------*) (*---------------------------------------------------------------------------*) procedure ISING; (* Saisie des paramtres pour le modle de Ising Stochastique et calcul des *) (* taux de transition. *) var I : integer; begin clrscr; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ MODELE DE ISING STOCHASTIQUE บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); writeln; writeln(' Ce processus admet pour mesure rversible la mesure de'); writeln(' Gibbs relative un potentiel de paire. '); writeln(' ALPHA est le potentiel d''un site. BETA est le poten- '); writeln(' tiel d''une paire de sites voisins. '); writeln(' Les taux de transition en un site ayant V voisins '); writeln(' 1 s''crivent '); writeln; writeln(' c(0,V) = Exp[ ALPHA + (2V-4) BETA] '); writeln(' c(1,V) = Exp[-ALPHA + (4-2V) BETA] '); writeln; writeln; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ Valeurs des deux paramtres บ '); writeln(' บ บ '); writeln(' บ บ '); writeln(' บ ALPHA = ? บ '); writeln(' บ บ '); writeln(' บ BETA = ? บ '); writeln(' บ บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); repeat (* Saisie de ALPHA--------------------------*) gotoxy(32,20); writeln(' '); gotoxy(32,20); readln(ALPHA); until (ALPHA>-5)and(ALPHA<5); repeat (* Saisie de BETA---------------------------*) gotoxy(32,22); writeln(' '); gotoxy(32,22); readln(BETA); until (BETA>-5)and(BETA<5); for I:=0 to 4 do (* Remplissage du tableau des taux----------*) begin TAUX[0,I]:=exp(ALPHA+(2*I-4)*BETA); TAUX[1,I]:=exp(-ALPHA+(4-2*I)*BETA); end; end; (*---------------------------------------------------------------------------*) procedure CONTACT; (* Saisie des paramtres pour le processus de contact et calcul des taux de *) (* transition. *) var I : integer; begin clrscr; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ PROCESSUS DE CONTACT บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); writeln; writeln(' Le taux de transition de 1 0 est constant et vaut 1.'); writeln(' Le taux de transition de 0 1 est proportionnel au '); writeln(' nombre de voisins 1. '); writeln(' Les taux de transition en un site ayant V voisins '); writeln(' 1 s''crivent '); writeln; writeln(' c(0,V) = LAMBDA V '); writeln(' c(1,V) = 1. '); writeln; writeln; writeln; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ Valeur du paramtre LAMBDA บ '); writeln(' บ บ '); writeln(' บ บ '); writeln(' บ LAMBDA = ? บ '); writeln(' บ บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); repeat (* Saisie de LAMBDA-------------------------*) gotoxy(32,20); writeln(' '); gotoxy(32,20); readln(LAMBDA); until LAMBDA>=0; for I:=0 to 4 do (* Remplissage du tableau des taux----------*) begin TAUX[0,I]:=LAMBDA*I; TAUX[1,I]:=1.000; end; end; (*---------------------------------------------------------------------------*) procedure ELECTION; (* Prsentation et calcul des taux de transition du modle d'lection *) var I : integer; C : char; begin clrscr; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ MODELE D''ELECTION บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); writeln; writeln; writeln(' Le taux de transition de 0 1 est gal au nombre de '); writeln(' voisins 1. '); writeln(' Le taux de transition de 1 0 est gal au nombre de '); writeln(' voisins 0. '); writeln(' Les taux de transition en un site ayant V voisins '); writeln(' 1 s''crivent '); writeln; writeln; writeln(' c(0,V) = V'); writeln(' c(1,V) = 4-V '); for I:=0 to 4 do (* Remplissage du tableau des taux----------*) begin TAUX[0,I]:=I; TAUX[1,I]:=4-I; end; gotoxy(29,20); writeln('Une touche pour continuer.'); repeat until keypressed; C:=readkey; end; (*---------------------------------------------------------------------------*) procedure PHILOSOPHES; (* Saisie des paramtres pour le processus des philosophes et calcul des taux*) (* de transition. *) var I : integer; begin clrscr; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ PROCESSUS DES PHILOSOPHES บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); writeln; writeln(' Le taux de transition de 1 0 est constant et vaut 1.'); writeln(' Le taux de transition de 0 1 vaut LAMBDA si les deux'); writeln(' voisins sont 0. Il est nul sinon. '); writeln(' Les taux de transition en un site ayant V voisins '); writeln(' 1 s''crivent '); writeln; writeln(' c(0,0) = LAMBDA '); writeln(' c(0,V) = 0 si V>0 '); writeln(' c(1,V) = 1. '); writeln; writeln; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ Valeur du paramtre LAMBDA บ '); writeln(' บ บ '); writeln(' บ บ '); writeln(' บ LAMBDA = ? บ '); writeln(' บ บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); repeat (* Saisie de LAMBDA-------------------------*) gotoxy(32,20); writeln(' '); gotoxy(32,20); readln(LAMBDA); until LAMBDA>=0; for I:=0 to 4 do (* Remplissage du tableau des taux----------*) begin TAUX[0,I]:=0; TAUX[1,I]:=1.000; end; TAUX[0,0]:=LAMBDA; end; (*---------------------------------------------------------------------------*) procedure UTILISATEUR; (* Saisie du tableau des taux choisis par l'utilisateur *) var I,J : integer; OK : char; begin clrscr; writeln(' ษออออออออออออออออออออออออออออออออออออออออออป '); writeln(' บ SAISIE DES TAUX DE TRANSITION บ '); writeln(' ศออออออออออออออออออออออออออออออออออออออออออผ '); writeln; writeln; writeln; writeln; writeln; writeln; writeln; writeln(' V=0 V=1 V=2 V=3 V=4 '); writeln(' ษอออออออออหอออออออออหอออออออออหอออออออออหอออออออออป'); writeln(' De 0 1 บ บ บ บ บ บ'); writeln(' อออออออออฮอออออออออฮอออออออออฮอออออออออฮอออออออออฮอออออออออน'); writeln(' De 1 0 บ บ บ บ บ บ'); writeln(' ศอออออออออสอออออออออสอออออออออสอออออออออสอออออออออผ'); repeat for I:=0 to 1 do for J:=0 to 4 do repeat begin gotoxy(19+10*J,13+2*I); writeln(' '); gotoxy(19+10*J,13+2*I); readln(TAUX[I,J]); end; until TAUX[I,J]>=0; gotoxy(32,20); writeln('D''accord (O/N) ?'); OK:=readkey; until (OK='o') or (OK='O'); end; (*------------ Fin des procdures de saisie de paramtres -------------------*) (*---------------------------------------------------------------------------*) (*----------- Calcul des probabilits de changement en un site --------------*) (*---------------------- en fonction des taux -------------------------------*) (*---------------------------------------------------------------------------*) procedure CALCUL_PROBA; (* Les probabilits de changements sont obtenues partir des taux en *) (* divisant par leur plus grande valeur : MAXTAUX. *) var MAXTAUX : real; I,J : integer; begin MAXTAUX:=0.0000; for I:=0 to 1 do for J:=0 to 4 do if (TAUX[I,J] > MAXTAUX) then MAXTAUX:=TAUX[I,J]; for I:=0 to 1 do for J:=0 to 4 do PROBA[I,J]:=TAUX[I,J]/MAXTAUX; end; (*---------------------------------------------------------------------------*) (*---------------Calculs des nombres de voisins occups----------------------*) (*---------------------------------------------------------------------------*) function VOISINS(X,Y:integer):integer; (* Retourne le nombre de voisins 1 du point (X,Y), en distinguant les *) (* bords et les coins. *) var NVOIS : integer; begin NVOIS := 0; (*---------------------------------------------------------------------------*) case X of 0 : (* Bord 0uest---------------------------------*) begin case Y of 0 : (* Coin Nord-Ouest----------------------------*) begin if CONFIG[X+1,Y] then NVOIS:=NVOIS+1; if CONFIG[X,Y+1] then NVOIS:=NVOIS+1; (* Voisins dans le cadre puis voisins en dehors------------*) case REPBORD of #60 : (* Bord 1----------*) NVOIS:=NVOIS+2; #61 : (* Bord priodique---*) begin if CONFIG[249,Y] then NVOIS:=NVOIS+1; if CONFIG[X,199] then NVOIS:=NVOIS+1; end; end; (* Fin du case REPBORD------------------------*) end; (* Fin du coin Nord-Ouest---------------------*) 199 : (* Coin Sud-Ouest-----------------------------*) begin if CONFIG[X+1,Y] then NVOIS:=NVOIS+1; if CONFIG[X,Y-1] then NVOIS:=NVOIS+1; (* Voisins dans le cadre puis voisins en dehors------------*) case REPBORD of (* Bord 1----------*) #60 : NVOIS:=NVOIS+2; #61 : (* Bord priodique---*) begin if CONFIG[249,Y] then NVOIS:=NVOIS+1; if CONFIG[X,0] then NVOIS:=NVOIS+1; end; end; (* Fin du case REPBORD------------------------*) end; (* Fin du coin Sud-Ouest----------------------*) else (* Tous les autres points du bord Ouest-------*) begin if CONFIG[X+1,Y] then NVOIS:=NVOIS+1; if CONFIG[X,Y-1] then NVOIS:=NVOIS+1; if CONFIG[X,Y+1] then NVOIS:=NVOIS+1; (* Voisins dans le cadre puis voisins en dehors------------*) case REPBORD of #60 : (* Bord 1----------*) NVOIS:=NVOIS+1; #61 : (* Bord priodique---*) if CONFIG[249,Y] then NVOIS:=NVOIS+1; end; (* Fin du case REPBORD------------------------*) end; (* Fin du bord Ouest hors les coins-----------*) end; (* Fin du case Y------------------------------*) end; (* Fin du bord Ouest--------------------------*) (*---------------------------------------------------------------------------*) 249 : (* Bord Est-----------------------------------*) begin case Y of 0 : (* Coin Nord-Est------------------------------*) begin if CONFIG[X-1,Y] then NVOIS:=NVOIS+1; if CONFIG[X,Y+1] then NVOIS:=NVOIS+1; (* Voisins dans le cadre puis voisins en dehors------------*) case REPBORD of #60 : (* Bord 1----------*) NVOIS:=NVOIS+2; #61 : (* Bord priodique---*) begin if CONFIG[0,Y] then NVOIS:=NVOIS+1; if CONFIG[X,199] then NVOIS:=NVOIS+1; end; end; (* Fin du case REPBORD------------------------*) end; (* Fin du coin Nord-Est-----------------------*) 199 : (* Coin Sud-Est-------------------------------*) begin if CONFIG[X-1,Y] then NVOIS:=NVOIS+1; if CONFIG[X,Y-1] then NVOIS:=NVOIS+1; (* Voisins dans le cadre puis voisins en dehors------------*) case REPBORD of #60 : (* Bord 1----------*) NVOIS:=NVOIS+2; #61 : (* Bord priodique---*) begin if CONFIG[0,Y] then NVOIS:=NVOIS+1; if CONFIG[X,0] then NVOIS:=NVOIS+1; end; end; (* Fin du case REPBORD------------------------*) end; (* Fin du coin Sud-Est------------------------*) else (* Tous les autres points du bord Est---------*) begin if CONFIG[X-1,Y] then NVOIS:=NVOIS+1; if CONFIG[X,Y-1] then NVOIS:=NVOIS+1; if CONFIG[X,Y+1] then NVOIS:=NVOIS+1; (* Voisins dans le cadre puis voisins en dehors------------*) case REPBORD of #60 : (* Bord 1----------*) NVOIS:=NVOIS+1; #61 : (* Bord priodique---*) if CONFIG[0,Y] then NVOIS:=NVOIS+1; end; (* Fin du case REPBORD------------------------*) end; (* Fin du bord Est hors les coins-------------*) end; (* Fin du case Y------------------------------*) end; (* Fin du bord Est----------------------------*) else (* X de 1 248-------------------------------*) begin case Y of 0 : (* Bord Nord hors les coins-------------------*) begin if CONFIG[X+1,Y] then NVOIS:=NVOIS+1; if CONFIG[X-1,Y] then NVOIS:=NVOIS+1; if CONFIG[X,Y+1] then NVOIS:=NVOIS+1; (* Voisins dans le cadre puis voisins en dehors------------*) case REPBORD of #60 : (* Bord 1----------*) NVOIS:=NVOIS+1; #61 : (* Bord priodique---*) if CONFIG[X,199] then NVOIS:=NVOIS+1; end; (* Fin du case REPBORD----------------------*) end; (* Fin du bord Nord-------------------------*) 199 : (* Bord Sud hors les coins--------*) begin if CONFIG[X+1,Y] then NVOIS:=NVOIS+1; if CONFIG[X-1,Y] then NVOIS:=NVOIS+1; if CONFIG[X,Y-1] then NVOIS:=NVOIS+1; (* Voisins dans le cadre puis voisins en dehors------------*) case REPBORD of #60 : (* Bord 1----------*) NVOIS:=NVOIS+1; #61 : (* Bord priodique---*) if CONFIG[X,0] then NVOIS:=NVOIS+1; end; (* Fin du case REPBORD----------------------*) end; (* Fin du bord Sud--------------------------*) else (* Tous les points de l'intrieur du cadre--*) begin if CONFIG[X+1,Y] then NVOIS:=NVOIS+1; if CONFIG[X-1,Y] then NVOIS:=NVOIS+1; if CONFIG[X,Y-1] then NVOIS:=NVOIS+1; if CONFIG[X,Y+1] then NVOIS:=NVOIS+1; end; (* Fin de l'intrieur du cadre--------------*) end; (* Fin du case Y----------------------------*) end; (* Fin des X de 1 248---------------------*) end; (* Fin du case X----------------------------*) VOISINS := NVOIS; end; (* Fin de la fonction VOISINS-----------------*) (*---------------------------------------------------------------------------*) (*--------- Gestion du changement de la configuration en un point -----------*) (*---------------------------------------------------------------------------*) procedure ALLUME(X,Y :integer); (* allume les 4 pixels correspondant l'lement (X,Y) du tableau *) (* et met jour la configuration. *) var XAL,YAL : integer; begin XAL := X+X+10; YAL := Y+Y+10; setcolor(15); putpixel(XAL,YAL,15); putpixel(XAL+1,YAL,15); putpixel(XAL,YAL+1,15); putpixel(XAL+1,YAL+1,15); CONFIG[X,Y] := true; end; (*---------------------------------------------------------------------------*) procedure ETEINT(X,Y :integer); (* teint les 4 pixels correspondant l'lment (X,Y) du tableau *) (* et met jour la configuration. *) var XET,YET : integer; begin XET := X+X+10; YET := Y+Y+10; setcolor(0); putpixel(XET,YET,0); putpixel(XET+1,YET,0); putpixel(XET,YET+1,0); putpixel(XET+1,YET+1,0); CONFIG[X,Y] := false; end; (*---------------------------------------------------------------------------*) (*-----------Initialisations du graphique et de la configuration-------------*) (*---------------------------------------------------------------------------*) procedure PAGE_GRAPHIQUE; (* Instaure le mode graphique, trace les diffrents cadres et les messages *) (* fixes. *) var STRTAUX, STRALPHA, STRBETA, STRLAMBDA : string[6]; I, J : integer; begin setgraphmode(GRM); (* Installe le mode graphique---------*) setlinestyle(0,0,1); (* Trac des diffrents cadres--------*) rectangle(6,6,513,413); rectangle(520,6,639,479); rectangle(522,6,639,477); line(522,30,639,30); line(522,32,639,32); line(522,130,639,130); line(522,132,639,132); line(540,200,639,200); line(540,200,540,340); line(522,413,639,413); line(522,415,639,415); settextstyle(0,0,1); (* Messages communs-------------------*) outtextxy(540,428,'Itrations'); outtextxy(570,145,'Taux'); outtextxy(528,210,'0'); outtextxy(528,240,'1'); outtextxy(528,270,'2'); outtextxy(528,300,'3'); outtextxy(528,330,'4'); outtextxy(560,190,'0'); outtextxy(610,190,'1'); for I:=0 to 1 do for J:=0 to 4 do begin str(TAUX[I,J]:6:2,STRTAUX); outtextxy(540+50*I,210+30*J,STRTAUX); end; case REPPROC of #59 : (* F1 : Ising-------------------------*) begin outtextxy(550,15,'ISING'); outtextxy(530,45,'Alpha '); str(ALPHA:6:2,STRALPHA); outtextxy(530,65,STRALPHA); outtextxy(530,95,'Beta '); str(BETA:6:2,STRBETA); outtextxy(530,115,STRBETA); end; #60 : (* F2 : Contact-----------------------*) begin outtextxy(550,15,'CONTACT'); outtextxy(530,50,'Lambda '); str(LAMBDA:6:2,STRLAMBDA); outtextxy(530,70,STRLAMBDA); end; #61 : (* F3 : Election----------------------*) begin outtextxy(540,15,'ELECTION'); end; #62 : (* F4 : Philosophes-------------------*) begin outtextxy(530,15,'PHILOSOPHES'); outtextxy(530,50,'Lambda '); str(LAMBDA:6:2,STRLAMBDA); outtextxy(530,70,STRLAMBDA); end; #63 : (* F5 : Saisie Ecran------------------*) begin outtextxy(530,15,'SAISIE ECRAN'); end; end; outtextxy(100,450,'Une touche pour stopper'); end; (*---------------------------------------------------------------------------*) procedure INIT_CONFIG; (* Calcule la configuration initiale choisie par l'utilisateur *) (* et initialise le compteur d'itrations. *) var X, Y, V, I, J : integer; begin NITER:=0; case REPINIT of #59 : (* F1 : Carr------------------------*) begin for X:=0 to 249 do for Y:= 0 to 199 do CONFIG[X,Y]:=false; for X:=60 to 190 do for Y:= 50 to 150 do CONFIG[X,Y]:=true; end; #60 : (* F2 : Damier-----------------------*) begin for X:=0 to 249 do for Y:= 0 to 199 do if (((X div 50) mod 2)=0) xor (((Y div 50) mod 2)=0) then CONFIG[X,Y]:=true else CONFIG[X,Y]:=false; end; #61 : (* F3 : Diagonales-------------------*) begin for X:=0 to 249 do for Y:= 0 to 199 do if ((X+Y) mod 20) < 8 then CONFIG[X,Y]:=true else CONFIG[X,Y]:=false; end; #62 : (* F4 : Sites indpendants-----------*) begin for X:=0 to 249 do for Y:= 0 to 199 do if random
#27) do begin CHOIX_PROCESSUS; (* Choix du type de processus-------------*) if REPPROC=#27 then REPBORD:=#27 else begin REPBORD:=#59; case REPPROC of (* Choix des paramtres-------------------*) #59 : ISING; #60 : CONTACT; #61 : ELECTION; #62 : PHILOSOPHES; #63 : UTILISATEUR; end; CALCUL_PROBA; (* Calcul des probabilits de changement--*) end; while (REPBORD<>#27) do begin CHOIX_BORD; (* Choix des conditions de bord-----------*) if REPBORD=#27 then REPINIT:=#27 else REPINIT:=#59; while (REPINIT<>#27) do begin CHOIX_INIT; (* Choix d'une configuration initiale-----*) if REPINIT=#27 then REPSTOP:=#27 else REPSTOP:=#59; INIT_CONFIG; while (REPSTOP<>#27) do begin PAGE_GRAPHIQUE; (* Initialisation graphique---------------*) CONFIG_GRAPHIQUE; SITES; (* Simulation-----------------------------*) STOP; end; REPSTOP:=#59; end; end; end; closegraph; clrscr; end. (*---------------------------Fin du programme--------------------------------*)