train_som_data Subroutine

public subroutine train_som_data(kohonen_map, input_data)

Training function for self_organizing_map

Type Bound

self_organizing_map

Arguments

Type IntentOptional Attributes Name
class(self_organizing_map) :: kohonen_map

A self_organizing_map object
type(kohonen_pattern), intent(inout), dimension(:) :: input_data

A kohonen_pattern array with the input data

Calls

proc~~train_som_data~~CallsGraph proc~train_som_data self_organizing_map%train_som_data none~get_prototype kohonen_prototype%get_prototype proc~train_som_data->none~get_prototype proc~calculate_distance_between_prototypes self_organizing_map%calculate_distance_between_prototypes proc~train_som_data->proc~calculate_distance_between_prototypes proc~calculate_u_matrix self_organizing_map%calculate_u_matrix proc~train_som_data->proc~calculate_u_matrix proc~find_best_match_unit self_organizing_map%find_best_match_unit proc~train_som_data->proc~find_best_match_unit proc~kohonen_pattern_accessor kohonen_pattern%kohonen_pattern_accessor proc~train_som_data->proc~kohonen_pattern_accessor proc~update_weights self_organizing_map%update_weights proc~train_som_data->proc~update_weights proc~position2index self_organizing_map%position2index proc~calculate_distance_between_prototypes->proc~position2index none~distance~8 kohonen_prototype%distance proc~calculate_u_matrix->none~distance~8 float float proc~find_best_match_unit->float proc~find_best_match_unit->none~distance~8 proc~update_weights->none~get_prototype dexp dexp proc~update_weights->dexp none~set_prototype kohonen_prototype%set_prototype proc~update_weights->none~set_prototype proc~index2position self_organizing_map%index2position proc~update_weights->proc~index2position proc~update_weights->proc~position2index none~distance~8->none~get_prototype calculate calculate none~distance~8->calculate

Called by

proc~~train_som_data~~CalledByGraph proc~train_som_data self_organizing_map%train_som_data proc~external_train_map self_organizing_map%external_train_map proc~external_train_map->proc~train_som_data proc~train_som train_som proc~train_som->proc~train_som_data

Variables

Type Visibility Attributes Name Initial
integer, public :: iteration
integer, public :: iepoch
integer, public :: ipattern
integer, public :: ix
integer, public :: iy
integer, public :: iz
integer, public :: jhit
integer, public :: ihit
integer, public :: khit
integer, public :: ineigh
integer, public :: jneigh
integer, public :: kneigh
integer, public :: idbg
integer, public :: number_variables
integer, public :: idisto
integer, public :: cx
integer, public :: cy
integer, public :: cz
integer, public :: i
integer, public :: j
integer, public :: k
integer, public :: number_nodes
integer, public :: debug_option
integer, public :: ix1
integer, public :: iy1
integer, public :: iz1
integer, public :: pos
integer, public :: pos1
integer, public :: max_pattern
integer, public :: ierr
integer, public :: nx
integer, public :: ny
integer, public :: nz
integer, public :: ipos
integer, public :: current_pos
integer, public :: ic
integer, public :: itemp
real(kind=wp), public :: distortion
real(kind=wp), public :: dist
real(kind=wp), public :: dist_hit
real(kind=wp), public :: maximum_radius
real(kind=wp), public :: minimum_radius
real(kind=wp), public :: current_radius
real(kind=wp), public :: alpha
real(kind=wp), public :: u_temp
type(kohonen_prototype), public :: current_prototype
real(kind=wp), public, dimension(kohonen_map%parameters%number_variables1, kohonen_map%parameters%number_variables2) :: current_values
integer, public, allocatable :: pattern_index(:,:,:,:)
integer, public, allocatable :: positions(:)

Source Code

   subroutine train_som_data(kohonen_map,input_data)
!========================================================================================
!!   Training function for self_organizing_map 
      class(self_organizing_map) :: kohonen_map
!! A `self_organizing_map` object
      type(kohonen_pattern),dimension(:),intent(inout) :: input_data
!! A `kohonen_pattern` array with the input data
      integer :: iteration,iepoch,ipattern,ix,iy,iz,jhit,ihit,khit,ineigh,jneigh
      integer :: kneigh,idbg,number_variables,idisto !neff,
      integer :: cx,cy,cz,i,j,k,number_nodes,debug_option,ix1,iy1,iz1,pos,pos1,max_pattern
      integer :: ierr,nx,ny,nz,ipos
      integer :: current_pos,ic,itemp
      real(kind=wp) :: distortion,dist,dist_hit,maximum_radius,minimum_radius
      real(kind=wp) :: current_radius,alpha,u_temp
      type(kohonen_prototype) :: current_prototype
      real(kind=wp),dimension(kohonen_map%parameters%number_variables1,&
      kohonen_map%parameters%number_variables2) :: current_values
      integer,allocatable :: pattern_index(:,:,:,:),positions(:)
!
! 
!
      nx=kohonen_map%parameters%number_nodes_nx;
      ny=kohonen_map%parameters%number_nodes_ny;
      nz=kohonen_map%parameters%number_nodes_nz;
      allocate(positions(nx*ny*nz),stat=ierr);
      idbg=kohonen_map%parameters%idbg;
      idisto=kohonen_map%parameters%idisto;
      debug_option=kohonen_map%parameters%debug_level;
      if(debug_option > 0) then
      open(idbg,file=trim(kohonen_map%parameters%debug_file),status='unknown');
      endif
      iteration = 0;
      distortion = 0.0_wp;
      number_variables=kohonen_map%parameters%number_variables1*kohonen_map%parameters%number_variables2;
      maximum_radius=dble(max(kohonen_map%parameters%number_nodes_nx,kohonen_map%parameters%number_nodes_ny));
      minimum_radius=1.0_wp;
      write(*,*) 'SOM: Training starting...'
      do iepoch = 1,kohonen_map%parameters%number_epochs;
         kohonen_map%distortion(iepoch)=distortion;
         write(6,*) ' Starting epoch -- distortion',iepoch,' -- ',distortion;
        if(iepoch > 1) write(idisto,*) iepoch,distortion
         distortion = 0.0_wp;
         do ipattern = 1, kohonen_map%parameters%number_patterns;
            iteration = iteration + 1;
            ihit = 0;
            jhit = 0;
            khit = 0;
            dist_hit = 100000.0_wp;
            call input_data(ipattern)%get(current_prototype);
            call current_prototype%get_prototype(current_values);
            call kohonen_map%find_best_match_unit(current_prototype,ihit,jhit,khit,dist_hit);
            !write(*,*) 'Test= ',ipattern,ihit,jhit,khit,dist_hit
            if(debug_option > 0) then
               write(idbg,*) 'Epoch,Current Pattern',iepoch,ipattern;
               call current_prototype%print(idbg);
            endif            
            distortion = distortion + dist_hit;
            if(debug_option > 0) then
               write(idbg,*) 'Neighborhood,alpha= ',alpha;
            endif
            call kohonen_map%update_weights(current_values,ihit,jhit,khit,maximum_radius,iteration);
      !   
         enddo !ipattern
      enddo!iepoch
      !       write(*,*) 'SOM: Training finished'
      !       write(*,*) 'Total number of iterations= ',iteration
      !     print prototypes
      ! if(kohonen_map%parameters%train_option < 3) then
      ! do iz=1,size(kohonen_map%grid,3)
      !    !write(kohonen_map%parameters%iprot,'(A,I4)') 'Layer ',iz
      !    do iy=1,size(kohonen_map%grid,2);
      !       do ix=1,size(kohonen_map%grid,1);
      !          !write(kohonen_map%parameters%iprot,'(A6,1X,3I4)') 'node= ',ix,iy,iz            
      !          call kohonen_map%grid(ix,iy,iz)%print(kohonen_map%parameters%iprot);
      !       enddo
      !    enddo
      ! enddo!ix
      ! endif
      !     calculate and print distance matrix
      call kohonen_map%calculate_distance_between_prototypes();
      !     final best match
      !      call kohonen_map%find_bmu_grid(input_data);
      max_pattern=0;         
      do ipattern = 1, kohonen_map%parameters%number_patterns
         ihit = 0;
         jhit = 0;
         khit = 0;
         dist_hit = 100000.0_wp;
         call input_data(ipattern)%get(current_prototype);
         !call current_prototype%get_prototype(current_values);
         call kohonen_map%find_best_match_unit(current_prototype,ihit,jhit,khit,dist_hit);
         kohonen_map%number_patterns(ihit,jhit,khit)=kohonen_map%number_patterns(ihit,jhit,khit)+1;
         if(kohonen_map%number_patterns(ihit,jhit,khit) > max_pattern) then 
               max_pattern=kohonen_map%number_patterns(ihit,jhit,khit);
         endif
         kohonen_map%cells_index(ipattern,1)=ihit;
         kohonen_map%cells_index(ipattern,2)=jhit;
         kohonen_map%cells_index(ipattern,3)=khit;
         if(debug_option > 0) then
            write(idbg,*) ipattern,ihit,jhit,khit;
         endif
         !if(kohonen_map%parameters%train_option < 3) then
         !   write(kohonen_map%parameters%iindex,*) ipattern,ihit,jhit,khit
         !endif
         !         write(*,*) 'BMU= ',ipattern,ihit,jhit,khit,dist_hit
         !
      enddo !ipattern
      !
      allocate(pattern_index(size(kohonen_map%grid,1),&
         size(kohonen_map%grid,2),size(kohonen_map%grid,3),&
         max_pattern),stat=ierr);
      pattern_index=-1;         
      do ipattern=1,kohonen_map%parameters%number_patterns
         ix=kohonen_map%cells_index(ipattern,1);
         iy=kohonen_map%cells_index(ipattern,2);
         iz=kohonen_map%cells_index(ipattern,3);
         do i=1,max_pattern;
            if(pattern_index(ix,iy,iz,i) < 0) then
               pattern_index(ix,iy,iz,i)=ipattern;
               exit;
            endif
         enddo
      enddo!ipattern
      if(kohonen_map%parameters%train_option < 3) then
         do iz1=1,size(kohonen_map%grid,3);
            do iy1=1,size(kohonen_map%grid,2);
               do ix1=1,size(kohonen_map%grid,1);
                  write(kohonen_map%parameters%isam,'(A,3I4)') 'Node= ',ix1,iy1,iz1
                  if(kohonen_map%number_patterns(ix1,iy1,iz1) > 0) then
                     write(kohonen_map%parameters%isam,'(A,10000I5)') 'Sample ID= ',&
                     pattern_index(ix1,iy1,iz1,1:kohonen_map%number_patterns(ix1,iy1,iz1));
                  else
                     write(kohonen_map%parameters%isam,'(A,I4)') 'Sample ID= ',0
                  endif
               enddo
            enddo
         enddo
         deallocate(pattern_index);
      endif
      !
        if(debug_option .gt. 0) then 
            close(idbg);
        endif
        close(idisto);
    
      !     print hit counter
      if(kohonen_map%parameters%train_option < 3) then
         do iz=1,size(kohonen_map%grid,3)
            do ix=1,size(kohonen_map%grid,1);
               write(kohonen_map%parameters%ihit,'(100I5)') (kohonen_map%number_patterns(ix,iy,iz),&
                  iy=1,size(kohonen_map%grid,2));
            enddo!ix
         enddo
      endif
      call kohonen_map%calculate_u_matrix();
!
   end subroutine train_som_data