Sudoku
Le programme en FORTRAN
Cliquez sur le nom de la partie du programme pour atteindre le code concerné:
program sudoku
integer rechlign,rechcoll,rechcarr
integer n(9,9),n0(9,9) integer ii,jj,ncase,jessai integer kk(9),ik(9),jk(9) integer icarr(9),iligne(9),icolo(9)
! quelques initialisations
do i=1,9 do j=1,9 n(i,j)=0 n0(i,j)=0 end do end do
! entree des données call entree(n0) do i=1,9 do j=1,9 n(i,j)=n0(i,j) end do end do
! debut de la sequence recherche/modification
jessai=1 essai: do while(jessai.eq.1)
do i=1,9 icarr(i)=0 iligne(i)=0 icolo(i)=0 end do
ioomax=0 reste=81 nchangem=1
do ioo=1,10 if((reste.ne.0).and.(nchangem.ne.0)) then ioomax=ioo
! recherche si une solution dans un carre
itcarre: do io=1,10 if((icarr(ioo).ne.0).or.(io.eq.1)) then
docarre: do ii=1,7,3 do jj=1,7,3
call recherche(n,ii,jj,kk,ik,jk,klm) rechcarr=0
do k=1,9
if(kk(k).ne.0) then n(ik(k),jk(k))=kk(k) icarr(ioo)=icarr(ioo)+1 else end if
if(klm.ne.0) then rechcarr=1 else end if
end do
end do
enddo docarre
ij=0 do i=1,9 do j=1,9 if(n(i,j).ne.0) ij=ij+1 end do end do
else end if end do itcarre
! recherche dans une colonne
icol: do io=1,10 if((icolo(ioo).gt.0).or.(io.eq.1)) then
col: do i=1,9 call rechercol(n,i,j,kk,ik,jk,klm) rechcoll=0
do k=1,9 if(kk(k).ne.0) then n(ik(k),jk(k))=kk(k) icolo(ioo)=icolo(ioo)+1 else end if if(klm.ne.0) then rechcoll=1 else end if end do
enddo col
else end if
enddo icol
ij=0 do i=1,9 do j=1,9 if(n(i,j).ne.0) ij=ij+1 end do end do
! recherche dans une ligne
ilign: do io=1,10
if((iligne(ioo).gt.0).or.(io.eq.1)) then do j=1,9
call recherlign(n,i,j,kk,ik,jk,klm)
rechlign=0
do k=1,9 if(kk(k).ne.0) then n(ik(k),jk(k))=kk(k) iligne(ioo)=iligne(ioo)+1 else end if if(klm.ne.0) then rechlign=1 else end if end do
end do
else end if
enddo ilign
ij=0 do i=1,9 do j=1,9 if(n(i,j).ne.0) ij=ij+1 end do end do if((iligne(ioo).eq.0).and.(icolo(ioo).eq.0).and.(icarr(ioo).eq.0)) nchangem=0
reste=81-ij else end if end do
if((81-ij).eq.0) then write (*,*) "le sudoku est trouve" call tableau(n) else write (*,*) "pas de solution"
if((rechlign.eq.1).or.(rechcarr.eq.1).or.(rechcoll.eq.1)) then write(*,*) "trop de possibilite" else write(*,*) "pas de possibilites" end if end if
do io=1,ioomax
write(*,200) io,icarr(io),iligne(io),icolo(io)
200 format(' iteration:',I2,' on a trouve ',i2,' carres, ',i2,' lignes et ',i2,' colonnes')
end do
! choix pour continuer ou non
write(*,*) "tapez 1 pour finir, 2 pour rajouter ou modifier des points" read(*,*) ichoix
if(ichoix.eq.1) then jessai=0 else if(ichoix.eq.2) then call entree(n0) else jessai=0 end if end if
do i=1,9 do j=1,9 n(i,j)=n0(i,j) end do end do
enddo essai
end
subroutine entree(n) integer n(9,9)
ient=1
entr: do while(ient.eq.1) write(*,*) "etat des donnees:" call tableau(n) write(*,*) "combien de cases voulez-vous rentrer ou modifier?"
read (*,*) ncase do i=1,ncase write (*,*) "donnez i,j et la valeur" read (*,*) i,j,n(i,j) end do
write(*,100) 100 format(/,' Vous avez entre le tableau suivant:',/) 110 format(/) Write(*,100) call tableau(n) write(*,110)
write(*,*) "entrez 0 si c'est bon, 1 si vous voulez corriger" read (*,*) ient end do entr
end
subroutine tableau (n) integer n(9,9)
do j=1,9 if((j.eq.4).or.(j.eq.7)) write(*,20) if(j.eq.1) write (*,30) write(*,10) j,n(1,j),n(2,j),n(3,j),n(4,j),n(5,j),n(6,j),n(7,j),n(8,j),n(9,j) 10 format(i2,' '3i3," . ",3i3," . ",3i3,/) 20 format(/,'. ---------------------------------',/) 30 format(/,'. 1 2 3 4 5 6 7 8 9 ',/) end do
end
subroutine recherche(n,ii,jj,kk,ik,jk,klm) integer n(9,9),nkk(9,9,2),nnk(9),kk(9),ik(9),jk(9)
klm=0
do k=1,9 kk(k)=0 ik(k)=0 jk(k)=0 nnk(k)=0 do kkk=1,9 nkk(k,kkk,1)=0 nkk(k,kkk,2)=0 end do end do
do i=ii,ii+2,1 do j=jj,jj+2,1
do k=1,9,1 nk=1 call carre(i,j,n,k,nk) call horizontal(i,j,n,k,nk) call vertical(i,j,n,k,nk)
if(n(i,j).ne.0) nk=0 if(nk.eq.0) then else nnk(k)=nnk(k)+1 nkk(k,nnk(k),1)=i nkk(k,nnk(k),2)=j end if end do
end do end do
do k=1,9 if(nnk(k).eq.1) then kk(k)=k ik(k)=nkk(k,nnk(k),1) jk(k)=nkk(k,nnk(k),2)
else kk(k)=0 end if if(nnk(k).ge.1) klm=1 end do
end
subroutine rechercol(n,i,j,kk,ik,jk,klm) integer n(9,9),nkk(9,9,2),nnk(9),kk(9),ik(9),jk(9)
klm=0
do k=1,9 kk(k)=0 ik(k)=0 jk(k)=0 nnk(k)=0 do kkk=1,9 nkk(k,kkk,1)=0 nkk(k,kkk,2)=0 end do end do
do j=1,9,1
do k=1,9,1 nk=1 call carre(i,j,n,k,nk) call horizontal(i,j,n,k,nk) call vertical(i,j,n,k,nk)
if(n(i,j).ne.0) nk=0 if(nk.eq.0) then else nnk(k)=nnk(k)+1 nkk(k,nnk(k),1)=i nkk(k,nnk(k),2)=j end if end do
end do
do k=1,9 if(nnk(k).eq.1) then kk(k)=k ik(k)=nkk(k,nnk(k),1) jk(k)=nkk(k,nnk(k),2)
else kk(k)=0 end if if(nnk(k).ge.1) klm=1
end do
end
subroutine recherlign(n,i,j,kk,ik,jk,klm) integer n(9,9),nkk(9,9,2),nnk(9),kk(9),ik(9),jk(9)
klm=0
do k=1,9 kk(k)=0 ik(k)=0 jk(k)=0 nnk(k)=0 do kkk=1,9 nkk(k,kkk,1)=0 nkk(k,kkk,2)=0 end do end do
do i=1,9,1
do k=1,9,1 nk=1 call carre(i,j,n,k,nk) call horizontal(i,j,n,k,nk) call vertical(i,j,n,k,nk)
if(n(i,j).ne.0) nk=0 if(nk.eq.0) then else nnk(k)=nnk(k)+1 nkk(k,nnk(k),1)=i nkk(k,nnk(k),2)=j end if end do
end do
do k=1,9 if(nnk(k).eq.1) then kk(k)=k ik(k)=nkk(k,nnk(k),1) jk(k)=nkk(k,nnk(k),2)
else kk(k)=0 end if if(nnk(k).ge.1) klm=1
end do
end
subroutine carre(i,j,n,k,nk)
integer n(9,9),i,j,k,nk,carrek
! recherche dans le carré
if(i.ge.1) ii=1 if(i.ge.4) ii=4 if(i.ge.7) ii=7 if(j.ge.1) jj=1 if(j.ge.4) jj=4 if(j.ge.7) jj=7 carrek=0
do ini=ii,ii+2 do jnj=jj,jj+2
if((ini.eq.i).and.(jnj.eq.j)) then ! rien a faire
else if(n(ini,jnj).eq.k) then carrek=1 else
end if
end if
if(carrek.eq.1) nk=0
end do end do
end
subroutine vertical(i,j,n,k,nk)
integer n(9,9),i,j,k,nk,colonnek,jk
! essai ligne verticale colonnek=0 do jk=1,9 if(n(i,jk).eq.k) then colonnek=1 else end if end do
if(colonnek.eq.1) nk=0
end
subroutine horizontal(i,j,n,k,nk)
integer n(9,9),k,nk,ik,lignek
! essai ligne horizontale
lignek=0
do ik=1,9
if(n(ik,j).eq.k) then lignek=1 else end if
end do
if(lignek.eq.1) nk=0
end