C ********************************************************************** C C PARST C COSMETIC OUTPUT CHANGES DEC 2008 ARDEAN LEITH * C IMC FILE FDUM JUN 2009 ARDEAN LEITH C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2009 Health Research Inc. * C=* * C=* HEALTH RESEARCH INCORPORATED (HRI), * C=* ONE UNIVERSITY PLACE, RENSSELAER, NY 12144-3455. * C=* * C=* Email: spider@wadsworth.org * C=* * C=* This program is free software; you can redistribute it and/or * C=* modify it under the terms of the GNU General Public License as * C=* published by the Free Software Foundation; either version 2 of the * C=* License, or (at your option) any later version. * C=* * C=* This program is distributed in the hope that it will be useful, * C=* but WITHOUT ANY WARRANTY; without even the implied warranty of * C=* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * C=* General Public License for more details. * C=* * C=* You should have received a copy of the GNU General Public License * C=* along with this program; if not, write to the * C=* Free Software Foundation, Inc., * C=* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * C=* * C ********************************************************************** C C PARST(N2DIM,KDIM,NFAC,NUMIM,KFAC,NBASE,NITER,NCLAS, C NKLA,KLAS,JW,U,CI,JV,G,KFIN,LUNI,LUNK,IDI) C C PURPOSE: C CLUSTERING OF NUMIM OBJECTS CHARACTERIZED BY KFAC COORDINATES. C NKLA CLUSTERS ARE DETERMINED. THE NKLA-1 FIRST CLUSTERS C CONTAIN THE MOST STABLE OBJECTS AS OBTAINED FROM THE NBASE C BASIC PARTITIONS. EACH BASIC PARTITION IS GENERATED BY NITER C ITERATIONS AROUND NCLAS SEED-OBJECTS RANDOMLY DRAWN. THE C SEED OBJECTS ARE REPLACED AFTER THE FIRST ITERATION BY THE C GRAVITY CENTERS OF THE GENERATED CLASSES. C C PARAMETERS: C INPUT ..... DATA IN _IMC FILE ON: LUNI (FORMATTED) C NUMIM = NUMBER OF OBJECTS TO BE CLUSTERED C KFAC = NUMBER PF COORDINATES FOR THE OBJECTS C NBASE = NUMBER OF BASIC PARTITIONS C NITER = NUMBER OF ITERATIONS FOR EACH BASIC PARTITION C NCLAS = NUMBER OF CLASSES FOR EACH BASIC PARTITION C NKLA = FINAL NUMBER OF CLUSTERS THE FIRST NKLA-1 C CONTAIN THE STABLES C N2DIM = MAJORANT DE 2*NCLAS C KDIM = MAJORANT DE MAX (NUMIM , NCLAS ** NBASE) C C OUTPUT ..... NUMBER AND COORDINATES OF SEED-OBJECTS C KLAS(NUMIM)= CLASS NUMBER OF EACH OBJECT C KFIN = NUMBER OF NON-EMPTY FINAL CLUSTERS C JV(KFIN) = SIZES RANKED IN DESCENDING ORDER OF C STABLE CLUSTERS C CI(KFAC) = WORKING ARRAY C JW(KDIM) = WORKING ARRAY C G(N2DIM,KFAC) = WORKING ARRAY C C CALL TREE: SCLASSI - NOYAU - PARST - RETIR C - CLAST C - STABK - SHELK C C23456789012345678901234567890123456789012345678901234567890123456789012 C*********************************************************************** SUBROUTINE PARST(N2DIM,KDIM,NFAC,NUMIM,KFAC,NBASE,NITER,NCLAS, & NKLA,KLAS,JW,U,CI,JV,G,KFIN,LUNI,LUNK,IDI) DIMENSION KLAS(NUMIM),CI(NFAC),G(N2DIM,KFAC) DIMENSION U(KDIM), JV(KDIM), JW(KDIM) DIMENSION IDI(NUMIM) COMMON /UNITS/LUN,NIN,NOUT,NECHO,IFOUND,NPROC,NDAT NSTAB = NKLA - 1 WRITE(NDAT,1000) NUMIM,KFAC 1000 FORMAT (' CLUSTERING BY AGGREGATION AROUND MOBILE CENTERS',//, & ' PARTITION OF:',I7,' OBJECTS CHARACTERIZED BY:',I4, & ' CARTESIAN COORDINATES',/) IF (NBASE .GT. 1) WRITE(NDAT,2000) NKLA,NSTAB,NBASE,NITER,NCLAS 2000 FORMAT(' PARTITION CONTAINS:' ,I5,' CLASSES',/, & ' THE',I4,' FIRST CONTAINS THE MOST STABLE OBJECTS IN THE:', & I4,' BASIC PARTITIONS',/, & ' EACH PARTITION IS GENERATED BY:',I5,' ITERATIONS', & ' AROUND:',I4,' RANDOMLY DRAWN SEED-OBJECTS',/) C EXHAUSTIVE RANDOM DRAWING OF SEED-OBJECTS FOR NBASE PARTITION KGERM = NCLAS*NBASE CALL RETIR(NUMIM,KLAS,KGERM,JV) C COPY OVER ALL SEED-OBJECTS TO CLUSTER FILE ON: LUNK CALL REWF(LUNI, 1) ! REWIND THE _IMC FILE TO 2'ND RECORD REWIND LUNK ! REWIND THE CLUSTER FILE TO OVERWRITE DO I = 1,NUMIM C READ THE IMAGE'S FACTOR COORDINATES AND IMAGE NUMBER READ(LUNI,*) (CI(KF), KF=1,NFAC), FDUM,FDUM,FIM,FDUM C SAVE IMAGE NUMBER IN IDI IDI(I) = FIM C write(6,*) I, IDI(I),(CI(KF),KF=1,KFAC) C IF THIS IS SEED-OBJECT IMAGE COPY COORDINATES TO CLUSTER FILE DO M = 1,KGERM IF (JV(M) .EQ. I) WRITE(LUNK) I,(CI(KF),KF=1,KFAC) ENDDO ENDDO C BIG LOOP OVER THE BASIC PARTITIONS N=1,NBASE KG1 = 1 DO N = 1,NBASE KG2 = KG1 + NCLAS - 1 WRITE(NDAT,3000) 3000 FORMAT(' CONSTRUCTION OF PARTITION WITH SEED-OBJECTS:') WRITE(NDAT,3001) (JV(LL), LL=KG1,KG2) 3001 FORMAT(4X,10I6) WRITE(NDAT,*)' ' C SEED-OBJECTS TABLE FOR PARTITION NUMBER N REWIND LUNK ! REWIND CLUSTER FILE J = 0 DO L = 1,KGERM READ(LUNK) I ,(CI(KF), KF=1,KFAC) ! READ CLUSTER FILE DO LL = KG1,KG2 IF (JV(LL) .EQ. I) THEN C SELECTED FOR SEED-OBJECT J = J + 1 DO KF = 1,KFAC G(J,KF) = CI(KF) ENDDO ENDIF ENDDO ENDDO C GENERATION OF PARTITION N BY NITER ITERATIONS. DO NIT = 1,NITER C DETERMINATION OF CLASSES FROM COORDINATES. THE DISTANCE C BETWEEN OBJECT I AND THE NCLAS CENTERS IS CALCULATED. C READS _IMC FILE ON: LUNI CALL CLAST(N2DIM,NFAC,NUMIM,KFAC,NCLAS,G,JW,CI,U,LUNI) ENDDO WRITE(NDAT,4001) NITER 4001 FORMAT(' SIZE OF CLUSTERS AFTER: ',I4,' ITERATIONS') WRITE(NDAT,5000) (U(J), J=1,NCLAS) 5000 FORMAT(4X,10F6.0) IF (N .LE. 1) THEN DO I = 1,NUMIM KLAS(I)= JW(I) ENDDO IF (NBASE .NE. 1) GO TO 100 KFIN = NCLAS NKLA = NCLAS RETURN ENDIF DO I = 1,NUMIM KLAS(I)= KLAS(I) + (JW(I) - 1)*NCLAS**(N-1) ENDDO C END OF BASIC PARTITION NUMBER N 100 KG1 = KG1 + NCLAS ENDDO C GENERATION OF STABLE CLUSTERING WITH NKLA CLUSTERS KTOT = NCLAS ** NBASE CALL STABK(NUMIM,NKLA,KLAS,U,JV,JW,KTOT,KFIN,NIND) PCT = 100.0 * NIND / FLOAT(NUMIM) WRITE(NDAT,6000) 6000 FORMAT(/,' SIZE OF THE CLUSTERS FROM THE CROSSED-PARTITION ',/, & ' FOLLOWED BY THEIR CUMULATIVE PERCENTAGES.') WRITE(NDAT,7000) (JV(K),K=1,KFIN) 7000 FORMAT(/,1X,12I6) WRITE(NDAT,8000) (U(K),K=1,KFIN) 8000 FORMAT(2X,12F6.1) WRITE(NDAT,9000) NKLA,NIND,PCT 9000 FORMAT(/, ' SIZE OF RESIDUAL CLUSTER (NUMBER',I4,')=',I6,//, & ' PERCENTAGE=',F9.2, /,2X,70('-')/) RETURN END