In rete http://www.elegio.it/fortran/sudoku.html
Il gioco del SUDOKU
L'input è costituito da un file html qualsiasi in cui ci siano almeno 9 righe contenenti ciascuna, solo 9 numeri di una cifra (ossia in tutto una tabella di SUDOKU). Il programma scarta automaticamente le righe in cui ci sia un carattere delimitatore di marca (< oppure >) e quelle che non terminano con una cifra. Il programma potrebbe accettare per errore, una riga senza marche ma con caratteri alfanumerici mescolati e con l'ultimo carattere numerico. Lo scrivere un input sotto form di file HTML è un modo per poter documentare bene l'input stesso. Basta comunque stare attenti di non far cadere in errore il programma (ad esempio mettendo un piccolo commento su ogni riga, tipo <!-- -->, oppure badando di non far finire nessuna riga con una cifra). La tabella 9*9 del SUDOKU va data usando lo 0 come segnalatore di nessun dato. Ad esempio questa è una tabella valida: 0 0 0 7 0 0 4 0 0 0 3 0 0 9 0 0 2 0 4 0 0 0 0 5 0 0 0 0 0 8 0 0 0 0 0 5 0 9 0 0 3 0 0 7 0 6 0 0 0 0 0 3 0 0 0 0 0 4 0 0 0 0 1 0 7 0 0 2 0 0 9 0 0 0 5 0 0 8 0 0 0 Il risultato viene scritto non usando le cifre ma le lettere della parola Esperanto. Ossia: E==1, s==2, p==3, e==4, r==5, a==6, n==7, t==8, o==9. Si tratta di una concessione ad una mia fissazione o meglio, lucida indicazione della Via, Verità e Vita. Chiunque però può operare la trasformazione inversa, magari per controllare se la sua soluzione coincide con quella data dal Corriere della Sera per i Sudoku del giorno prima. Se non altro questo programma serve ad evidenziare cosa è possibile fare programmando in Fortran moderno ossia in Fortran 95. Il sorgente è compilabile usando il compilatore gratuito della Silverfrost (estensione .f95).http://www.silverfrost.com/ Attenzione: l'eseguibile Silverfrost è piccolo ma richiede la loro DLL ottenibile scaricando il loro compilatore ed istallandoselo. Altro compilatore gratuito che ho applicato qui:http://www.g95.org/ Le procedure bat applicate ai file con estensione .f03 creano l'eseguibile a.exe Io ho usato anche il compilatore della Intel (estensione .f90).http://en.wikipedia.org/wiki/Intel_Fortran_Compiler
- http://en.wikipedia.org/wiki/G95
- http://en.wikipedia.org/wiki/Coarray_Fortran
- http://www.fortran.com/F/
- http://www.rice.edu/ ... dove ci si interessa ... e si inventano... le CoArray ... http://caf.rice.edu/index.html
To address these shortcomings, Rice University is developing a clean-slate redesign of the Coarray Fortran programming model. Rice's new design for Coarray Fortran, which we call Coarray Fortran 2.0, is an expressive set of coarray-based extensions to Fortran designed to provide a productive parallel programming model. Compared to the emerging Fortran 2008, Rice's new coarray-based language extensions include some additional features:- http://www.fortran.com/F/compilers.html
- http://www.fortran.com/F/ex_big_integers.html
In Italia vendono compilatori Fortran, ad esempio:
! sudoku.f90
module miosudoku
implicit none
character(len=*),parameter::versione="SUDOKU - ESPERANTESCO : gpbottoni@gmail.com [V20050717]"
type,public:: passo
integer::esaminato
integer,dimension(9,9)::stato
end type passo
type,public::proposta
integer:: r,c,valore
end type proposta
type(proposta)::forse
type(passo),dimension(90)::stati
integer::fase,konto,pausamax,tentativi
character(len=1),dimension(0:9),parameter::es=(/ ".","E","s","p",&
"e","r","a","n","t","o" /), &
sx=(/ " ","^","^","^","^","^","^","^","^","^"/)
!
contains
!
subroutine lettura(s)
type(passo),intent(out)::s
character(len=256)::nomefile,riga
integer::nf,j,nstato,m,r
logical::esiste
!
write(*,*)"Digita il nome del file da cui vuoi leggere ",&
"la situazione iniziale..."
write(*,*)"Attenzione: se il nome finisce con una cifra viene aggiunta ",&
"l'estensione .html"
s%stato(:,:)=0
do j=1,3
read(*,"(1a)") nomefile
nf=len_trim(nomefile)
if(1>nf )exit
if(ichar(nomefile(nf:nf))>47.and.58>ichar(nomefile(nf:nf)))then
nomefile=nomefile(1:nf)//".html"
nf=len_trim(nomefile)
end if
write(*,*)"Cerco ",nomefile(1:nf)
inquire(file=nomefile(1:nf),exist=esiste)
if(esiste) then
open(12,file=nomefile(1:nf),action="read",status="old",iostat=nstato)
if(nstato/=0) then
write(*,*)"Fallisce apertura di ",nomefile(1:nf)
write(*,*)"Invia..."
read(*,*)
exit
end if
write(*,*)"Apertura riuscita"
r=0
tutto : do
read(12,"(1a)",iostat=nstato) riga
if(nstato/=0) then
write(*,*)"Lettura troncata"
close(12)
return
end if
m=scan(riga,char(60))
if(m>0) cycle tutto
m=scan(riga,char(62))
if(m>0) cycle tutto
m=len_trim(riga)
if(2>m) cycle tutto
if(48>ichar(riga(m:m)).or.ichar(riga(m:m))>57) cycle tutto
r=r+1
read(riga,*,iostat=nstato) s%stato(r,:)
if(nstato/=0) then
write(*,*)"Una riga non valida. Tronco la lettura"
close(12)
return
end if
s%stato(r,:)=modulo(s%stato(r,:),10)
write(*,"(20x,3(1x,1a,1x),2x,3(1x,1a,1x),2x,3(1x,1a,1x))") es(s%stato(r,:))
write(*,"(20x,3(1x,1a,1x),2x,3(1x,1a,1x),2x,3(1x,1a,1x))") sx(s%stato(r,:))
if(r.eq.3.or.r.eq.6) write(*,*)" "
if(r>=9) then
close(12)
return
end if
end do tutto
else
write(*,*)"Non trovo ",nomefile(1:nf)
write(*,*)"...altro tentativo..."
end if
end do
return
end subroutine lettura
!
subroutine imposto()
integer::j
do j=1,size(stati,1)
stati(j)%stato(:,:)=0
end do
stati(:)%esaminato=0
fase=0
tentativi=0
return
end subroutine imposto
!
function achepunto(situazione)result(tento)
type(passo),intent(in)::situazione
type(proposta)::tento
integer::j,k,jj,kk,p,jp,kp
tento%r=0
tento%c=0
tento%valore=0
if(situazione%esaminato>8) then
return
end if
do jj=0,6,3
do kk=0,6,3
do j=jj+1,jj+3
do k=kk+1,kk+3
if(situazione%stato(j,k)==0) then
tento%r=j
tento%c=k
unico: do p=situazione%esaminato+1,9
do jp=jj+1,jj+3
do kp=kk+1,kk+3
if(situazione%stato(jp,kp)==p) then
cycle unico
end if
end do
end do
tento%valore=p
exit unico
end do unico
if(tento%valore==0) then
tentativi=tentativi+1
! write(*,*)"tento%valore nullo!"
end if
return
end if
end do
end do
end do
end do
return
end function achepunto
!
function baco(s,avviso,nf)result(bah)
logical::bah
type(passo),intent(in)::s
integer,optional,intent(in)::nf
character(len=*),intent(in)::avviso
integer::j,nfu
bah=.false.
if(avviso(1:1)=="!") konto=0
if(modulo(konto,pausamax)/=0) return
if(present(nf)) then
nfu=nf
else
nfu=6
end if
write(nfu,*) avviso
do j=1,9
write(nfu,"(20x,3(1x,1a,1x),2x,3(1x,1a,1x),2x,3(1x,1a,1x))") es(s%stato(j,:))
write(nfu,"(20x,3(1x,1a,1x),2x,3(1x,1a,1x),2x,3(1x,1a,1x))") sx(stati(1)%stato(j,:))
if(j.eq.3.or.j.eq.6) write(nfu,*)" "
end do
j=0
if(nfu==6) then
write(*,*) konto, "Un invio per continuare..."
! read(*,*) j
read(*,*)
end if
if(j>0) bah=.true.
return
end function baco
!
function ammesso(situazione,tento)result(siono)
type(passo),intent(in)::situazione
type(proposta),intent(in)::tento
logical::siono
integer::j,k,r,c
if ((tento%r>9).or.(1>tento%r).or.(tento%c>9).or.(1>tento%c) &
.or.(tento%valore>9).or.(1>tento%valore)) then
siono=.false.
return
end if
r=tento%r
c=tento%c
! write(*,*)"Valuto",r,c,tento%valore
if(situazione%stato(r,c)/=0) then
siono=.false.
return
end if
! Prova nel suo cellone
do j=1+3*((r-1)/3),3+3*((r-1)/3)
do k=1+3*((c-1)/3),3+3*((c-1)/3)
if(situazione%stato(j,k)==tento%valore) then
! write(*,*)tento%valore," male:, anche in",j,k
siono=.false.
return
end if
end do
end do
! write(*,*)"Nel cellone va bene"
do j=1,9
if(situazione%stato(r,j)==tento%valore) then
siono=.false.
! write(*,*)tento%valore,": Male: anche in",r,j
return
end if
end do
!
do j=1,9
if(situazione%stato(j,c)==tento%valore) then
siono=.false.
! write(*,*)tento%valore,": Male: anche in",j,c
return
end if
end do
siono=.true.
! write(*,*)"accettabile"
return
end function ammesso
!
function fatti(situazione)result(n)
type(passo),intent(in)::situazione
integer::n
integer::j,k
n=0
do j=1,9
do k=1,9
if(situazione%stato(j,k)/=0) n=n+1
end do
end do
return
end function fatti
!
end module miosudoku
program sudoku
use miosudoku
implicit none
integer::nunc,j,jp
logical::decido
character(len=60)::avviso,path
call imposto()
write(*,*)"Il gioco del SUDOKU risolto usando, in luogo delle cifre,"
write(*,*)"le nove lettere della LUMINOSA parola: Esperanto"
write(*,*)
write(*,*) versione
write(*,*)
write(*,*)"Dimmi ogni quanti passi deve fare una sosta"
read(*,*) pausamax
if(1>pausamax) pausamax=2000000000
konto=0
nunc=1
call lettura(stati(nunc))
write(*,*)"Un invio per iniziare..."
read(*,*)
ciclo:do
konto=konto+1
fase=fatti(stati(nunc))
if(fase>=81) exit ciclo
forse=achepunto(stati(nunc))
if(forse%valore==0) then
if(nunc>1) then
nunc=nunc-1
!
! write(*,*)"Deve arretrare a",nunc
cycle ciclo
else
write(*,*)"Non riesce ad andare avanti"
read(*,*)
exit ciclo
end if
end if
if(ammesso(stati(nunc),forse)) then
stati(nunc)%esaminato=forse%valore
nunc=nunc+1
stati(nunc)%stato=stati(nunc-1)%stato
stati(nunc)%stato(forse%r,forse%c)=forse%valore
stati(nunc)%esaminato=0
if(baco(stati(nunc),"Ora tenta questo")) then
write(*,*)"Digita t se vuoi veramente terminare"
decido=.false.
read(*,*) decido
if(decido) exit ciclo
end if
else
stati(nunc)%esaminato=forse%valore
end if
end do ciclo
write(*,*) konto
konto=0
decido=baco(stati(nunc),"Situazione finale")
write(*,*)"Digita 1 per salvare i passaggi per arrivare al risultato:"
read(*,*) konto
if(konto==1) then
write(*,*)"Digita il path (quello locale== .",char(92)," )"
read(*,"(1a)")path
jp=len_trim(path)
if(1>jp) then
path="."//char(92)
jp=len_trim(path)
end if
open(13,file=path(1:jp)//"sudoku-risultato.html",action="write",status="replace")
write(13,*)char(60),"html>",char(60),"body>Sudoku Esperanto",char(60),"pre>"
konto=0
do j=1,nunc
write(avviso,"(1x,1a,i4)")"--- Passo",j
decido=baco(stati(j),avviso,13)
end do
write(13,*)char(60),"/pre>",char(60),"/body>",char(60),"/html>"
close(13)
write(*,*)"Ha salvato sul file ",path(1:jp),"sudoku-risultato.html"
end if
write(*,*)"Ha finito (Fecit: http://mail.cilea.it/~bottoni/)"
read(*,*)
stop
end program sudoku
!