home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l292 / 1.ddi / SUMSTATS.FOR < prev    next >
Encoding:
Text File  |  1990-01-21  |  3.4 KB  |  133 lines
  1.       SUBROUTINE CalculateMode (dataset, numrow, mode)
  2.       INCLUDE 'STDHDR.FOR'
  3.       REAL dataset(0:maxc)
  4.       INTEGER numrow
  5.       REAL mode
  6.  
  7.       INTEGER Num
  8.       LOGICAL even
  9.  
  10.       even = .TRUE.
  11.       IF (MOD(numrow,2) .NE. 0) even = .FALSE.
  12.       CALL SortDataSet(dataset, numrow)
  13.       IF (even) THEN
  14.          Num = numrow / 2 - 1
  15.          mode = (dataset(Num) + dataset(Num + 1)) / 2.0
  16.       ELSE
  17.           Num = numrow / 2
  18.           mode = dataset(Num)
  19.       END IF
  20.  
  21.       END  !Subroutine  CalculateMode
  22.  
  23.  
  24.  
  25.       SUBROUTINE StatsMinMax (dataset, numdat, minval, maxval, range)
  26.       INCLUDE 'STDHDR.FOR'
  27.       REAL dataset(0:maxc )
  28.       INTEGER numdat,i
  29.       REAL minval,maxval,range
  30.  
  31.       minval = dataset(0)
  32.       maxval = dataset(0)
  33.       DO i = 1 , numdat - 1
  34.          IF (dataset(i) .LT. minval)  minval = dataset(i)
  35.          IF (dataset(i) .GT. maxval)  maxval = dataset(i)
  36.       END DO
  37.       range = maxval - minval
  38.  
  39.       END  !Subroutine  StatsMinMax
  40.  
  41.  
  42.  
  43.       SUBROUTINE MatMean (datary, numrow, sumx, mean)
  44.       INCLUDE 'STDHDR.FOR'
  45.       REAL datary(0:maxc)
  46.       INTEGER numrow,i
  47.       REAL sumx, mean
  48.  
  49.       sumx = 0
  50.       DO i = 0 , numrow - 1
  51.          sumx = sumx + datary(i)
  52.       END DO
  53.       mean = sumx / numrow
  54.  
  55.       END  !Subroutine  matmean
  56.  
  57.  
  58.  
  59.       SUBROUTINE MatStd (datary, mean, numrow, variance, stddev)
  60.       INCLUDE 'STDHDR.FOR'
  61.       REAL datary(0:maxc)
  62.       INTEGER numrow
  63.       REAL variance, stddev,mean
  64.  
  65.       REAL xsqr
  66.       INTEGER i
  67.  
  68.       xsqr = 0
  69.       DO i = 0 , numrow - 1
  70.          xsqr = xsqr + datary(i) ** 2
  71.       END DO
  72.       variance = (xsqr - numrow * mean ** 2) / (numrow - 1)
  73.       stddev = SQRT(ABS(variance))
  74.  
  75.       END  !Subroutine  MatStd
  76.  
  77.  
  78.  
  79.       SUBROUTINE SortDataSet (dataset, numrow)
  80.       INCLUDE 'STDHDR.FOR'
  81.       REAL dataset(0:maxc)
  82.       INTEGER numrow
  83.  
  84.       INTEGER k, j
  85.       REAL TempX
  86.       LOGICAL abort
  87.  
  88.       IF (numrow .GT. 1) THEN
  89.          DO j = 0 , numrow - 1
  90.             abort = .FALSE.
  91.             TempX = dataset(j)
  92.             k = j - 1
  93.             DO WHILE ( ( abort .EQV. .FALSE.) .AND. (k .GE. 0))
  94.                IF (TempX .LT. dataset(k)) THEN
  95.                   dataset(k + 1) = dataset(k)
  96.                   k = k - 1
  97.                ELSE
  98.                   abort = .TRUE.
  99.                END IF
  100.                dataset(k + 1) = TempX
  101.             END DO
  102.  
  103.          END DO
  104.       END IF
  105.  
  106.       END  !Subroutine  sortdataset
  107.  
  108.  
  109.  
  110.       SUBROUTINE SummaryStats (dataset, numobs, numcol, minima,
  111.      + maxima, range, sumxx, mean, variance, stddev, semean, mode)
  112.       INCLUDE 'STDHDR.FOR'
  113.       REAL dataset(0:maxr,0:maxc)
  114.       INTEGER numobs, numcol, i, j
  115.       REAL minima(0:maxc), maxima(0:maxc), range(0:maxc)
  116.       REAL sumxx(0:maxc), mean(0:maxc), variance(0:maxc)
  117.       REAL stddev(0:maxc), semean(0:maxc), mode(0:maxc)
  118.       REAL tempv(0:maxc)
  119.  
  120.       DO j = 0 , numcol - 1
  121.          DO i = 0 , numobs - 1
  122.             tempv(i) = dataset(i, j)
  123.          END DO
  124.          CALL CalculateMode(tempv, numobs, mode(j))
  125.          CALL StatsMinMax(tempv, numobs, minima(j),maxima(j),range(j))
  126.          CALL MatMean(tempv, numobs, sumxx(j), mean(j))
  127.          CALL MatStd(tempv, mean(j), numobs, variance(j), stddev(j))
  128.          semean(j) = stddev(j) / SQRT(numobs)
  129.       END DO
  130.  
  131.       END  !Subroutine  summarystats
  132.  
  133.