C ********************************************************************** C * C PARST * C COSMETIC OUTPUT CHANGES DEC 2008 ARDEAN LEITH * C IMC FILE FDUM JUN 2009 ARDEAN LEITH * C KV NOV 2011 ARDEAN LEITH * C ********************************************************************** C=* * C=* This file is part of: SPIDER - Modular Image Processing System. * C=* SPIDER System Authors: Joachim Frank & ArDean Leith * C=* Copyright 1985-2011 Health Research Inc., * C=* Riverview Center, 150 Broadway, Suite 560, Menands, NY 12204. * C=* Email: spider@wadsworth.org * C=* * C=* SPIDER 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=* SPIDER 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=* You should have received a copy of the GNU General Public License * C=* along with this program. If not, see * 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 | | * C | NOYAU - DEUCL * C | NOYAU - CHAVA * C | NOYAU - DENDRO - DENLST * C | NOYAU - COUPE * C | * C SCLASSI - RGRI * C * C23456789012345678901234567890123456789012345678901234567890123456789012 C*********************************************************************** SUBROUTINE PARST(N2DIM,KDIM,NFAC,NUMIM,KFAC,NBASE,NITER,NCLAS, & NKLA,KLAS,JW,U,CI,JV,G,KFIN,LUNI,LUNK,IDI,KV) INTEGER :: KLAS(NUMIM) REAL :: CI(NFAC), G(N2DIM,KFAC) REAL :: U(KDIM) INTEGER :: JV(KDIM), JW(KDIM), IDI(NUMIM) INTEGER :: KV(KFAC) REAL :: CI_KV(KFAC) 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 COORD.',/) IF (NBASE .GT. 1) WRITE(NDAT,2000) NKLA,NSTAB,NBASE,NITER,NCLAS 2000 FORMAT & (' PARTITION CONTAINS:' ,I5,' CLASSES',/, & ' THE FIRST',I4,' CONTAIN MOST STABLE OBJECTS IN THE:', & I4,' BASIC PARTITIONS',/, & ' EACH PARTITION 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(NF), NF=1,NFAC), FDUM,FDUM,FIM,FDUM C SAVE IMAGE NUMBER IN IDI IDI(I) = FIM DO KF = 1,KFAC KT = KV(KF) CI_KV(KF) = CI(KT) ENDDO !write(6,*) 'parst:',I, IDI(I),(CI_KV(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_KV(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) 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,KV,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) THEN KG1 = KG1 + NCLAS CYCLE ENDIF 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 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 CLUSTERS FROM 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=',F7.2,/) END