iod of multpel linear regression with class variable

iod of multpel linear regression with class variable

 

자료

 

31111150
31111256
11111342
31112155
21112251
21112357
31113160
31113266
11113352
11121134
11121240
21121356
11122139
11122245
31122371
21123154
21123260
31123376
21131148
11131244
11131350
31132163
21132259
31132375
11133148
21133264
11133360
31211153
21211249
31211365
11212138
31212264
11212350
11213143
31213269
21213365
21221147
11221243
11221349
21222152
11222248
31222374
21223157
11223253
21223369
31231161
31231267
11231353
31232166
21232262
21232368
21233161
31233277
11233363
11311136
31311262
31311368
21312151
21312257
21312363
21313156
11313252
21313368
21321150
21321256
21321362
11322145
11322251
31322377
21323160
11323256
21323372
21331154
11331250
21331366
31332169
11332255
31332381
11333154
31333280
11333366
12111132
32111258
12111344
12112137
32112263
22112359
12113142
22113258
32113374
12121136
32121262
32121368
32122161
22122257
12122353
22123156
12123252
22123368
12131140
32131266
22131362
12132145
32132271
22132367
22133160
12133256
22133372
22211145
12211241
32211367
22212150
12212246
22212362
32213165
32213271
32213377
32221159
32221265
12221351
22222154
12222250
22222366
22223159
32223275
32223381
12231143
12231249
32231375
32232168
22232264
22232370
32233173
32233279
22233375
22311148
32311264
32311370
12312143
22312259
32312375
12313148
22313264
22313370
32321162
32321268
22321364
12322147
12322253
32322379
32323172
22323268
12323364
12331146
32331272
12331358
12332151
22332267
12332363
32333176
22333272
32333388
13111134
33111260
33111366
23112149
33112265
13112351
13113144
23113260
23113366
23121148
23121254
23121360
13122143
23122259
23122365
33123168
33123274
33123380
23131152
13131248
33131374
13132147
13132253
33132379
13133152
33133278
23133374
13211137
13211243
33211369
33212162
13212248
13212354
13213147
33213273
23213369
23221151
33221267
23221363
23222156
23222262
23222368
23223161
23223267
33223383
13231145
13231251
13231357
33232170
33232276
23232372
13233155
23233271
33233387
33311160
33311266
23311362
23312155
33312271
23312367
23313160
13313256
13313362
33321164
23321260
13321356
33322169
23322265
23322371
23323164
33323280
23323376
33331168
33331274
33331380
23332163
13332259
13332365
33333178
13333264
33333390

1st col : class variable

2nd ~ 6th col : independent variables

7th col : dependent variable

 

위 자료를 iod_multiple_linear_regression_cv.dat 로 저장

 

LHS와 RHS를 만드는 프로그램

 

PROGRAM iod_mlrc_setup

! program name
! : iteration on data of multiple linear regreesion with class variable
! prgrammer
! : Park Byoungho
! date
! : 2009.11.3.

IMPLICIT NONE

! data dictionary

INTEGER, PARAMETER :: no_of_cv = 1 ! number of class variables
INTEGER, PARAMETER :: levels_of_cv = 3 ! levels of each calss variables
INTEGER, PARAMETER :: no_of_rc = 5 ! number of regression coefficient
CHARACTER(LEN=256), PARAMETER :: data_filename = 'iod_multiple_linear_regression_cv.dat' ! data file name

REAL(KIND = 8), ALLOCATABLE :: ind(:) ! storage for independent variable when reading data
REAL(KIND = 8) :: dep ! storage for dependent variable when reading data

REAL(KIND = 8), ALLOCATABLE :: rhs(:) ! right-hand side
INTEGER, ALLOCATABLE :: eq_no(:) ! storage for equation number

REAL(KIND = 8) :: temp_ind ! temporary independent variable
INTEGER :: temp_eq_no

INTEGER :: i,j ! for loop
INTEGER :: status ! I/O status
CHARACTER(LEN = 40) :: error_msg ! error message

ALLOCATE(ind(no_of_cv + no_of_rc)) ! independent variable
ALLOCATE(rhs(levels_of_cv + no_of_rc)) ! right-hand side
ALLOCATE(eq_no(no_of_cv + no_of_rc)) ! storage for equation number

! initialize
rhs = 0

! open data file
OPEN(UNIT = 10, FILE = data_filename, STATUS = 'OLD', ACTION = 'READ', IOSTAT = status, IOMSG = error_msg)

IF (status /= 0) THEN ! file open failed
WRITE (*,'(1X, A, A)') 'Data file open failed -- error message : ', error_msg
STOP
END IF

! open data file for writing left-hand side
OPEN(UNIT = 20, FILE = 'lhs.dat', STATUS = 'REPLACE', ACTION = 'WRITE')

! read each line
DO
READ(UNIT = 10, FMT = *, IOSTAT = status) ind, dep
IF (status /= 0) EXIT ! end of file

DO i = 2, no_of_cv + no_of_rc
eq_no(i) = levels_of_cv + i - 1
END DO

eq_no(1) = ind(1)
ind(1) = 1

DO i = 1, no_of_cv + no_of_rc
! swap equation number
temp_eq_no = eq_no(i)
eq_no(i) = eq_no(1)
eq_no(1) = temp_eq_no

! swap independent variable
temp_ind = ind(i)
ind(i) = ind(1)
ind(1) = temp_ind

WRITE(20,*) (eq_no(j),ind(1)*ind(j), j=1, no_of_cv + no_of_rc)

rhs(eq_no(1)) = rhs(eq_no(1)) + ind(1) * dep
END DO

END DO

CLOSE(11) ! close data file

! open file for right hand side
OPEN(UNIT = 30, FILE = 'rhs.dat', STATUS = 'REPLACE', ACTION = 'WRITE')

! write right-hand side
DO i = 1, levels_of_cv + no_of_rc
WRITE(30, *) rhs(i)
END DO

CLOSE(30) ! close

END PROGRAM iod_mlrc_setup

 

위 소스를 iod_multiple_linear_regression_cv_setup.f95 로 저장

 

LHS의 정렬

 

sort -n -o sorted_lhs.dat lhs.dat

 

해를 구하는 프로그램

 

PROGRAM iod_mlrc_solve

! program name
! : iteration on data of multiple linear regreesion with class variable
! : solve program
! prgrammer
! : Park Byoungho
! date
! : 2009.11.3.

IMPLICIT NONE

! data dictionary

INTEGER, PARAMETER :: no_of_cv = 1 ! number of class variables
INTEGER, PARAMETER :: levels_of_cv = 3 ! levels of each calss variables
INTEGER, PARAMETER :: no_of_rc = 5 ! number of regression coefficient

INTEGER :: no_of_lhs ! number of left hand side lines
REAL(KIND = 8), ALLOCATABLE :: lhs(:,:), rhs(:) ! left-hand side, right-hand side, x'y
REAL(KIND = 8), ALLOCATABLE :: solutions(:) ! solutions

INTEGER :: pre_eq_no ! previous equation number
INTEGER :: cur_eq_no ! current equation number

REAL(KIND = 8) :: diag_ele ! diagonal element
REAL(KIND = 8) :: temp_rhs ! temporary rihgt hand side
REAL(KIND = 8) :: pre_sol ! previous solution

INTEGER :: iteration ! iteration
REAL(KIND = 8) :: epsilon ! sum of squares of difference between old and new solutions
INTEGER :: i,j ! loop
INTEGER :: status ! i/o status
CHARACTER(LEN = 40) :: error_msg ! error message
INTEGER, PARAMETER :: MAX_ITER = 500 ! maximum number of iteration
REAL(KIND = 8), PARAMETER :: criteria = 1.E-12 ! criteria for stopping

ALLOCATE(rhs(levels_of_cv + no_of_rc))
ALLOCATE(solutions(levels_of_cv + no_of_rc))

solutions = 0

!open left-hand side file
OPEN(UNIT = 10, FILE = 'sorted_lhs.dat', STATUS = 'OLD', ACTION = 'READ', IOSTAT = status, IOMSG = error_msg)
IF (status /= 0) THEN ! file open failed
WRITE (*,'(1X, A, A)') 'Sorted lhs file open failed -- error message : ', error_msg
STOP
END IF

! count the lines of lhs
no_of_lhs = 0
DO
READ(UNIT = 10, FMT = *, IOSTAT = status)
IF (status /= 0) EXIT ! reach end of file
no_of_lhs = no_of_lhs + 1
END DO

ALLOCATE(lhs(no_of_lhs, (no_of_cv + no_of_rc) * 2))

! write(*,*) 'number of lines of left hand side = ', no_of_lhs

! store lhs to array
REWIND(10)
DO i = 1, no_of_lhs
READ(UNIT = 10, FMT = *, IOSTAT = status) lhs(i,:)
IF (status /= 0) EXIT ! reach end of file
END DO
CLOSE(11)

! DO i = 1, no_of_lhs
! write(*,*) lhs(i,:)
! END DO

!open right-hand side file
OPEN(UNIT = 20, FILE = 'rhs.dat', STATUS = 'OLD', ACTION = 'READ', IOSTAT = status, IOMSG = error_msg)

IF (status /= 0) THEN ! file open failed
WRITE (*,'(1X, A, A)') 'RHS file open failed -- error message : ', error_msg
STOP
END IF

! read and store right-hand side
DO i = 1, (levels_of_cv + no_of_rc)
READ(UNIT = 20,FMT = *) rhs(i)
END DO
close(20)

! write(*,*) 'right hand side ...'
! DO i = 1, levels_of_cv + no_of_rc
! write(*,*) i, rhs(i)
! END DO

DO iteration = 1, MAX_ITER

pre_eq_no = 1
diag_ele = 0.0
temp_rhs = rhs(1)
epsilon = 0.0

! start reading and processing each line of lhs
DO i = 1, no_of_lhs

cur_eq_no = lhs(i,1)

IF(pre_eq_no /= cur_eq_no) THEN
pre_sol = solutions(pre_eq_no) ! store old solution
solutions(pre_eq_no) = temp_rhs / diag_ele ! get a new solution
epsilon = epsilon + (pre_sol - solutions(pre_eq_no)) ** 2 ! calculate sum of squares of difference between old solution and new solution

diag_ele = 0.0
temp_rhs = rhs(INT(lhs(i,1)))
END IF

! add diagonal element
diag_ele = diag_ele + lhs(i, 2)

! adjust right-hand sie
! temp_rhs - independend variable * solutions
DO j = 2, (no_of_cv + no_of_rc)
temp_rhs = temp_rhs - lhs(i, 2*j) * solutions(INT(lhs(i,2*j-1)))
END DO

pre_eq_no = lhs(i,1)

END DO
! end reading lhs

! calculate last solution
pre_sol = solutions(pre_eq_no) ! store old solution
solutions(pre_eq_no) = temp_rhs / diag_ele ! get a new solution
epsilon = epsilon + (pre_sol - solutions(pre_eq_no)) ** 2 ! calculate sum of squares of difference between old solution and new solution

! WRITE(*,*) iteration,'th iteration''s solutions'
! DO i = 1, no_of_rc
! WRITE(*,*) i, solutions(i)
! END DO

epsilon = epsilon / (levels_of_cv + no_of_rc)

! write iteration number and epsilon
write(*,*) 'iteration = ', iteration , ', epsilon = ', epsilon
IF (epsilon < criteria) THEN
EXIT
END IF

END DO
! end iteration

! open file for writing solution
OPEN(UNIT=30, FILE='sol.dat', STATUS='REPLACE', ACTION='WRITE', IOSTAT=status)
DO i = 1, (levels_of_cv + no_of_rc)
WRITE(30,*) i, solutions(i)
END DO
CLOSE(30)

END PROGRAM iod_mlrc_solve

 

위 소스를 iod_multiple_linear_regression_cv_solve.f95 로 저장

 

프로그램 컴파일 및 실행

 

관련 파일

 

 

1257243619_iod_multiple_linear_regression_cv.zip

다운로드

1257243619_iod_multiple_linear_regression_cv.zip