The Fred Fish Collection 1.5

home *** CD-ROM | disk | FTP | other *** search

/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / prog_oth / basicprs.lzh / BASICPROGS / LEASTSQUARE < prev next >

Wrap

Text File | 1991-08-16 | 12.7 KB | 526 lines

DIM P(20), r(20), v(20), X(20), Y(20), z(20,20) DEFDBL a-z DEFSNG PrintY SCREEN 2,640,200,3,2 WINDOW 2,,,0,2 WIDTH 80 Round$ = "################.####" MenuFlag = 0 'for degree count LOCATE 10,28 PRINT "Want instructions (Y/N)?" Instruct: Want$ = INKEY$ IF Want$ = "" THEN Instruct Want$ = UCASE$(Want$) IF Want$ <> "Y" AND Want$ <> "N" THEN Instruct CLS IF Want$ = "N" THEN GOTO Start IntroFlag = 0 RESTORE PrintIntro: FOR j% = 1 TO 23 READ d$ Over = INT((80 - LEN(d$))/2) PRINT SPACE$(Over) d$ NEXT EndIntro: IF INKEY$ = "" THEN EndIntro IF IntroFlag = 0 THEN CLS IntroFlag = 1 GOTO PrintIntro END IF Start: CLS WIDTH 70 NumPairs = 0 HowManyPlaces: LOCATE 5,11 PRINT "How many decimal places do you want to show - 2 is mimimum" LOCATE 6,11 INPUT "(Enter your choice then press RETURN) "; Places IF Places < 2 THEN PRINT " Everybody wants to be a comedian. Try again." PRINT GOTO HowManyPlaces END IF IF Places > 16 THEN PRINT "16 is as high as the machine goes. Try again." GOTO Start END IF Place$ = "." + LEFT$(Round$,Places) Round$ = Round$ + Place$ Places = Places + 1 InputLoop: PRINT NumPairs = NumPairs+1 COLOR 3,0 PRINT " Pair"; NumPairs; COLOR 4,0 PRINT " (C to start calculating - D to delete last pair)" COLOR 1,0 PRINT " Input the first number of the pair then press RETURN" GOSUB GetIt IF Final$ = "C" AND NumPairs > 2 THEN NumPairs = NumPairs-1: GOTO SetDegree IF Final$ = "D" AND NumPairs > 1 THEN NumPairs = NumPairs-2: GOTO InputLoop X(NumPairs) = Final PRINT PRINT " Input the second Number of the pair then press RETURN" GOSUB GetIt IF Final$ = "C" AND NumPairs > 2 THEN NumPairs = NumPairs-1: GOTO SetDegree IF Final$ = "D" AND NumPairs > 1 THEN NumPairs = NumPairs-2: GOTO InputLoop Y(NumPairs) = Final GOTO InputLoop SetDegree: CLS FOR j% = 1 TO NumPairs 'sort in ascending order FOR k% = j% TO NumPairs IF X(j%) > X(k%) THEN SWAP X(j%), X(k%) SWAP Y(j%), Y(k%) END IF NEXT NEXT Degree = NumPairs - 1 IF Degree > 9 THEN Degree = 9 FOR WhatDeg = 1 TO Degree: GOSUB Calculate: NEXT PrintMenu: MenuFlag = 1 COLOR 5,0 PRINT PRINT PRINT SPACE$(38)"MENU" PRINT PRINT SPACE$(20)"1 - Drop this equation and find another" PRINT SPACE$(20)"2 - Determine Y given X" PRINT SPACE$(20)"3 - List all pairs" PRINT SPACE$(20)"4 - Quit" PRINT SPACE$(20)"5 - Graph" COLOR 1,0 PRINT " GetQ: q$ = INKEY$ q = VAL(q$) IF q<1 OR q>5 THEN GetQ ON q GOTO Start, FindY, ListPairs, EndIt, GraphIt GOTO PrintMenu FindY: WhatDeg = 0: INPUT "What degree equation do you want to use"; WhatDeg GOSUB Calculate NextY: PRINT PRINT "(R to return to menu)" INPUT "x = "; X$ X = VAL(X$) X$ = UCASE$(X$) IF X$ = "R" THEN GOTO PrintMenu YValue = 0 FOR k% = 1 TO WhatDeg + 1 YValue = YValue + v(k%) * X ^ (k%-1) NEXT PRINT "y ="; YValue GOTO NextY ListPairs: PRINT FOR j% = 1 TO NumPairs PRINT "Pair";j%, Length = LEN(STR$(INT(X(j%)))) PrintNum$ = RIGHT$(Round$,Length + Places) IF X(j%) < 0 THEN PRINT "-"; PRINT USING PrintNum$; ABS((X(j%))), PRINT " ", Length = LEN(STR$(INT(Y(j%)))) PrintNum$ = RIGHT$(Round$,Length + Places) IF Y(j%) < 0 THEN PRINT "-"; PRINT USING PrintNum$; ABS((Y(j%))) NEXT PRINT PRINT "<D>elete a pair <A>dd a pair <R>ecalculate <M>enu" UpDate: UD$ = INKEY$ IF UD$ = "" THEN UpDate UD$ = UCASE$(UD$) IF UD$ <> "D" AND UD$ <> "A" AND UD$ <> "R" AND UD$ <> "M" THEN UpDate IF UD$ = "M" THEN GOTO PrintMenu IF UD$ = "R" THEN GOTO SetDegree IF UD$ = "A" THEN AddPair DeltePair: INPUT "Delete which pair"; Which IF Which < 1 OR Which > NumPairs GOTO DeletePair SWAP X(Which), X(NumPairs) SWAP Y(Which), Y(NumPairs) NumPairs = NumPairs - 1 GOTO ListPairs AddPair: NumPairs = NumPairs + 1 INPUT "X ="; X(NumPairs) INPUT "Y ="; Y(NumPairs) GOTO ListPairs PrintPlus: 'print sign before number IF POS(1)>60 THEN PRINT IF Flag = 1 AND v(j%)> = 0 THEN PRINT " +"; IF v(j%) < 0 THEN PRINT " -"; RETURN EndIt: WINDOW CLOSE 2 SCREEN CLOSE 2 LIST END Calculate: d = WhatDeg: n = d + 1: d2 = 2 * d FOR j% = 1 TO d2 P(j%) = 0 FOR k% = 1 TO NumPairs P(j%) = P(j%) + X(k%) ^ j% NEXT NEXT P(0) = NumPairs r(1) = 0 FOR j% = 1 TO NumPairs r(1) = r(1) + Y(j%) NEXT IF n = 1 THEN GOTO Jump1 FOR j% = 2 TO n r(j%) = 0 FOR k% = 1 TO NumPairs r(j%) = r(j%) + Y(k%) * X(k%) ^ (j%-1) NEXT NEXT Jump1: FOR j% = 1 TO n FOR k% = 1 TO n z(j%,k%) = P(j%+k%-2) NEXT NEXT GOSUB Calculate2 PRINT : PRINT "degree = "; d PRINT "y ="; : Flag = 0 FOR j% = n TO 1 STEP-1: IF v(j%)=0 THEN Jump3 IF j% = 1 THEN GOSUB PrintPlus Length = LEN(STR$(INT(v(j%)))) PrintNum$ = RIGHT$(Round$,Length + Places) PRINT USING PrintNum$; ABS((v(j%))) GOTO Jump2 END IF IF j% = 2 THEN GOSUB PrintPlus Length = LEN(STR$(INT(v(j%)))) PrintNum$ = RIGHT$(Round$,Length + Places) PRINT USING PrintNum$; ABS((v(j%))); COLOR 3,0 PRINT "x "; COLOR 1,0 GOTO Jump2 END IF GOSUB PrintPlus Length = LEN(STR$(INT(v(j%)))) PrintNum$ = RIGHT$(Round$,Length + Places) PRINT USING PrintNum$; ABS((v(j%))); COLOR 3,0 PRINT "x^"; RIGHT$(STR$(j%-1),1); COLOR 1,0 Jump2: Flag = 1 Jump3: IF POS(1)>60 THEN PRINT NEXT q = 0 FOR j% = 1 TO NumPairs q = q+Y(j%) NEXT m = q/NumPairs: t = 0: g = 0 FOR j% = 1 TO NumPairs q = 0 FOR k% = 1 TO n q = q + v(k%) * X(j%) ^ (k%-1) NEXT t = t + (Y(j%) - q) ^ 2 g = g + (Y(j%) - m) ^ 2 NEXT IF g = 0 THEN t = 1: GOTO PrintFit t = 1 - t/g PrintFit: PRINT PRINT INT(t * 100); "% fit" IF MenuFlag = 0 THEN HighestDeg = HighestDeg + 1 RETURN Calculate2: IF n = 1 THEN v(1) = r(1) / z(1,1): RETURN FOR k% = 1 TO n-1 a% = k% + 1 b = k% Skip1: IF ABS(z(a%,k%)) > ABS(z(b,k%)) THEN b = a% IF a% < n THEN a% = a% + 1: GOTO Skip1 IF b = k% THEN GOTO Skip2 FOR j% = k% TO n: q = z(k%,j%): z(k%,j%) = z(b,j%) z(b,j%) = q NEXT q = r(k%): r(k%) = r(b): r(b) = q Skip2: a% = k% + 1 Skip3: q = z(a%,k%) / z(k%,k%): z(a%,k%) = 0 FOR j% = k% + 1 TO n: z(a%,j%) = z(a%,j%) - q * z(k%,j%): NEXT r(a%) = r(a%) - q * r(k%): IF a% < n THEN a% = a% + 1: GOTO Skip3 NEXT v(n) = r(n) / z(n,n) FOR a% = n - 1 TO 1 STEP -1 q = 0 FOR j% = a% + 1 TO n: q = q + z(a%,j%) * v(j%) v(a%) = (r(a%) - q) / z(a%,a%) NEXT NEXT RETURN GraphIt: Max = X(NumPairs) Min = X(1) PRINT PRINT "Your low X point was "; Min PRINT "Your high X point was "; Max PRINT PRINT "<1> Use these points to graph <2> Use other points to graph" PRINT UseWhich: UW$ = INKEY$ IF UW$ = "" THEN UseWhich IF VAL(UW$) < 1 OR VAL(UW$) > 2 THEN UseWhich IF VAL(UW$) = 1 THEN LowX = Min HighX = Max GOTO FindDiff END IF INPUT "Input the low x value then press RETURN"; LowX INPUT "Input the high x value then press RETURN"; HighX PRINT FindDiff: Max = -1E+30 Min = 1E+30 Diff1 = ABS(HighX - LowX) Diff = Diff1/500 WhatDeg = 0 PRINT "What degree equation do you want to use?"; FindDegree: WhatDeg$ = INKEY$ IF WhatDeg$ = "" THEN FindDegree WhatDeg = VAL(WhatDeg$) IF WhatDeg < 1 THEN PRINT " Invalid entry - try again" PRINT PRINT "What degree equation do you want to use?"; GOTO FindDegree END IF PRINT WhatDeg GOSUB Calculate PRINT PRINT "Scaling....." HighEnd = HighX + (Diff/2) FOR Look = LowX TO HighEnd STEP Diff 'find max and min YValue = 0 FOR k% = 1 TO WhatDeg + 1 YValue = YValue + v(k%) * Look ^ (k%-1) NEXT IF YValue < Min THEN Min = YValue IF YValue > Max THEN Max = YValue NEXT CLS GOSUB Makegrid Scaler2 = 152/(Max - Min) Scaler1 = 20 - (Min * Scaler2) XCount = 119 FOR Plot = LowX TO HighX STEP Diff 'plot graph YValue = 0 FOR k% = 1 TO WhatDeg + 1 YValue = YValue + v(k%) * Plot ^ (k%-1) NEXT XCount = XCount + 1 YPlot = (YValue * Scaler2) + Scaler1 YPlot = 192 - YPlot ' invert PSET(XCount,YPlot) NEXT Diff = 500/ABS(LowX - HighX) 'plot the user's points FOR PP = 1 TO NumPairs NewX = (ABS(X(PP) - LowX) * Diff) + 120 NewY = 192 - ((Y(PP) * Scaler2) + Scaler1) CIRCLE (NewX,NewY),5,5 CIRCLE (NewX,NewY),6,5 NEXT LOCATE 24,23 COLOR 7,0 PRINT "PRESS ANY KEY TO RETURN TO THE MENU"; COLOR 1,0 WaitForKey: IF INKEY$ = "" THEN WaitForKey CLS GOTO PrintMenu Makegrid: 'draw garph grid on screen FOR Grid = 120 TO 630 STEP 25 COLOR 2,0 LINE (Grid,20) - (Grid,172) IF (Grid - 120) MOD 100 = 0 THEN COLOR 3,0 LINE (Grid,8) - (Grid,19) END IF NEXT COLOR 2,0 FOR Grid = 20 TO 172 STEP 8 LINE (0,Grid) - (620,Grid) NEXT COLOR 3,0 FOR Grid = 20 TO 172 STEP 8 LINE (0,Grid) - (120,Grid) NEXT COLOR 1,0 'print Y scale LOCATE 3,1 MinMax = (Max - Min)/19 PrintY = Max FOR Grid = 1 TO 20 PRINT PrintY PrintY = PrintY - MinMax NEXT COLOR 1,0 'print X scale Up$ = "" WIDTH 80 AddX = 0 PadFlag = 0 UDFlag = 0 XDiff = ABS(LowX - HighX)/10 AddX = AddX - XDiff LOCATE 1,1 FOR XX = 1 TO 11 UDFlag = ABS(UDFlag - 1) AddX = AddX + XDiff XPrint = AddX + LowX XPrint$ = LEFT$(STR$(XPrint),7) WHILE LEN(XPrint$) < 12 XPrint$ = " " + XPrint$ WEND IF UDFlag = 1 THEN Up$ = Up$ + XPrint$ IF PadFlag = 0 THEN Up$ = Up$ + " " PadFlag = 1 END IF END IF NEXT LOCATE 2,5 PRINT Up$ RETURN GetIt: 'input routine COLOR 7,0 PRINT " ---> "; Final$ = "" GetItOn: User$ = INKEY$ IF User$ = "" THEN GetItOn User$ = UCASE$(User$) IF User$ = "C" THEN Final$ = "C": GOTO EndGet IF User$ = "D" THEN Final$ = "D": GOTO EndGet IF User$ = CHR$(8) OR User$ = CHR$(127) THEN 'backspace PRINT User$; Final$ = LEFT$(Final$,LEN(Final$)-1) GOTO GetItOn END IF IF User$ = "," THEN GetItOn IF User$ = CHR$(13) THEN Final = VAL(Final$) PRINT IF Final$ = "" THEN BEEP PRINT "RETURN with no input - try again" PRINT GOTO GetItOn END IF GOTO EndGet END IF Final$ = Final$ + User$ PRINT User$; GOTO GetItOn EndGet: COLOR 1,0 RETURN DATA "Least Squares" DATA " " DATA "C 1987 to George Trepal 2650 Alturas Rd Bartow FL 33830" DATA "a shareware program - OK to give free but not to sell" DATA " " DATA " This program uses the Least Squares technique to find equations" DATA "from points. For example if you can microwave two muffins in" DATA "25 seconds, three muffins in 50 seconds, and four muffins in 120" DATA "seconds how long will five muffins take? To solve the mystery" DATA "feed the program the point pairs" DATA " " DATA "Muffins Seconds" DATA "2 25" DATA "3 50" DATA "4 120" DATA " " DATA "then tell it to calculate. It'll produce equations of different" DATA "degrees and judge their quality. Pick the one of highest quality" DATA "and feed it 5 to find how long five muffins would take." DATA " Of course there are other uses. You can use it for trend" DATA "analysis or for graphics programs to find a complex curve that" DATA "exactly fits your needs. And it's great to check your homework." DATA "---> PRESS ANY KEY TO READ MORE <---" DATA " " DATA "WARNING! Equations above the second degree are sometimes tricky." DATA "Instead of a smooth curve that fits your points they may be snakes" DATA "that merely intersect them. Always graph an equation to see what" DATA "it's realy like." DATA " " DATA "Predicted points far away from known points tend to be wrong so" DATA "use common sense about what you trust. DATA " " DATA "If this program can't give you a nice equation from your points don't" DATA "give up. There's a lot of math, such as trig functions, this program" DATA "can't handle. What It can handle it handles very well but it's not a" DATA "universal curve finder." DATA " " DATA " " DATA "This is version 1.0" DATA " " DATA "Released to public domain September 1987" DATA " " DATA "If you like this program please send a contribution." DATA " " DATA " " DATA "PRESS ANY KEY TO CONTINUE"