World of Ham Radio 1997/WOHR97_AmSoft_(1997-02-01).iso/antenna/ant_21/prog/geomreg.bas

BASIC Source File | 1997-02-01 | 6KB | 177 lines

    REM   GEOMREG.BAS

        cls: PRINT : PRINT " This program fits a geometric curve to a set of coordinates using"
    PRINT " the method of least squares.  The equation, coefficient of determination,"
    PRINT " coefficient of correlation and standard error of estimate are printed."
    PRINT
    PRINT " From SOME COMMON BASIC PROGRAMS, 3rd edition, by Lon Poole and Mary"
    PRINT " Borchers, Osborne/McGraw-Hill, Berkeley CA, 1979.  Authors state that"
    PRINT " the programs were tested on the Wang 2200 and Commodore PET (ancient"
    PRINT " history!).  Adapted where necessary to Microsoft QuickBasic 4.5, and"
    PRINT " modified for more aesthetic and useful output (esp. as an aid in curve-"
    PRINT " fitting for programmers), and compiled, by Orrin C. Winton WN1Z,"
    PRINT " 11/94 and 11/95.  The plot routine came from PROGRAMMING WITH BASIC 3rd ed.,"
    PRINT " by Byron S. Gottfried, McGraw-Hill, NY, 1986, extensively modified by"
    PRINT " O.C. Winton.  The menu program is from ADVANCED QuickBASIC by Ken Knecht,"
    PRINT " Scott, Foresman and Company, Glenview, Illinois, 1989, and is modified"
    PRINT " only slightly."
    PRINT
    PRINT " You must provide the x and y coordinates of known data points.  Once"
    PRINT " the curve has been fitted you may predict values of y for given values"
    PRINT " of x."
    PRINT
    PRINT " geometric regression"
    PRINT
    PRINT " number of known points:  ";
    INPUT n
    DIM x(30)
    DIM y(30)
    DIM o(30)
    DIM p(30)
    j = 0
    k = 0
    l = 0
    m = 0
    r2 = 0
    REM   enter coordinates of data points
    FOR i = 1 TO n
          PRINT " x,y of point "; i;
          INPUT x(i), y(i)
          REM   accumulate intermediate values
          IF x(i) = 0 GOTO skipx
rety:     IF y(i) = 0 GOTO skipy
          y1 = LOG(y(i))
          IF x(i) = 0 GOTO logskipx
          x1 = LOG(x(i)): GOTO logskipx

skipx:    x1 = 0
          GOTO rety

skipy:    y1 = 0
          GOTO logskipx

logskipx: j = j + x1
          k = k + y1
          l = l + x1 ^ 2
          m = m + y1 ^ 2
          r2 = r2 + x1 * y1
    NEXT i

    REM   calculate and print coefficients of equation
    b = (n * r2 - k * j) / (n * l - j ^ 2)
    a = (k - b * j) / n
    PRINT
    PRINT " f(x) = "; EXP(a); "* (x ^"; b; ")"
    PRINT

    REM   calculate regression analysis
    j = b * (r2 - j * k / n)
    m = m - k ^ 2 / n
    k = m - j
    PRINT
    r2 = j / m
    PRINT " coefficient of determination (r^2)  =  "; r2
    PRINT " coefficient of correlation          =  "; SQR(r2)
    IF (n - 2) <= 0 OR k < 0 THEN GOTO g
    PRINT " standard error of estimate          =  "; SQR(k / (n - 2)): GOTO h
g:  PRINT " standard error of estimate          =  "
h:  PRINT

    REM   estimate y-coordinate from entered x-coordinate
    INPUT " do you wish to do interpolation?  enter 'y' for yes"; y$
    IF y$ = "y" THEN
        PRINT " enter -999 to quit interpolation"
        GOTO a
    ELSE GOTO b
    END IF

a:      PRINT " x = ";
    INPUT x
    IF x = -999 THEN GOTO b
    PRINT " y = "; EXP(a) * x ^ b
    PRINT
    GOTO a
b:  REM


2115 ' ******* Prepare to plot regression equation y-values against
2116 '         user-input x values.  Not user-input y-values.
2117 '
2120 FOR i = 1 TO n
2122     o(i) = x(i)
2124 NEXT i

2126 FOR i = 1 TO n
2128     p(i) = EXP(a) * (o(i) ^ b)
2130 NEXT i

2270 ' ******* Find Largest and Smallest X and Y (the user-input x,y values)
2280 '
2290 XMAX = -100000!: YMAX = -100000!: XMIN = 100000!: YMIN = 100000!
2300 FOR i = 1 TO n
2310    IF x(i) > XMAX THEN XMAX = x(i)
2320    IF y(i) > YMAX THEN YMAX = y(i)
2330    IF x(i) < XMIN THEN XMIN = x(i)
2340    IF y(i) < YMIN THEN YMIN = y(i)
2350 NEXT i
2360
2370 ' ******* Scale the Xs and Ys
2380 '
2390 FOR i = 1 TO n
2400     x(i) = 29 + INT(280 * (x(i) - XMIN) / (XMAX - XMIN))
2410     y(i) = 189 - INT(150 * (y(i) - YMIN) / (YMAX - YMIN))
2420 NEXT i

2470 ' ******* Plot the Graphical Display of user-input x,y values
2480 '
2490 SCREEN 9
2500 LINE (19, 29)-(19, 199): LINE -(319, 199)
2510 FOR IY = 59 TO 179 STEP 20: LINE (19, IY)-(23, IY): NEXT IY
2520 FOR IX = 39 TO 299 STEP 20: LINE (IX, 199)-(IX, 195): NEXT IX
2530 '
2540 FOR i = 1 TO n
2550     PSET (x(i), y(i)): LINE (x(i), y(i) - 2)-(x(i) - 4, y(i) + 2)
2560     LINE -(x(i) + 4, y(i) + 2): LINE -(x(i), y(i) - 2)
2570 NEXT i
2580 '
2590 FOR i = 1 TO n - 1
2600     LINE (x(i), y(i))-(x(i + 1), y(i + 1))
2610 NEXT i

2770 ' ******* Find Largest and Smallest o and p
2780 '
2790 OMAX = -100000!: PMAX = -100000!: OMIN = 100000!: PMIN = 100000!
2800 FOR i = 1 TO n
2810    IF o(i) > OMAX THEN OMAX = o(i)
2820    IF p(i) > PMAX THEN PMAX = p(i)
2830    IF o(i) < OMIN THEN OMIN = o(i)
2840    IF p(i) < PMIN THEN PMIN = p(i)
2850 NEXT i
2860
2870 ' ******* Scale the Os and Ps
2880 '
2890 FOR i = 1 TO n
2900     o(i) = 29 + INT(280 * (o(i) - OMIN) / (OMAX - OMIN))
2910     p(i) = 189 - INT(150 * (p(i) - PMIN) / (PMAX - PMIN))
2920 NEXT i

3000 ' ******* Plot the Regression Equation y-values against
3002 '         user-input x values.  Not user-input y-values.
3010 '
3015 COLOR 4
3020 FOR i = 1 TO n - 1
3030     LINE (o(i), p(i))-(o(i + 1), p(i + 1))
3040 NEXT i
3045 COLOR 7
3050 PRINT " f(x) = "; EXP(a); "* (x ^"; b; ")"
3060 PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : PRINT
3064 PRINT " White curve w/markers:  your x,y inputs."
3065 COLOR 4
3066 PRINT " Red curve is eqn's y based on your x-inputs."
3068 PRINT " Eqn's fit is close to perfect if red line overwrites white line."
3069 COLOR 2
3070 INPUT " hit any key to end GEOMETRIC REGRESSION sub-program", dummy
3080 RUN "menu"
3099 END