home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l292 / 1.ddi / CURVEDEM.FOR < prev    next >
Encoding:
Text File  |  1990-02-20  |  5.2 KB  |  135 lines
  1.       INCLUDE 'misciofi.for'
  2.       INCLUDE 'stdhdr.for'
  3.       REAL xdata(0 : maxv), ydata(0 : maxv),indvar(0 : maxr)
  4.       REAL depvar(0 : maxr), coef(0 : maxc), coefsig(0 : maxc)
  5.       INTEGER numobs, i,  order
  6.       INTEGER quit,errr, count, maxX, maxY, L
  7.       REAL xval, randomnum
  8.       REAL yest(0 : maxr), resid(0 : maxr)
  9.       REAL rsq, r, see
  10.       CHARACTER * 80   xstr, coefstr, coefsigstr, tempstr
  11.       CHARACTER ch, scancode
  12.  
  13.       numobs = 24
  14.       !set up dependent / independent variables}
  15.       DO i = 0, numobs - 1
  16.         CALL Random(RandomNum)
  17.         xval = REAL(i)/10.0 -2
  18.         indvar(i) = xval
  19.         depvar(i) = 10 +xval*200.0 + (xval**2) * 30.0 + (xval**3) * 40.0
  20.       END DO
  21.  
  22.       CALL InitSEGraphics( -1, 'C:\FOR\LIB\*.FON')
  23.       CALL SelectColor(15)
  24.       CALL GetMaxCoords(maxX, maxY)
  25.       CALL DefGraphWindow(maxX / 3, 1, maxX, maxY / 2, 3)
  26.       CALL DefGraphWindow(maxX / 3, maxY / 2, maxX, maxY, 4)
  27.       CALL DefGraphWindow(0, 0, NINT(maxX / 3.25), maxY, 5)
  28.       CALL SetWin2PlotRatio(3, .21, .14, .05, .2)
  29.       CALL SetWin2PlotRatio(4, .25, .14, .05, .23)
  30.       quit = 1
  31.       DO WHILE ( quit .GT. 0)
  32.         CALL SetCurrentWindow(5)
  33.         CALL ClearWindow
  34.         CALL BorderCurrentWindow(1)
  35.         CALL SelectColor(15)
  36.         CALL LabelGraphWindow(30.0,900.0,'Input Order of Curve',0,0)
  37.         CALL LabelGraphWindow(30.0,830.0,'  must be 4 or less: ',0,0)
  38.         CALL ReadKey(ch,scancode)
  39.         order = ICHAR(ch)-48
  40.         CALL LabelGraphWindow(30.0, 760.0, 'Curvefit Equation = ', 0, 0)
  41.         CALL LabelGraphWindow(30.0, 690.0, 'Coefficient   Error ', 0, 0)
  42.         DO i = 0, numobs - 1
  43.           xdata(i) = indvar(i)
  44.           ydata(i) = depvar(i)
  45.         END DO
  46.         IF (order .LE. 4 .AND. order .GT. 0) THEN
  47.           CALL PolyCurveFit(indvar, depvar, numobs, order,
  48.      +        coef, yest, resid, see, coefsig, rsq, r, errr)
  49.           CALL LabelGraphWindow(30.0, 620.0, 'Y =    ', 0, 0)
  50.           count = 550
  51.           CALL SelectColor(15)
  52.           DO i = 0, order
  53.             xstr = '                                         '
  54.             CALL RealToString(REAL(i), 0, 1, xstr)
  55.             tempstr = 'X^                                    '
  56.             l = len_trim(tempstr) + 1
  57.             tempstr(l:l) = xstr(1:1)
  58.             coefstr = '                                      '
  59.             coefsi gstr = '                                   '
  60.             CALL LabelGraphWindow(30.0, REAL(count), tempstr, 0, 0)
  61.             CALL RealToString(coef(i), 1, 6, coefstr)
  62.             CALL LabelGraphWindow(550.0, REAL(count), coefstr, 2, 0)
  63.             CALL RealToString(coefsig(i), 1, 6, coefsigstr)
  64.             CALL LabelGraphWindow(825.0, REAL(count), coefsigstr, 2, 0)
  65.             count = count - 70
  66.           END DO
  67.           CALL SetTextJustifyXX(0, 0)
  68.           xstr = '                                 '
  69.           CALL RealToString(r, 3, 6, xstr)
  70.           tempstr = 'R Value ='
  71.           CALL LabelGraphWindow(30.0,REAL(count), tempstr, 0, 0)
  72.           CALL LabelGraphWindow(500.0,REAL(count), xstr, 0, 0)
  73.           count = count - 50
  74.  
  75.           xstr = 'R Squared Value = '
  76.           CALL LabelGraphWindow(30.0, REAL(count), xstr, 0, 0)
  77.           count = count - 50
  78.           CALL RealToString(rsq, 3, 5, xstr)
  79.           CALL LabelGraphWindow(500.0, REAL(count), xstr, 0, 0)
  80.           count = count - 50
  81.  
  82.           CALL RealToString(see, 3, 5, xstr)
  83.           tempstr = 'SEE = '
  84.           CALL LabelGraphWindow(30.0, REAL(count), tempstr, 0, 0)
  85.           CALL LabelGraphWindow(500.0, REAL(count), xstr, 0, 0)
  86.           count = count - 50
  87.           CALL SetLineStyleXX(0,  1)
  88.          CALL SetCurrentWindow(3)
  89.          CALL SetAxesType(0, 0)
  90.          CALL ClearWindow
  91.          CALL BorderCurrentWindow(15)
  92.          CALL AutoAxes(xdata, ydata, numobs, 1)
  93.          CALL LinePlotData(xdata, ydata, numobs, 1, 0)
  94.          CALL SelectColor(15)
  95.          CALL TitleWindow(
  96.      +     'ORIGINAL DATA - SOLID,  FITTED DATA - DOTTED')
  97.          CALL TitleXAxis('INDEPENDENT VARIABLE')
  98.          CALL TitleYAxis('DEP. VAR.')
  99.          DO i = 0, numobs - 1
  100.            ydata(i) = yest(i)
  101.          END DO
  102.          CALL LinePlotData(xdata, ydata, numobs, 15, 3)
  103.          CALL SetLineStyleXX(1,  1)
  104.          CALL DrawGrid(10)
  105.          CALL SetLineStyleXX(0,  1)
  106.          CALL SetCurrentWindow(4)
  107.          CALL SetAxesType(0, 0)
  108.          CALL ClearWindow
  109.          CALL BorderCurrentWindow(15)
  110.  
  111.          DO i = 0, numobs - 1
  112.           ydata(i) = resid(i)
  113.          END DO
  114.         CALL AutoAxes(xdata, ydata, numobs, 1)
  115.         CALL BarGraphData(xdata, ydata, numobs, .05, 1, 2)
  116.         CALL SelectColor(15)
  117.         CALL TitleWindow('CURVE FIT ERROR ANALYSIS')
  118.         CALL TitleXAxis('INDEPENDENT VARIABLE')
  119.         CALL TitleYAxis('RESIDUALS')
  120.         CALL SetLineStyleXX(1, 1)
  121.         CALL DrawGridY(10)
  122.  
  123.         CALL SetCurrentWindow(5)
  124.         CALL LabelGraphWindow(30.0, REAL(count),
  125.      +         'MORE <1-Y or 0-N> ?', 0, 0)
  126.         CALL ReadKey(ch,scancode)
  127.         quit = ICHAR(ch)-48
  128.         CALL RealToString(REAL(order), 0,1, Tempstr)
  129.         CALL LabelGraphWindow(650.0, REAL(count), tempstr, 0, 0)
  130.        END IF
  131.       END DO
  132.       CALL CloseSEGraphics
  133.       END
  134.  
  135.