|
Главная | Правила | Регистрация | Дневники | Справка | Пользователи | Календарь | Поиск | Сообщения за день | Все разделы прочитаны |
|
Опции темы | Опции просмотра |
05.07.2017, 20:56 | #1 (permalink) |
Новичок
Регистрация: 05.07.2017
Сообщений: 2
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Определить радиус и центр окружности минимального радиуса
|
05.07.2017, 20:56 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
На форуме можно найти похожие топики, помогу вам в этом Радиус изгиба провода Ограничение минимального напряжения Видит, подключается, радиус действия 30 см Найти длину дуги окружности Скорость передачи и радиус действия |
06.07.2017, 12:46 | #4 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Да... хороша задачка! Возни преизрядно. Впрочем, попробую — интересно!
SiliconPower8gb, а сдать нужно, как обычно, позавчера? |
06.07.2017, 16:16 | #5 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Вот. Сотворил:
Код:
Const N=10; {Number of points} L=100; {Dimension of area LxL} Eps=0.001; {minimal difference between angular coefficients} Type Crd=Record x,y:Word; End; Var Pts:Array[1..N] of Crd; i,j,k,Xp1,Xp2,Xp3,Yp1,Yp2,Yp3:Word; Bu:boolean; R,Rmin,Xc,Yc,Xcm,Ycm,A1,B1,C1,A2,B2,C2:Real; Function Determ(Q11,Q12,Q21,Q22:real):real; begin Determ:=Q11*Q22-Q12*Q21; end; Procedure Lines(x1,y1,x2,y2,x3,y3:Word; var Al1:real; var Bl1:real; var Cl1:real; var Al2:real; var Bl2:real; var Cl2:real); {Two crossing lines parameters} Var Kl,Xc,Yc:real; begin if x1=x2 then begin Al1:=1.0; Bl1:=0; Cl1:=-(x1+x2)/2; end else if y1=y2 then begin Al1:=0; Bl1:=1; Cl1:=-(y1+y2)/2; end else begin Xc:=(x1+x2)/2; Yc:=(y1+y2)/2; Kl:=-(x2-x1)/(y2-y1); Al1:=Kl; Bl1:=-1.0; Cl1:=Yc-Kl*Xc; end; if x2=x3 then begin Al2:=1.0; Bl2:=0; Cl2:=-(x2+x3)/2; end else if y2=y3 then begin Al2:=0; Bl2:=1; Cl2:=-(y2+y3)/2; end else begin Xc:=(x2+x3)/2; Yc:=(y2+y3)/2; Kl:=-(x3-x2)/(y3-y2); Al2:=Kl; Bl2:=-1.0; Cl2:=Yc-Kl*Xc; end; end; Procedure CrP(Ac1,Bc1,Cc1,Ac2,Bc2,Cc2:real; var Xcp:real; var Ycp:real); {Crossing point coordinates} Var D1,D2,D3:real; begin D1:=Determ(Ac1,Bc1,Ac2,Bc2); D2:=Determ(Bc1,Cc1,Bc2,Cc2); D3:=Determ(Cc1,Ac1,Cc2,Ac2); Xcp:=D2/D1; Ycp:=D3/D1; end; Function Radius(X,Y,XRc,YRc:real):real; begin Radius:=Sqrt(Sqr(X-XRc)+Sqr(Y-YRc)); end; Begin Randomize; for i:=1 to N do repeat Pts[i].x:=Random(L); Pts[i].y:=Random(L); Bu:=TRUE; for j:=1 to i-1 do if (Pts[j].x=Pts[i].x) and (Pts[j].y=Pts[i].y) then Bu:=FALSE; until Bu; Rmin:=1.0E300; for i:=1 to N do for j:=i+1 to N do for k:=j+1 to N do begin Lines(Pts[i].x,Pts[i].y,Pts[j].x,Pts[j].y,Pts[k].x,Pts[k].y, A1,B1,C1,A2,B2,C2); if Abs(Determ(A1,B1,A2,B2))>Eps then begin Crp(A1,B1,C1,A2,B2,C2,Xc,Yc); R:=Radius(Pts[i].x,Pts[i].y,Xc,Yc); if R<Rmin then begin Rmin:=R; Xcm:=Xc; Ycm:=Yc; Xp1:=Pts[i].x; Yp1:=Pts[i].y; Xp2:=Pts[j].x; Yp2:=Pts[j].y; Xp3:=Pts[k].x; Yp3:=Pts[k].y; end; end; end; Writeln('Point coordinates:'); Writeln(' x1 = ',Xp1:2,' y1 = ',Yp1:2); Writeln(' x2 = ',Xp2:2,' y2 = ',Yp2:2); Writeln(' x3 = ',Xp3:2,' y3 = ',Yp3:2); Writeln; Writeln('Center coordinates:'); Writeln(' X = ',Xcm:7:3,' Y = ',Ycm:7:3); Writeln; Writeln('Radius:'); Writeln(' R = ',Rmin:7:3); Readln End. |
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
Опции темы | |
Опции просмотра | |
|
|