Uses CRT,GRAPH; Const MinX : real = -10; MaxX : real = -9; MinY : real = MaxInt; MaxY : real = -MaxInt; {---------------------} LagrTable = 10; {---------------------} CStep = 1000; TVer = 0.01; ZX : longint = 250; ZY : longint = 200; Left = 30; Right = 400; Top = 20; Bottom = 400; {-----------------------------} Type LD = array [0..LagrTable] of record x,y : real; end; TB = array [0..LagrTable] of boolean; var Thresh : real; Pts : LD; BegiP, EndiP : TB; Function Func(x: real): real; Begin { Func := ln(abs(x));} { Func := Sin(x)*x;} Func := 1.4*x+2; { Func := X*X/10 * sin (x/2)} End; {-----------------------------} Function Lagr(X:real; var T : TB):real; var i,j,n : word; c,ret : real; begin n := LagrTable; ret:=0; for i := 0 to n do if T[i] then begin c:=1; for j := 0 to n do if (j <> i) AND T[j] then C := C * (X-Pts[j].X) / (Pts[i].X-Pts[j].X); ret := ret + Pts[i].Y*C; end; Lagr := ret; end; {-----------------------------} Procedure SetMinMax(var T:tb); var c:real; i:word; begin if MaxX < MinX then begin C := MaxX;MaxX := MinX;MinX := C; end; for i := 0 to Cstep do begin C := Lagr(MinX+i/CStep*(MaxX-MinX),T); if C > MaxY then MaxY:=C; if C < MinY then MinY:=C; end; end; {-----------------------------} Procedure InitG; Var grDriver: Integer; grMode: Integer; i : integer; Begin grDriver := Detect; InitGraph(grDriver, grMode,''); if GraphResult <> grOk then begin WriteLn('Graph error!'); Halt(255); end; End;{InitG} {---------------------------------} Procedure DrawAxis; var i : integer; s : string; ZX1,ZY1 : longint; begin if MinX > 0 then ZX := round(Left - MinX/(MaxX-MinX)*(Right-Left)) else if MaxX < 0 then ZX := round(Right - MaxX/(MaxX-MinX)*(Right-Left)) else ZX := round(Left + abs(MinX)/(MaxX-MinX)*(Right-Left)); if MinY > 0 then ZY := round(Bottom + MinY/(MaxY-MinY)*(Bottom-Top)) else if MaxY < 0 then ZY := round(Top + MaxY/(MaxY-MinY)*(Bottom-Top)) else ZY := round(Bottom - abs(MinY)/(MaxY-MinY)*(Bottom-Top)); if (ZX > Left) AND (ZX < Right) then ZX1 := ZX else if ZX < LEFT then ZX1 := Left else ZX1 := Right; if (ZY > Top) AND (ZY < Bottom) then ZY1 := ZY else if ZY < Top then ZY1 := Top else ZY1 := Bottom; SetColor(White); Line(Left,ZY1,Right+10,ZY1); Line(Right-5,ZY1-5,Right+10,ZY1); Line(Right-5,ZY1+5,Right+10,ZY1); Line(ZX1,Top-10,ZX1,Bottom); Line(ZX1,Top-10,ZX1-5,Top+5); Line(ZX1,Top-10,ZX1+5,Top+5); OutTextXY(ZX1-10,ZY1-10,'0'); OutTextXY(ZX1-15,Top,'Y'); OutTextXY(Right,ZY1+10,'X'); Str(MaxX:0:2,S); OutTextXY(Right,ZY1-10,S); Str(MinX:0:2,S); if MinX<0 then OutTextXY(Left,ZY1-10,S); Str(MaxY:0:2,S); OutTextXY(ZX1+10,Top,S); Str(MinY:0:2,S); if MinY<0 then OutTextXY(ZX1+10,Bottom,S); end; {--------------------} Procedure LoadData; var i : longint; begin for i := 0 to LagrTable do begin Pts[i].x := MinX + i/LagrTable*(MaxX-MinX); Pts[i].y := Func(Pts[i].x); BegiP[i] := true; EndiP[i] := true; end; end; {--------------------} Procedure FillTable(var T : TB); var i:word; ax,ay : string; begin SetFillStyle(SolidFill,Black); Bar(440,30,630,380); SetColor(Cyan); Rectangle(440,30,630,380); SetColor(Blue); for i := 0 to LagrTable do if T[i] then begin Str(Pts[i].x:0:2,aX); aX:='X'+Chr(i+$30)+'='+aX; Str(Pts[i].y:0:2,aY); aY:='Y'+Chr(i+$30)+'='+aY; SetTextJustify(LeftText,CenterText); OutTextXY(450,round(50 + i/LagrTable*300),aX); OutTextXY(550,round(50 + i/LagrTable*300),aY); end; end; {-----------------------------} Procedure DrawLagr(var T : TB); Var C : real; i : word; x, y : real; Begin { if (MaxY-MinY) > (MaxX-MinX) then C := (Bottom-Top)/(MaxY-MinY) else C := (Right-Left)/(MaxX-MinX);} if (MaxY-MinY) > (MaxX-MinX) then begin if MaxY*MinY < 0 then C := (Bottom-Top)/(MaxY-MinY) else if MaxY < 0 then C:=(Bottom-Top)/abs(MinY) else C:=(Bottom-Top)/MaxY; end else begin if MaxX*MinX < 0 then C := (Right-Left)/(MaxX-MinX) else if MaxX < 0 then C := (Right-Left)/abs(MinX) else C := (Right-Left)/MaxX; end; MoveTo(round(ZX + MinX*C),round(ZY-Lagr(MinX,T)*C)); for i := 1 to CStep do begin x:=MinX + i/CStep*(MaxX-MinX); y:=Lagr(X,T); LineTo(round(ZX+X*C),round(ZY-Y*C)); end; End;{DrawLagr} {-------------} Function Check(var T1, T2 : TB):boolean; var i : word; x, y1, y2 : real; Begin Check := true; for i := 0 to CStep do begin x:=MinX + i/CStep*(MaxX-MinX); y1:=Lagr(X,T1); y2:=Lagr(X,T2); if abs(y1-y2) > Thresh then begin Check := false; Exit; end; end; end; var CKick : word; ifDel : boolean; cS : word; Begin LoadData; InitG; SetMinMax(BegIp); Thresh := TVer * (MaxY-MinY); DrawAxis; { WriteGraph(CStep);} FillTable(BegIp); SetColor(Green); DrawLagr(BegIp); CKick :=0; repeat ifDel := false; for cS := 0 to LagrTable do if EndiP[cS] then begin EndiP[cS] := false; if Check(BegiP,EndiP) then begin inc(CKick); ifDel := true; end else EndiP[cs] := true; end; until not ifDel; ReadKey; FillTable(EndiP); SetColor(White); DrawLagr(EndiP); ReadLn; CloseGraph; WriteLn('Выкинуто точек - ',CKick); End.