1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
|
PROGRAM PARAMETER
* This program creates the parameter input file for Program
* Multimix/Missing
* Version 1.1A November 1996.
CHARACTER *18 outfile, paramfile,ANS*1,AORD,ATYP
PARAMETER (ik6=6,ip15=60,im10=10,iob=20000)
DIMENSION JP(ip15),IP(ip15),IPC(ip15),ISV(ip15),IEV(ip15),
: IPARTYPE(ip15),IVARTYPE(ip15),NCAT(ip15),PI(ik6),IGRP(iob),
: THETA(ik6,ip15,im10),EMU(ik6,ip15,ip15),IM(ip15),
: EMUL(ik6,ip15,ip15,im10),VARIX(ik6,ip15,ip15,ip15)
print *, ' CREATE A PARAMETER FILE FOR PROGRAM MULTIMIX / MISSING'
print *, ' ------------------------------------------'
print *,' '
print *, ' Name of parameter file:'
READ (*,10) outfile
10 FORMAT(a18)
OPEN (7, FILE=outfile, STATUS='NEW')
print *, ' Number of groups to be fitted:'
READ *, NG
print *, ' Number of individuals:'
READ *, NOBS
print *, ' Total number of attributes:'
READ *, NVAR
print *, ' Number of partitions:'
READ *, NPAR
print *,' Value for ISPEC'
print *, ' (ISPEC=1 - estimates of the parameters are to be input'
print *, ' ISPEC=2 - specified grouping of individuals)'
READ *, ISPEC
PRINT *, 'Do attributes require reordering?'
PRINT *, ' Input y = yes or n = no'
READ (*, 71) AORD
71 FORMAT (A1)
IF ((AORD.EQ.'y').OR.(AORD.EQ.'Y')) THEN
print *,' Column in data array in which attributes are to'
: ,' be stored'
DO 12 J=1,NVAR
print 13,J
13 format (' attribute ',I2,':')
READ *, JP(J)
12 CONTINUE
ELSE
DO 70 J=1,NVAR
JP(J) = J
70 CONTINUE
END IF
* Model of complete local independence
IF (NPAR.EQ.NVAR) THEN
DO 15 L=1,NPAR
IP(L) = 1
ISV(L) = L
IEV(L) = L
15 CONTINUE
* For other models, number of attributes is initially set to one
* The user then identifies those partitions having more than one attribute
ELSE
PRINT *,' '
PRINT *,' '
PRINT *, 'Number of attributes in each partition:'
print *, ' ------------------------------------------'
PRINT *,' '
PRINT *,'How many partitions have MORE THAN ONE attribute?:'
READ *, INUM
DO 16 L=1,NPAR
IP(L)=1
16 CONTINUE
print *, ' ------------------------------------------'
PRINT *,' '
PRINT *,'Identify partitions having MORE THAN ONE attribute'
PRINT *,' '
PRINT *,'Using one line per partition, enter partition number,'
PRINT *,'followed by a space, no. of variables for that partition'
PRINT *,' '
PRINT *,'Repeat for each partition having MORE THAN ONE attribute'
PRINT *,' '
print *, ' ------------------------------------------'
DO 9 I1=1,INUM
READ *, JPAR, IP(JPAR)
9 CONTINUE
* Create ISV(L) and IEV(L) from values of IP(L)
DO 21 L=1,NPAR
IF (L.EQ.1) THEN
ISV(L) = 1
ELSE
ISV(L) = IEV(L-1) + 1
END IF
IEV(L) = ISV(L) + IP(L) - 1
21 CONTINUE
* PRINT 20,L
*20 format( ' Partition ',I2,' starts at variable:')
* READ *, ISV(L)
* PRINT 22
*22 format(16X,'ends at variable:')
* READ *, IEV(L)
END IF
PRINT *, ' Type of model for each partition cell:'
PRINT *, ' Same type of model for each partition cell?'
PRINT *, ' Input y = yes or n = no'
READ (*, 74) ATYP
74 FORMAT (A1)
IF ((ATYP.EQ.'y').OR.(ATYP.EQ.'Y')) THEN
PRINT *, ' Input model type for partition cells'
PRINT *, ' 1 = latent class, 2 = multivariate normal'
: ,' 3 = location model'
READ (*,72) IPAR
72 FORMAT(I1)
DO 73 L=1,NPAR
IPARTYPE(L)= IPAR
73 CONTINUE
ELSE
PRINT *, ' 1 = latent class, 2 = multivariate normal',
: ' 3 = location model'
DO 24 L=1,NPAR
PRINT 17, L
17 FORMAT(' PARTITION ',I2,':')
READ *, IPARTYPE(L)
24 CONTINUE
END IF
* Create IPC(L), the number of continuous attributes in each
* partition. Note that if a location model is specified, only
* one categorical attribute can be present.
DO 19 L=1,NPAR
IF (IPARTYPE(L).EQ.1) THEN
IPC(L)=0
ELSE IF(IPARTYPE(L).EQ.2) THEN
IPC(L)=IP(L)
ELSE IF(IPARTYPE(L).EQ.3) THEN
IPC(L)=IP(L)-1
END IF
19 CONTINUE
* Write out the values to the parameter file
WRITE(7,11) NG,NOBS,NVAR,NPAR,ISPEC
11 FORMAT(I2,1X,I6,1X,I2,1X,I2,1X,I1)
WRITE(7,18)(JP(J),J=1,NVAR)
18 FORMAT(2X,10I4)
WRITE(7,18) (IP(L),L=1,NPAR)
WRITE(7,18) (IPC(L),L=1,NPAR)
WRITE(7,23)(ISV(L),L=1,NPAR)
WRITE(7,23)(IEV(L),L=1,NPAR)
WRITE(7,23)(IPARTYPE(L),L=1,NPAR)
23 FORMAT(2X,10I4)
* Create the type of attribute from the model specified.
* For the location model, the program checks for the categorical
* attribute.
DO 57 L=1,NPAR
IF (IPARTYPE(L).EQ.1) THEN
DO 58 J=ISV(L),IEV(L)
IVARTYPE(J)=1
58 CONTINUE
ELSE IF(IPARTYPE(L).EQ.2) THEN
DO 59 J=ISV(L),IEV(L)
IVARTYPE(J)=2
59 CONTINUE
ELSE IF (IPARTYPE(L).EQ.3) THEN
PRINT 60,L
60 FORMAT(' Location model for partition',I2)
PRINT *,' Input y for yes, n for no'
DO 61 J=ISV(L),IEV(L)
PRINT 62,J
62 FORMAT(' Is attribute ',I2,' categorical?')
READ (*,63) ANS
63 FORMAT(A1)
IF((ANS.EQ.'y').OR.(ANS.EQ.'Y')) THEN
IVARTYPE(J)=3
ELSE IF((ANS.EQ.'n').OR.(ANS.EQ.'N')) THEN
IVARTYPE(J)=4
ELSE
IVARTYPE(J)=9
END IF
61 CONTINUE
END IF
57 CONTINUE
WRITE(7,27)(IVARTYPE(J),J=1,NVAR)
27 FORMAT(2X,10I4)
DO 28 J=1,NVAR
IF (IVARTYPE(J).EQ.1) THEN
PRINT 26,J
26 FORMAT(' Number of categories for attribute ',I2,':')
READ *, NCAT(J)
ELSE IF (IVARTYPE(J).EQ.3) THEN
PRINT *,'(Categorical attribute in location model)'
PRINT 66,J
66 FORMAT(' Number of categories for attribute ',I2,':')
READ *,NCAT(J)
ELSE
NCAT(J)=0
END IF
28 CONTINUE
WRITE(7,27)(NCAT(J),J=1,NVAR)
IER = 0
CALL ERROR(NVAR,NPAR,ISPEC,IP,IPC,IPARTYPE,IVARTYPE,ISV,IEV,NCAT,
: IER)
IF(IER.EQ.1) THEN
PRINT *, ' ERROR IN INPUT VALUES, CHECK OUTFILE'
STOP
END IF
* Read in the parameters for the distribution.
* First, the mixing proportions.A check is made that the inputed
* values sum to 1.
IF(ISPEC.EQ.1) THEN
print *, ' Mixing proportions for each group:'
SUMPI=0.0
TOL=0.000001
DO 30 K=1,NG
print 31, K
31 FORMAT( ' Group ',I2,':')
READ *, PI(K)
SUMPI=SUMPI+PI(K)
30 CONTINUE
IF(ABS(SUMPI-1).LT.TOL) THEN
WRITE(7,32)(PI(K),K=1,NG)
32 FORMAT(30F8.4)
ELSE
PRINT *,' -----------------------------------'
PRINT *, ' **** ERROR, CONTINUE INPUT, BUT '
PRINT *, ' CHECK OUTFILE & CORRECT PI(K)'
PRINT *,' SUM PI(K) NOT EQUAL TO 1 *****'
PRINT *,' -----------------------------------'
WRITE(7,53)(PI(K),K=1,NG)
53 FORMAT(' ----PI(K) ERROR',10F7.4)
END IF
PRINT *,'---------------------------------------------------'
print *, ' Estimates of the parameters for the distributions'
DO 33 K=1,NG
PRINT *,' ---------------------------------------------------'
PRINT *, ' GROUP',K
PRINT *, ' -----------------'
DO 33 L=1,NPAR
print 36,L
36 FORMAT(' Partition ',I2)
IF (IPARTYPE(L).EQ.1) THEN
PRINT *, 'Input the level probabilities separated '
: ,'by a space'
DO 34 J=ISV(L),IEV(L)
PRINT 35,J,NCAT(J)
35 FORMAT(' For attribute ',I2,' the probabilities'
: ,' for',I2,' levels:')
READ *, (THETA(K,J,M),M=1,NCAT(J))
SUMTHETA=0.0
DO 54 M=1,NCAT(J)
SUMTHETA=SUMTHETA+THETA(K,J,M)
54 CONTINUE
IF (ABS(SUMTHETA-1).LT.TOL) THEN
WRITE(7,37)(THETA(K,J,M),M=1,NCAT(J))
37 FORMAT(30F9.6)
ELSE
PRINT *,' ---------------------------------'
PRINT *, ' ***ERROR. CONTINUE INPUT, BUT'
PRINT *, ' CHECK OUTFILE & CORRECT THETA ***'
PRINT 56,J
56 FORMAT(' FOR VARIABLE',I2,' SUM THETA NOT'
: ,' EQUAL TO 1')
PRINT *,' -----------------------------------'
WRITE(7,55)(THETA(K,J,M),M=1,NCAT(J))
55 FORMAT(' ----THETA ERROR',4F7.4)
END IF
34 CONTINUE
ELSE IF(IPARTYPE(L).EQ.2) THEN
PRINT *, 'Input the means for each partition separated'
: ,' by a space'
PRINT 51,IPC(L)
51 FORMAT (' the mean for ',I2,' attributes:')
READ *, (EMU(K,L,J),J=1,IPC(L))
WRITE(7,38)(EMU(K,L,J),J=1,IPC(L))
38 FORMAT(30F11.5)
ELSE IF(IPARTYPE(L).EQ.3) THEN
PRINT *, 'Input values separated by a space'
DO 39 J=ISV(L),IEV(L)
IF(IVARTYPE(J).EQ.3) THEN
PRINT *,' LOCATION MODEL PARAMETERS:'
PRINT 40,J,NCAT(J)
40 FORMAT(' For attribute ',I2,' the probabilities'
: ,' for ',I2,' levels :')
READ *, (THETA(K,J,M),M=1,NCAT(J))
IM(L)=NCAT(J)
SUMTHETA2=0.0
DO 64 M=1,NCAT(J)
SUMTHETA2=SUMTHETA2+THETA(K,J,M)
64 CONTINUE
IF (ABS(SUMTHETA2-1).LT.TOL) THEN
WRITE(7,65)(THETA(K,J,M),M=1,NCAT(J))
65 FORMAT(30F9.6)
ELSE
PRINT *,' ---------------------------------'
PRINT *, ' ***ERROR, CONTINUE INPUT, BUT'
PRINT *, ' CHECK OUTFILE & CORRECT THETA***'
PRINT 56,J
PRINT *,' ---------------------------------'
WRITE(7,55)(THETA(K,J,M),M=1,NCAT(J))
END IF
END IF
39 CONTINUE
J1=0
DO 41 J=ISV(L),IEV(L)
IF(IVARTYPE(J).EQ.4) THEN
J1=J1+1
PRINT 42,J,IM(L)
42 FORMAT(' For attribute ',I2,' the mean for ',I2,
: ' levels:')
READ *, (EMUL(K,L,J1,M),M=1,IM(L))
END IF
41 CONTINUE
J2=0
DO 43 J=ISV(L),IEV(L)
IF (IVARTYPE(J).EQ.4) THEN
J2=J2+1
WRITE(7,38) (EMUL(K,L,J2,M),M=1,IM(L))
END IF
43 CONTINUE
END IF
33 CONTINUE
PRINT *,' ------------------------------'
PRINT *,' Input the covariance matrices by row'
DO 44 K=1,NG
DO 44 L=1,NPAR
IF(IPARTYPE(L).NE.1) THEN
PRINT 45,K,L
45 FORMAT(' GROUP',I2,' PARTITION ',I2)
PRINT 52,IPC(L),IPC(L)
52 FORMAT(' Input (',I2,' x',I2,' ) covariance matrix:')
READ *, ((VARIX(K,L,I,J),J=1,IPC(L)),I=1,IPC(L))
DO 50 I=1,IPC(L)
WRITE(7,49)(VARIX(K,L,I,J),J=1,IPC(L))
49 FORMAT(30F12.4)
50 CONTINUE
END IF
44 CONTINUE
ELSE IF (ISPEC.EQ.2) THEN
PRINT *, ' Filename in which grouping is stored:'
READ (*,46) paramfile
46 FORMAT(A18)
OPEN (8, FILE=paramfile, STATUS='OLD')
DO 47 I=1,NOBS
READ(8,*) IGRP(I)
47 CONTINUE
WRITE(7,48)(IGRP(I),I=1,NOBS)
48 FORMAT(I3)
END IF
END
* This subroutine checks for errors in the input parameter file.
* It checks that the numbers of attributes specified by NVAR, IPC(L),
* and IP(L) match, the types of attributes match with the type of
* partition
SUBROUTINE ERROR(NVAR,NPAR,ISPEC,IP,IPC,IPAR,IVAR,ISV,IEV,NCAT,
: IER)
PARAMETER(ip15=100)
DIMENSION IP(ip15),IPC(ip15),NUM(ip15),ISV(ip15),IEV(ip15),
: IPAR(ip15),IVAR(ip15),NCAT(ip15)
IER=0
IF(NVAR.LT.NPAR) THEN
IER=1
WRITE(7,700)
700 FORMAT(' Number of attributes cannot be less than number of'
: ,' partitions')
END IF
IF ((ISPEC.NE.1).AND.(ISPEC.NE.2)) THEN
IER=1
WRITE(7,702)
702 FORMAT(' Value of ISPEC not permitted. {ISPEC=1 or 2}')
END IF
ISUMVAR=0
DO 701 L=1,NPAR
ISUMVAR=ISUMVAR+IP(L)
701 CONTINUE
IF(ISUMVAR.NE.NVAR) THEN
IER=1
WRITE(7,703)
703 FORMAT(' Sum of attributes in partitions not equal to the'
: ,' total number of attributes')
END IF
DO 704 L=1,NPAR
IF(IPC(L).GT.IP(L)) THEN
IER=1
WRITE(7,705)
705 FORMAT(' Number of continuous attributes greater than the'
: ,' number of attributes in a partition')
END IF
NUM(L) = IEV(L) - ISV(L) + 1
IF (NUM(L).NE.IP(L)) THEN
IER=1
WRITE(7,706)
706 FORMAT(' Number of attributes does not match with ISV & IEV')
END IF
IF((IPAR(L).GT.3).OR.(IPAR(L).LT.1)) THEN
IER=1
WRITE(7,707)
707 FORMAT(' Value of IPARTYPE not permitted')
END IF
IF(IPAR(L).EQ.1) THEN
DO 708 J=ISV(L),IEV(L)
IF(IVAR(J).NE.1) THEN
IER=1
WRITE(7,709)
709 FORMAT(' Partition and attribute type do not match')
END IF
708 CONTINUE
ELSE IF (IPAR(L).EQ.2) THEN
DO 710 J=ISV(L),IEV(L)
IF(IVAR(J).NE.2) THEN
PRINT *, ' HERE 2'
PRINT *, 'IPAR',IPAR(L),'VAR',J,'IVAR',IVAR(J)
IER=1
WRITE(7,709)
END IF
710 CONTINUE
ELSE IF (IPAR(L).EQ.3) THEN
ICOUNT=0
DO 711 J=ISV(L),IEV(L)
IF ((IVAR(J).NE.3).AND.(IVAR(J).NE.4)) THEN
IER=1
WRITE(7,709)
END IF
IF(IVAR(J).EQ.3) ICOUNT=ICOUNT+1
711 CONTINUE
IF (ICOUNT.GT.1) THEN
IER=1
WRITE(7,712)
712 FORMAT(' Location model restriced to 1 categorical'
: ,' attribute')
END IF
END IF
704 CONTINUE
DO 713 J=1,NVAR
IF ((IVAR(J).EQ.2).OR.(IVAR(J).EQ.4)) THEN
IF (NCAT(J).NE.0)THEN
WRITE(7,714)
714 FORMAT(' Input continuous attributes with 0',
: ' categories')
END IF
END IF
713 CONTINUE
RETURN
END
|
