filename changes
[unres.git] / source / ga / GA.f
index cfb58a3..be7bbda 100644 (file)
@@ -4,7 +4,7 @@
       include 'GA.inc'
       include 'common.inc'
       include 'io.inc'
-      real*16 :: WEIGHTS(18)
+      real*8 :: WEIGHTS(18)
       integer*4 :: i,j,m,n,iloc,pos,iter,maxiter,numarg,tmplen
       integer*4 :: WybierzOsobnika,Najlepszy,ZnajdzPodobnego,FindWorst
       integer*4 :: status
@@ -81,8 +81,6 @@ c No. Prepere next generation
        read(ostate,'(L2)') do_ga
        read(ostate,'(F7.5)') avrd
        close(ostate)
-       write(tmptext,'(I4)') generation 
-       call write2log("This is genaration "//tmptext)
        if (do_ga) then
         call write2log("Doing GA in this step")
        endif
@@ -91,7 +89,8 @@ c No. Prepere next generation
         call write2log("ZSCORE weights minimalization disabled for now")
         generation=generation+1
        endif
-
+       write(tmptext,'(I4)') generation 
+       call write2log("This is genaration "//tmptext)
        call ReadOptimaW(BANK_MULTIPLIER*banksize,populacja)
 
 c Yes. Generate random zero-population
@@ -103,23 +102,23 @@ c Yes. Generate random zero-population
         do_ga=.false.
        endif 
 
-c End of "fisrst time here?" code
+c End of "first time here?" code
       endif
 
 c
 c Do we actual use a Genetic Algorithm?
 c
 
-      if (do_ga.eq..true.) then
+      if (do_ga.eqv..true.) then
 
 c Yes. This is only done when doing second pass with ZSCORE (without weight minimalizaton)
 c or with weight minimalization disabled (maxmin=0) just to obtain final score)
 
-c \\---//================================================================
-c  \\-//           
-c   "//  Genetic Algorithm code starts here  
-c   //-\\                                        
-c =//---\\===============================================================
+c \\---//================================================================c
+c  \\-//                                                                 c
+c   "//  Genetic Algorithm code starts here                              c
+c   //-\\                                                                c
+c =//---\\===============================================================c
 
       call ReadZEnergy(BANK_MULTIPLIER*banksize,populacja)
       do i=1,BANK_MULTIPLIER*banksize
@@ -166,9 +165,15 @@ c --- debug begin ---
 c --- debug end ---
          call GetNBest(populacja,bank,banksize)
          call CalcAvgDist(bank,avrd)
+         write(tmptext,'(F7.5)') avrd
+         call write2log("Average distance between individuals in initial&
+     & bank is "//trim(tmptext))
+c
+c Cutoff 
+c
+         csacutoff=(maxco*avrd)-generation*avrd*(maxco-minco)/maxgen
          write(tmptext,'(F7.5)') csacutoff
-         call write2log("CSA cutoff is now set to "//tmptext)
-          csacutoff=(maxco*avrd)-generation*avrd*(maxco-minco)/maxgen
+         call write2log("CSA cutoff is now set to "//trim(tmptext))
 c         csacutoff=maxco*avrd         
 
          
@@ -198,28 +203,50 @@ c --- debug end ---
          call ReadBank(bank)
          write(tmptext,'(F7.5)') avrd
          call write2log("Average distance in bank is "//trim(tmptext))
+
+         csacutoff=maxco*avrd-generation*avrd*(maxco-minco)/maxgen
+         write(tmptext,'(F7.5)') csacutoff
+         call write2log("CSA cutoff is now set to "//trim(tmptext))
   
          do i=1,BANK_MULTIPLIER*banksize
           write(tmptext,'(I4)') i
-          call write2log("Checking ind "//tmptext)  
+          call write2log("Checking ind "//trim(tmptext))  
           j=ZnajdzPodobnego(banksize,bank,populacja(i,:),csacutoff)
-          if (j.gt.0) then
+          if (j.gt.0) then  ! W banku jest podobny
            if (populacja(i,20).lt.bank(j,20)) then
             write(tmptext,'(I4)') j
             write(tmptext2,'(I4)') i
-            call write2log("Swaping ind"//trim(tmptext)//" from bank to &
-     &ind "//trim(tmptext2)//" from population")
+            call write2log("  Swaping ind"//trim(tmptext)//" from bank t&
+     &o ind "//trim(tmptext2)//" from population")
+            write(tmptext2,'(19F8.5,E15.7,F8.5)') bank(j,:)
+            call write2log("  BANK"//trim(tmptext)//":"//trim(tmptext2))
+
+            write(tmptext,'(I4)') i
+            write(tmptext2,'(19F8.5,E15.7,F8.5)') populacja(i,:)
+            call write2log("  POP "//trim(tmptext)//":"//trim(tmptext2))
+      
             bank(j,:)=populacja(i,:)
+           else
+            call write2log("  Found simialar but not better")
            endif
-          else
+          else              ! W banku nie ma podobnego 
            j=FindWorst(banksize,bank)
-           write(tmptext,'(I4)') j
-           write(tmptext2,'(I4)') i
+           write(tmptext2,'(I4)') j
            if (populacja(i,20).lt.bank(j,20)) then
-            call write2log("Worst in bank is "//trim(tmptext))
-            call write2log("Swaping worst ind in bank to "//trim(tmptext&
-     &2))
+            call write2log("  Worst in bank is "//trim(tmptext2))
+            write(tmptext,'(I4)') i
+            call write2log("  Swaping worst ind in bank to "//trim(tmpte&
+     &xt))
+            write(tmptext,'(I4)') j
+            write(tmptext2,'(19F8.5,E15.7,F8.5)') bank(j,:)
+            call write2log("  BANK"//trim(tmptext)//":"//trim(tmptext2))
+            write(tmptext,'(I4)') i
+            write(tmptext2,'(19F8.5,E15.7,F8.5)') populacja(i,:)
+            call write2log("  POP "//trim(tmptext)//":"//trim(tmptext2))
             bank(j,:)=populacja(i,:)
+           else
+            call write2log("  The worst in bank is better then this Ind"&
+     &)
            endif
           endif
          enddo
@@ -241,15 +268,9 @@ c --- debug end ---
 
          call WriteBank(bank)
 
-         csacutoff=maxco*avrd-generation*avrd*(maxco-minco)/maxgen
-c         csacutoff=csacutoff-(generation*cicutoff/maxgen)
-c       csacutoff=cicutoff*(0.8**(iter-1))
-
-         write(tmptext,'(F7.5)') csacutoff
-         call write2log("CSA cutoff is now set to "//tmptext)
         endif
        case('cluster')
-        write(*,*) "Some stuff here in the future"
+        write(*,*) "Well this is not implemented yet"
         goto 2010
       end select
 
@@ -388,7 +409,7 @@ c
       else
        if (do_fs) then
         do_optima=.not.do_optima
-        if (generation.eq.1) then
+        if (generation.eq.0) then
          do_ga=.false.
         else
          do_ga=.not.do_ga
@@ -408,7 +429,7 @@ c      call WritePopSum()
 c
 c Create the inputs
 c 
-      write(tmptext,'(I)') generation
+      write(tmptext,'(I3)') generation+1
       call write2log("Preparing inputs for next generation ("//trim(adju&
      &stl(tmptext))//")")
       call CreateInputs(BANK_MULTIPLIER*banksize,populacja)
@@ -507,7 +528,7 @@ c ----------------------------------------------------------------------
 
       integer*4 function FindWorst(rozmiar,pop)
        integer*4 :: rozmiar, i, idx
-       real*16 :: pop,last
+       real*8 :: pop,last
        dimension pop(rozmiar,21)
        
        last=0.0
@@ -699,7 +720,7 @@ c ----------------------------------------------------------------------
        include 'TEST.inc'
        real*8 :: osobnik(20)
        integer*4 :: i
-       FunkcjaCeluB = 20 + -exp(-abs(WLONG-osobnik(1)))                 &
+       FunkcjaCeluB = 20 -exp(-abs(WLONG-osobnik(1)))                   &
      & - exp(-abs(WSCP-osobnik(2)))                                     &
      & - exp(-abs(WELEC-osobnik(3)))                                    &
      & - exp(-abs(WBOND-osobnik(4)))                                    &
@@ -879,7 +900,7 @@ c GENERATIONS=
          select case (wiersz(1:12))
           case('GENERATIONS=','generations=')
            tmp = wiersz(13:len_trim(wiersz))
-           read(tmp,'(I)') maxgen 
+           read(tmp,'(I4)') maxgen 
          end select 
 
 c CICUTOFF=
@@ -911,7 +932,7 @@ c POPULATION=
          select case(wiersz(1:11))
           case('POPULATION=','population=')
            tmp = wiersz(12:len_trim(wiersz))
-           read(tmp,'(I)') banksize
+           read(tmp,'(I4)') banksize
            call write2log("Bank size is set to "//tmp)
          end select
 
@@ -969,7 +990,7 @@ c MAXMIN=
          select case(wiersz(1:7))
           case('MAXMIN=','maxmin=')
           tmp = wiersz(8:len_trim(wiersz))
-          read(tmp,'(I)') maxminstep
+          read(tmp,'(I4)') maxminstep
           if (maxminstep.gt.0) then
            call write2log("ZSCORE weights minimalization set to "//tmp)
            do_optima=.true.
@@ -1303,8 +1324,8 @@ c        call write2log("Delta is "//tmp)
         if (delta.lt.mindelta) then
           mindelta=delta
           pozycja=i
-          write(tmp,'(F7.5,X,I)') delta,pozycja
-          call write2log("Delta is "//tmp)
+          write(tmp,'(F7.5,X,I4)') delta,pozycja
+          call write2log("  Delta is "//tmp)
         endif
       end do
 
@@ -1621,6 +1642,37 @@ c ----------------------------------------------------------------------
       end subroutine
 
 c ======================================================================
+c  WriteBankHistory subroutine
+c ======================================================================
+c  Writes CSA BANK History to file 
+c ----------------------------------------------------------------------
+      subroutine WriteBankHistory(b)
+       include 'io.inc'
+       include 'common.inc'
+       real*8,dimension(banksize,21) :: b  
+       character*250 :: tmptext
+       character*250 :: header   
+
+
+       header="#    WLONG      WSCP     WELEC     WBOND      WANG    WSC&
+     &LOC      WTOR     WTORD    WCORRH    WCORR4    WCORR5    WCORR6   &
+     &WEL_LOC    WTURN3    WTURN4    WTURN6    WVDWPP      WHPB    WSCCO&
+     &R            FFV   FITNESS" 
+       call write2log("Writing Bank history to file "//obankhfn)
+       open(obankh, file = obankhfn)
+       write(iobank, "(A)") trim(adjustl(header))
+       
+       do i=1,banksize
+        write(obankh,'(19F10.5,E15.7,F10.5)') (b(i,j),j=1,21)
+        write(tmptext,'(19F10.5,E15.7,F10.5)') (b(i,j),j=1,21)
+        call write2log(trim(tmptext))  
+       enddo 
+       close(iobank)
+      end subroutine
+
+c
+c ======================================================================
 c  ReadBank subroutine
 c ======================================================================
 c  Read CSA BANK from file
@@ -1676,7 +1728,7 @@ c ----------------------------------------------------------------------
        include 'common.inc'
        real*8,dimension(banksize,21) :: b
        real*8 :: d,avgd
-       integer*4 :: nd
+       integer*4 :: nd,w
 
        d=0.0                          ! distance
        nd = (banksize-1)*banksize/2   ! number of distances to calculate