PDA

Просмотр полной версии : Задача по Turbo Pascal



assis2007
04.11.2007, 20:11
Задача выглядит так: найти в матрице строку с минимальным числом ненулевых элементов. Кол-во строк и столбцов от 1 до 100. Я тут набросал кое что
cur_row: Integer;
cur_zero_num: Integer;

begin

rows И cols - РЯДЫ И СТОЛБЦЫ В МАТРИЦЕ

cur_row:= 0;
cur_zero_num:= 0;

for i := 1 to rows do
begin
x:=0;
for j := 1 to cols do begin
if a[i, j] = 0 then x:= x+1;
end;
if cur_zero_num < x then begin
cur_zero_num := x;
cur_row := i;
end;
end;
end.
Мне нужна основная часть матрицы, если конешно правильно то что я написал.

Колядин Максим
04.11.2007, 20:50
найти в матрице строку с минимальным числом ненулевых элементов.
А если таких строк несколько? Я предлагаю вариант: таковых больше 1, тогда в ответ выводим перую попавшуюся.
Вот код:


var a: array [1..100,1..100] of integer;
min,zero,max_zero: integer;
i,j: integer;
begin
max_zero:=101; {max zeros +1}
{здесь наполняем массив элементами}
for i:= 1 to 100 do begin
zero:=0;
for j:= 1 to 100 do if a[i,j]=0 then inc(zero);
if zero<max_zero then begin
min:=i;
max_zero:=zero;
end;
end;
Writeln('Меньше нулей в столбце N',min,');
end.

assis2007
04.11.2007, 21:54
Да нужна именно первая строка спасибо. А можно целиком задачу, а то я немножко болван в паскале, но стараюсь освоить. Чтобы можно было сразу в паскаль переписать. (если не сложно)

Колядин Максим
04.11.2007, 23:39
assis2007, а тут и дописывать, можно сказать, нечего :-) Здесь остается только заполнить массив элементами и сделать ввод данных.


var a: array [1..100,1..100] of integer;
mi,mj: integer; {кол-во строк и столбцов}
min,zero,max_zero: integer;
i,j: integer;
begin
write('Kol-vo strok: '); read(mi);
write('Kol-vo stolcov: '); read(mj);
max_zero:=mi+1;
randomize;
for i:= 1 to mi do
for j:= 1 to mj do a[i,j]:=random(3); {к примеру}
for i:= 1 to mi do begin
zero:=0;
for j:= 1 to mj do if a[i,j]=0 then inc(zero);
if zero<max_zero then begin
min:=i;
max_zero:=zero;
end;
end;
Writeln('Minimalno nenulevih elementov v stroke №',min);
readln;
end.

Без отображения массива элементов. Если хочешь, можешь добавить это, для того, чтобы убедиться в работоспособности программы.

assis2007
05.11.2007, 16:17
Тут маленькая неувязочка которую я вспомнил. Я должен ещё и сам вводить матрицу т.е. мне выводиться введите элемент матрицы например a11 это нужно добавлять вроде сразу после ввода количества строк и столбцов?

Serge_Bliznykov
05.11.2007, 20:10
write('Kol-vo strok: '); read(mi);
write('Kol-vo stolcov: '); read(mj);
max_zero:=mi+1;
for i:= 1 to mi do
for j:= 1 to mj do begin
Write('Vvedite a[',i:1,',',j:1,']');
Readln(a[i,j]);
end;

assis2007
11.11.2007, 17:03
Странно но какую бы матрицу не вводил она выводит не правильно. Вот например при вводе матрицы
5 6 0
7 0 0
правильный ответ будет строка 2
он же выводит строку номер 1

assis2007
11.11.2007, 17:03
Что нужно поменять?

Хыиуду
12.11.2007, 11:47
Скорее всего, здесь читается транспонированная матрица. Т.е. фактически введена матрица
5 7
6 0
0 0
И 1 строка - совершенно правильный ответ.
Чтобы ликвидировать когнитивный диссонанс, предлагаю изменить код Serge Bliznykov
Readln(a[i,j]); => Readln(a[j,i]);

assis2007
12.11.2007, 19:12
Нет всё равно ответ первая строка

Хыиуду
14.11.2007, 11:16
Тогда, чувствую, ошибка где-то в логике. Можно переделать: найти строку с минимальным количеством ненулевых элементов - это то же самое, что найти строку с максимумом нулей


max_zero:=0;
for i:= 1 to mi do begin
zero:=0;
for j:= 1 to mj do if a[i,j]=0 then inc(zero);
if zero>ax_zero then begin
max:=i;
max_zero:=zero;
end;
end;
Writeln('Minimalno nenulevih elementov v stroke №',max);

assis2007
15.11.2007, 20:46
Всё заработало огромное спасибо ввёл тесты и всё что нужно получилось

assis2007
15.11.2007, 22:02
Собственно ещё есть маленький вопросик. Прога вычисляет наибольший общий делитель двух целых чисел.
var
n1,n2:integer;
nod:integer;
r:integer;
begin
writeln('вычисление наибольшего общего делителя двух целых чисел');
writeln('введите в одной строке два числа');
readln(n1,n2);
while (n1 mod n2)<>0 do
begin
r:=n1 mod n2;
n1:=n2;
n2:=r;
end;
nod:=n2;
writeln;
readln;
end.
Мне нужно написать её через цикл repeat. Они взаимозаменяемы но у меня не получается

Serge_Bliznykov
15.11.2007, 22:50
вот уж проще некуда... вместо

while (n1 mod n2)<>0 do
begin
...
end;
поставьте


repeat
...
until (n1 mod n2)=0;
только учтите, что в этом случае тело выполниться хотя бы одина раз!! ВСЕГДА!
поэтому, возможно, прийдётся добавить проверку перед циклом:

if (n1 mod n2)<>0 then
repeat
...
until (n1 mod n2)=0;

p.s. извините, но в текст сайо программы не вчитывался..

Хыиуду
16.11.2007, 13:44
А можно узнать, зачем в конце программы
writeln;
readln;
если все равно в консоль по ходу работы ничего не выводится?

assis2007
18.11.2007, 18:35
Я просто не стал переписывать длинную строчку на русском

assis2007
18.11.2007, 18:41
Serge_Bliznykov, пишет ошибку когда уже скомпилирована и ввожу два числа. Дословно error 200:division by zero

Хыиуду
19.11.2007, 15:32
Есть мнение, что первое число должно быть больше второго. Если я правильно помню алгоритм Евклида

assis2007
21.11.2007, 21:51
Извиняюсь за нубство но что такое inc(zero) где не смотрю такого нету и никто не знает а мне ведь надо объяснить что это преподу

Хыиуду
22.11.2007, 15:14
Поставить курсор на непонятное слово и нажать Ctrl+F1;
inc(zero) <=> zero:=zero+1;
inc(zero, N) <=> zero:=zero+N;

assis2007
22.11.2007, 19:36
Большое спасибо т.е. если я поставлю место inc(zero) zero:=zero+1 ничего не измениться насколько я понял.

Хыиуду
23.11.2007, 10:58
assis2007, именно!

Oleg_Rus
26.11.2007, 06:06
а что если создать еще один одномерный массив, и записывать в нем кол-во ненулевых эл-ов, причем заполнение идет параллельно матрице? например при просмотре 1 столбца, пусть заполняется 1 эл-т второго массива и т.д. и вонце распечатать максимум из второго массива? Согласен программа далеко не оптимизирована, но должна работать.

Oleg_Rus
26.11.2007, 06:07
for i:=1 to n do
for j:=1 to m do
if a[i, j]<>0 then b[i]:=b[i]+1;
max:=0;
for i:=1 to n do
if b[i]>max then max:=b[i];
write(max);

assis2007
27.11.2007, 17:54
можно конешно но это дополнительные накрутки и мне они не нужны. У меня другая проблема: найти три точки, чтобы внутри треугольника с вершинами в этих точках содержалось бы наибольшее число заданных точек.

Хыиуду
27.11.2007, 18:10
(0, oo), (-oo, -oo), (oo,-oo).
А вообще - точка D находится внутри треугольника ABC, если сумма углов ABD+DBC равна углу ABC, и то же самое для остальных вершин. Углы можно определять по теореме косинусов из длин сторон, а они определяются по координатам по теореме Пифагора

Alykards
27.11.2007, 19:29
Привет всем.Пожалуйста помогите решить задачу:
Найти значение функции y=(2)х(здесь х - степень)*sinx при заданном значении x и проверить лежит ли точка с координатами(х,у) в областе D(область D - это 1/4 круга координатной площади,
где начало круга(0,2), а конец - (2,0))
Очень надо!

Хыиуду
28.11.2007, 13:07
f(x)=exp(sin(x)*ln(2))
(sqrt(sqr(x)+sqr(y))<=2) and (x>0) and (y>0)

assis2007
07.12.2007, 19:32
Ну что мысли у кого-нибудь есть какие-нибудь?найти три точки, чтобы внутри треугольника с вершинами в этих точках содержалось бы наибольшее число заданных точек.

Хыиуду
10.12.2007, 11:44
Ну что мысли у кого-нибудь есть какие-нибудь?найти три точки, чтобы внутри треугольника с вершинами в этих точках содержалось бы наибольшее число заданных точек.
Мой предпредыдущий пост отвечает на этот вопрос. Если три любые точки - то ответ тривиален: три точки в плюс и минус бесконечности.

assis2007
10.12.2007, 22:03
Если честно ничего не понял из выш сказанного. Ты предложил искать принадлежность через сумму углов

Хыиуду
11.12.2007, 11:08
Объясняю.
Если точка О лежит внутри угла ABC, то луч BО проходит между лучами BА и ВС. В таком случае углы АВО и ОВС в сумме дают угол АВС. Если О лежит вне этого угла, тогда АВО+ОВС>АВС.

Поскольку нам известны координаты трех вершин треугольника, мы можем по теореме Пифагора найти длину каждой из трех сторон. После этого можем найти угол между двумя сторонами из теоремы косинусов: c^2=a^2+b^2-2ab*cos(alpha), где alpha - угол между сторонами a и b.

Итого, зная координаты точек А, В, С и О, мы определяем, лежит ли точка О внутри углов АВС, ВСА или САВ. Если лежит внутри хотя бы двух из них - она лежит внутри треугольника АВС. То же проверить для всех остальных точек.

И еще: что-то мне подсказывает, что наиболее вероятные кандидаты на должность искомых трех точек - те, в которых координаты либо максимальны, либо минимальны среди остальных точек

assis2007
11.12.2007, 14:36
А можно тоже самое в паскале теперь?

Хыиуду
12.12.2007, 11:06
Для того, чтобы перевести это на Паскаль, достаточно знать его синтаксис. Для того, чтобы знать синтаксис, достаточно прочитать учебник. Пробуйте. Если что-то будет не получаться - пишите

assis2007
14.12.2007, 18:55
Я тут набросал кое что естественно не компилируется

Program treyg;
Uses Crt;
Const Max=50;
Var i,j,v,v1,n,a,b,c,way,u,z,NN,NM,L1,MMaxx:Integer;
X:array [1..Max] of Real;
WX,WY:array [1..6,1..Max] of Real;
Y:array [1..Max] of Real;
M:array [1..Max] of Integer;
ii:array [1..3] of Integer;
XX,YY:array [1..3] of Real;
Found,Pr:Boolean;
xa,ya,xb,yb,k1,k2,g1,g2,g3: Real;
xc,yc,xd,yd: array [1..2] of Real;
Procedure INput;
Begin
Repeat
WriteLn(' ‘Є®«мЄ® в®зҐЄ ‚л б®ЎЁа*ҐвҐбм ўўҐбвЁ (¤® 50) ? ');
Write(' ');
Readln(n);
If n<=0 then
Writeln(' ЌҐ¤®ЇгбвЁ¬®Ґ Є®«-ў®');
If n>Max then
Writeln(' €е Є®«-ў® б«ЁиЄ®¬ Ў®«м讥');
Until (N>0) and (N<=Max);
Writeln(' ‚ўҐ¤ЁвҐ Ёе Є®®а¤Ё**вл ');
For i:=1 to n do
Begin
Writeln(' ’®зЄ* A',i,':');
Write(' X',' = ');
Readln(X[i]);
Write(' Y',' = ');
Readln(Y[i]);

end
End;
Procedure DoingSum;
Procedure Lookfor;
Begin
Found:=False;
Pr:=FALSE;
xa:=X[b]-X[a]; ya:=y[b]-y[a];
xc:=X[c]-X[a]; yc:=y[c]-y[a];

xb:=X[c]-X[b]; yb:=y[c]-y[b];
ii[1]:=a; ii[3]:=c;
ii[2]:=b;
For u:=1 to 3 do
For v:=(u+1) to 3 do
If (x[ii[u]]=x[ii[v]])and(y[ii[u]]=y[ii[v]]) then
Begin
PR:=true;
End;
For u:=1 to 3 do Begin
WX[u,z+1]:=X[ii[u]];
WY[u,z+1]:=Y[ii[u]];
End;
For u:=1 to z do Begin
NM:=0;
For v:=1 to 3 do
For v1:=1 to 3 do
If (WX[v1,z+1]=WX[v,u])and(WY[v1,z+1]=WY[v,u]) then
NM:=NM+1;
IF NM=3 then
PR:=true;
end;
If not Pr then Begin
If pr=true then Writeln('ЋиЁЎЄ* 2');
Way:=0;
g1:=(xa*xb+ya*yb)/(sqrt(sqr(xa)+sqr(ya))*sqrt(sqr(xb)+sqr(yb)));
g2:=(xb*xc+yb*yc)/(sqrt(sqr(xb)+sqr(yb))*sqrt(sqr(xc)+sqr(yc)));
g3:=(xa*xa+ya*yc)/(sqrt(sqr(xa)+sqr(ya))*sqrt(sqr(xc)+sqr(yc)));
If ABS(Round(g1*1000)/1000) = 1 then Begin
If ABS(Round(g2*1000)/1000)=1 then way:=way+1;
If ABS(Round(g3*1000)/1000)=1 then way:=way+2;
If (way=1) or (way=2) then
Found:=true;
If way=2 then
begin
WX[3,z+1]:=X[c];WX[2,z+1]:=X[d];
WY[2,z+1]:=Y
[d];WY[3,z+1]:=Y[c];
End;{If way=2}
End;{ЏҐаў®Ј® If-*}
End;{If not Pr}
End;{Procedure Lookfor}
Procedure Counting;
Begin
z:=z+1;
WX[5,z]:=WX[1,z];WX[6,z]:=WX[2,z];
WY[5,z]:=WY[1,z];WY[6,z]:=WX[2,z];
For j:=1 to n do Begin
NN:=0;
For i:=1 to 3 do
Begin
k1:=(WX[i+2,z]-Wx[i,z])*(Wy[i+1,z]-Wy[i,z])-(Wx[i+1,z]-Wx[i,z])*(Wy[i+2,z]-WY[i,z]);
k2:=(X[j]-Wx[i,z])*(Wy[i+1,z]-Wy[i,z])-(Wx[i+1,z]-Wx[i,z])*(y[j]-WY[i,z]);;
If k1*k2>0 then
NN:=NN+1;
End;
If NN=3 then
M[z]:= M[z] + 1;
End;
End;
Procedure Max;
Begin
MMaxx:= M[1]; {MMaxx-¬*ЄбЁ¬*«м*®Ґ Є-ў® в®зҐЄ ў Ї*а-¬Ґ,*®¬Ґа Є®в-Ј® L1}
L1:=1;
For I:=1 to z do
If Mmaxx<M[I] then
Begin
Mmaxx:=M[I];
L1:=I;
End;
XX[1]:=WX[1,L1];XX[3]:=WX[3,L1];
XX[2]:=WX[2,L1];
YY[1]:=WY[1,L1];YY[3]:=WY[3,L1];
YY[2]:=WY[2,L1];
End;{Procedure Max}
Begin {DoingSum}
L1:=0;NN:=0;NM:=0;z:=0;
For a:=1 to (n-2) do
For b:=(a+1) to n do
For c:=(a+1) to n do
For d:=(c+1) to n do
Begin
Lookfor;
If Found then
Counting;
End;
If z>=1 then
Max;
End;{DoingSum}
Procedure OUTput;
Begin
If z=0 then Writeln('treyg *Ґв')
else Begin
Writeln('‚ҐаиЁ*л treygolnika , ᮤҐа¦*饣® ¬*ЄбЁ¬*«м*®Ґ Є®«-ў® в®зҐЄ:');
Writeln(' A( ',XX[1]:2:2,' , ',YY[1]:2:2,' )');
Writeln(' B( ',XX[2]:2:2,' , ',YY[2]:2:2,' )');
Writeln(' C( ',XX[3]:2:2,' , ',YY[3]:2:2,' )');

Writeln('„®Ї®«*ЁвҐ«м**п Ё*д®а¬*жЁп :');
Writeln({'…Ј® *®¬Ґа ',L1,}' ў *Ґ¬ ',Mmaxx,' в®зҐЄ, * ўбҐЈ® Ї*а*«-¬®ў ',z);
End;
ENd;
Begin
Clrscr;
Writeln(' Џа®Ја*¬¬* **室Ёв treyg, ᮤҐа¦*йЁ© ¬*ЄбЁ¬*«м*®Ґ Є®«-ў® §*¤***ле в®зҐЄ');
Writeln(' (ўҐаиЁ*л treyg -- ў §*¤***ле в®зЄ*е).');
Writeln;
INput;
DoingSum;
OUTput;
Readln;
end.

не стал переписывать где выводятся сообщения
у меня вопрос нельзя ли прогу с параллелограммом переделать на треугольник?

assis2007
15.12.2007, 19:08
Мне нужна помощь в части вычисления треугольника с наибольшим числом точек внутри я делаю так: даны нам три точки А В С и некая Е и программа вычисляет входит Е в треугольник или нет через сумму площадь треугольника АВС равна площади трёх треугольников АВЕ АСЕ ВСЕ . Если она равна то входит .

assis2007
15.12.2007, 21:03
Program treygolnik;
Uses Crt;
Const Max=100;
Var i,j,v,v1,n,a,b,c,d,way,u,z,NN,NM,L1,MMaxx:Integer;
X:array [1..Max] of Real;
WX,WY:array [1..6,1..Max] of Real;
Y:array [1..Max] of Real;
M:array [1..Max] of Integer;
ii:array [1..3] of Integer;
XX,YY:array [1..3] of Real;
Found,Pr:Boolean;
xa,ya,xb,yb,k1,k2,g1,g2,g3: Real;
xc,yc,xd,yd: {array [1..2] of }Real;
Procedure INput;
Begin
Repeat
WriteLn(' kol-vo tochek ');
Write(' ');
Readln(n);
If n<=0 then
Writeln(' nedopystimoe chislo');
If n>Max then
Writeln(' slishkom mnogo');
Until (N>0) and (N<=Max);
Writeln(' vvedite koordinati ');
For i:=1 to n do
Begin
Writeln(' Tochka A',i,':');
Write(' X',' = ');
Readln(X[i]);
Write(' Y',' = ');
Readln(Y[i]);

end
End;
Procedure DoingSum;
Procedure Lookfor;
Begin
Found:=False;
Pr:=FALSE;
xa:=X[b]-X[a]; ya:=y[b]-y[a];
xc:=X[c]-X[a]; yc:=y[c]-y[a];

xb:=X[c]-X[b]; yb:=y[c]-y[b];
ii[1]:=a; ii[3]:=c;
ii[2]:=b;
For u:=1 to 1{2} do
For v:=u to 2{3} do
If (x[ii[u]]=x[ii[v]])and(y[ii[u]]=y[ii[v]]) then
Begin
PR:=true;
End;
For u:=1 to 2{3} do Begin
WX[u,z+1]:=X[ii[u]];
WY[u,z+1]:=Y[ii[u]];
End;
For u:=1 to z do Begin
NM:=0;
For v:=1 to 2{3} do
For v1:=1 to 2{3} do
If (WX[v1,z+1]=WX[v,u])and(WY[v1,z+1]=WY[v,u]) then
NM:=NM+1;
IF NM=2{3} then
PR:=true;
end;
If not Pr then Begin
If pr=true then Writeln('Oshibka 2');
Way:=0;
g1:=(xa*xb+ya*yb)/(sqrt(sqr(xa)+sqr(ya))*sqrt(sqr(xb)+sqr(yb)));
g2:=(xc*xb+yc*yb)/(sqrt(sqr(xc)+sqr(yc))*sqrt(sqr(xb)+sqr(yb)));
g3:=(xc*xa+yc*ya)/(sqrt(sqr(xc)+sqr(yc))*sqrt(sqr(xa)+sqr(ya)));
If ABS(Round(g1*1000)/1000) = 1 then Begin
If ABS(Round(g2*1000)/1000)=1 then way:=way+1;
If ABS(Round(g3*1000)/1000)=1 then way:=way+2;
If (way=1) or (way=2) then
Found:=true;
If way=2 then
begin
WX[2{3},z+1]:=X[c];WX[1{2},z+1]:=X[d];
WY[1{2},z+1]:=Y
[d];WY[2{3},z+1]:=Y[c];
End;{If way=2}
End;{ЏҐаў®Ј® If-*}
end;
End;
Procedure Counting;
Begin
z:=z+1;
WX[2,z]:=WX[1,z];WX[3,z]:=WX[2,z];
WY[2,z]:=WY[1,z];WY[3,z]:=WX[2,z];
For j:=1 to n do Begin
NN:=0;
For i:=1 to 2{3} do
Begin
k1:=(WX[i+2,z]-Wx[i,z])*(Wy[i+1,z]-Wy[i,z])-(Wx[i+1,z]-Wx[i,z])*(Wy[i+2,z]-WY[i,z]);
k2:=(X[j]-Wx[i,z])*(Wy[i+1,z]-Wy[i,z])-(Wx[i+1,z]-Wx[i,z])*(y[j]-WY[i,z]);;
If k1*k2>0 then
NN:=NN+1;
End;
If NN=2{3} then
M[z]:= M[z] + 1;
End;
End;
Procedure Max;
Begin
MMaxx:= M[1];
L1:=1;
For I:=1 to z do
If Mmaxx<M[I] then
Begin
Mmaxx:=M[I];
L1:=I;
End;
XX[1]:=WX[1,L1];XX[3]:=WX[3,L1];
XX[2]:=WX[2,L1];
YY[1]:=WY[1,L1];YY[3]:=WY[3,L1];
YY[2]:=WY[2,L1];
End;{Procedure Max}
Begin {DoingSum}
L1:=0;NN:=0;NM:=0;z:=0;
For a:=1 to (n-1) do
For b:=a to n do
For c:=a to n do

Begin
Lookfor;
If Found then
Counting;
End;
If z>=1 then
Max;
End;{DoingSum}
Procedure OUTput;
Begin
If z=0 then Writeln('treyg net ')
else Begin
Writeln('vershini treyg:');
Writeln(' A( ',XX[1]:2:2,' , ',YY[1]:2:2,' )');
Writeln(' B( ',XX[2]:2:2,' , ',YY[2]:2:2,' )');
Writeln(' C( ',XX[3]:2:2,' , ',YY[3]:2:2,' )');

End;
ENd;
Begin
Clrscr;
Writeln(' proga nahodit treyg');
Writeln(' (vershini treyg -- v zadanih tochkah).');
Writeln;
INput;
DoingSum;
OUTput;
Readln;
end.

Вот компилируется но не находит что надо. Ввожу координаты но выводит нет решений

assis2007
16.12.2007, 19:18
Люди выручайте плиз!!!!

assis2007
25.12.2007, 18:04
Я написал но возникла проблема если ввожу координаты (1;1) (2;2) (3;3) то выводит нельзя построить а если ввожу (-0.5;-0.5) (-1;-1) (0;0) (0.5;0.5) (1;1) то он находит треугольник


program TREYGOLNIK;


const
B=0.001;

var
n,i,C,j,A,m,k:integer;
X,Y: array [1..100] of real;
s: array [1..3] of real;
W: array [1..4] of real;
TR: array [1..3,1..2] of real;
pr: boolean;
L: real;

function dl(a,b,c,d:real):real;
begin
dl:=sqrt((a-b)*(a-b)+(c-d)*(c-d));
end;
function plo(a,b,c:real):real;
begin
plo:=sqrt(((a+b+c)/2)*((a+b-c)/2)*((a+c-b)/2)*((b+c-a)/2));
end;
function plot(a,b,c:real):real;
begin
plot:=sqrt(((a+b+c)/2)*((a+b-c)/2)*((a+c-b)/2)*((b+c-a)/2));
end;

begin
writeln ('Нахождение треугольника с наибольшим числом заданных точек');
repeat
write ('Введите число точек = ');
readln (n);
if (n<3) or (n>100) then
writeln ('Неверное число');
until (n>=3) and (n<=100);
writeln ('Введите координаты точки');
for i:=1 to n do
begin
write ('Введите абсциссу ',i,' точки = ');
readln (X[i]);
write ('Введите ординату ',i,' точки = ');
readln (Y[i]);
end;
pr:=false;
C:=0;
for i:=1 to (n-2) do
for j:=i+1 to (n-1) do

for k:=j+1 to n do
begin
s[1]:=dl(X[i],X[j],Y[i],Y[j]);
s[2]:=dl(X[i],X[k],Y[i],Y[k]);
s[3]:=dl(X[j],X[k],Y[j],Y[k]);
if (s[1]<s[2]+s[3]) and (s[2]<s[1]+s[3]) and (s[3]<s[1]+s[2]) then
begin

A:=0;
for m:=1 to n do
begin
W[1]:=plo(dl(X[m],X[i],Y[m],Y[i]),dl(X[m],X[k],Y[m],Y[k]),dl(X[i],X[k],Y[i],Y[k]));
W[2]:=plo(dl(X[m],X[i],Y[m],Y[i]),dl(X[m],X[j],Y[m],Y[j]),dl(X[i],X[j],Y[i],Y[j]));
W[3]:=plo(dl(X[m],X[j],Y[m],Y[j]),dl(X[m],X[k],Y[m],Y[k]),dl(X[j],X[k],Y[j],Y[k]));
W[4]:=plot(dl(X[i],X[j],Y[i],Y[j]),dl(X[j],X[k],Y[j],Y[k]),dl(X[i],X[k],Y[i],Y[k]));
L:=W[1]+W[2]+W[3]-W[4];
if abs(L)<=B then
A:=A+1;
end;
if A>=C then
begin
C:=A;
TR[1,1]:=X[i];
TR[1,2]:=Y[i];
TR[2,1]:=X[j];
TR[2,2]:=Y[j];
TR[3,1]:=X[k];
TR[3,2]:=Y[k];


pr:=true;
end;
end;
end;
if pr then
begin
writeln ('Вершины искомого треугольника:');
for i:=1 to 3 do
writeln ('(',TR[i,1],',',TR[i,2],')');
end
else
writeln ('Построить треугольник нельзя');
end.

Temka
08.01.2008, 19:31
Помогите решить задачку пожалуйсто кому не тяжело буду очень благодарен!!!
1.Масса 8 литров бензина 5,68 кг. Цистерна имеет объем 500 м3. Хватит ли ее, чтобы вместить А т бензина?:confused:

Настенька
25.03.2008, 20:02
Уважаемые!На вас надежда!помогите маленькой девочке написать программку с помощью Паскаля! Вот условие :Написать программу,которая проверяет,является ли введенная с клавиатуры квадратная матрица магическим квадратом.
Магическим квадратом называется матрица,сумма элементов которой в каждой строке,в каждом столюце и диагонали одинакова.
294 13 8 12 1
753 2 11 7 14
618 3 10 6 15
16 5 9 4

Настенька
25.03.2008, 20:02
блин ,квадраты не получились ))

drummer
25.03.2008, 22:25
var a:array[1..100,1..100] of longint;
i,j,s1,s2,s,n:longint;

procedure input;
begin
readln(n);
for i:=1 to n do
for j:=1 to n do
read(a[i,j]);
end;

procedure init;
begin
s:=0;s1:=0;s2:=0;
end;

procedure output(s:string);
begin
writeln(s);
readln;
halt;
end;

procedure solve;
begin
for i:=1 to n do
inc(s,a[i,i]);
for i:=1 to n do
inc(s1,a[i,n-i+1]);
if s1<>s then output('NO!');
for i:=1 to n do
begin
s1:=0;s2:=0;
for j:=1 to n do
begin
inc(s1,a[i,j]);
inc(s2,a[j,i]);
end;
if (s<>s1)or(s<>s2) then output('NO!');
end;

end;

begin
input;
init;
solve;
output('YES!');
end.

Хыиуду
26.03.2008, 11:25
Помогите решить задачку пожалуйсто кому не тяжело буду очень благодарен!!!
1.Масса 8 литров бензина 5,68 кг. Цистерна имеет объем 500 м3. Хватит ли ее, чтобы вместить А т бензина?:confused:
writeln(A/5.68*8>=500)

Вот такое простое решение - а это уже мой тысячный пост на форуме ;)

Настенька
28.03.2008, 16:06
Скажите пожалуйста а вот эта задача что вы написали это что за задача? не моя ли ??

Serge_Bliznykov
29.03.2008, 10:21
Настенька, а в чём собственно проблема?
ну делаете несколько циклов: сумма по строчкам, сумма по столбцам и сумма по диагоналям (по двум - главной и побочной).
Вначале считаете сумму по чему-то одному (ну, например, по главной диагонале.
или по первой строчке) запоминаете эту полученную сумму.
и потом в цикле проверяет, если сумма подсчитанная не совпала с первой - сразу выход - квадрат НЕ МАГИЧЕСКИЙ, иначе, если все циклы/проверки прошли - то магический. Кстати, это очень удобно оформить в виде функции, ну,
type MyArray = array[1..N] of integer;
что-то вроде function is_magican_square(A:MyArray):boolean;

в чём у вас сложность то?!?!

Настенька
03.04.2008, 09:35
Настенька, а в чём собственно проблема?
ну делаете несколько циклов: сумма по строчкам, сумма по столбцам и сумма по диагоналям (по двум - главной и побочной).
Вначале считаете сумму по чему-то одному (ну, например, по главной диагонале.
или по первой строчке) запоминаете эту полученную сумму.
и потом в цикле проверяет, если сумма подсчитанная не совпала с первой - сразу выход - квадрат НЕ МАГИЧЕСКИЙ, иначе, если все циклы/проверки прошли - то магический. Кстати, это очень удобно оформить в виде функции, ну,
type MyArray = array[1..N] of integer;
что-то вроде function is_magican_square(A:MyArray):boolean;

в чём у вас сложность то?!?!

Сложность в том что я в этом деле полный ноль...вот и ищу помощи у опятных людей

Хыиуду
03.04.2008, 10:47
Сумма элементов i-й строки
for j:=1 to 5 do sum:=sum+a[i,j]
Сумма элементов j-го столбца
for i:=1 to 5 do sum:=sum+a[i,j]
Сумма элементов главной диагонали
for i:=1 to 5 do sum:=sum+a[i,i]
Сумма элементов побочной диагонали
for i:=1 to 5 do sum:=sum+a[i,6-i]
Считайте, сравнивайте

Desos777
11.10.2008, 10:06
Помогите пожалуйста,у меня две проблемы...точнее задачи,если не сложно,через for
y= 0,x<=0
sqr(x)-x, 0<x<=1
sqr(x)-sin(pi)x*x-1
и
y= x*x, x>-5
x/2, x<=-5
Заранее благодарен

Хыиуду
11.10.2008, 12:10
Desos777, и в чем состоит задача?

Desos777
11.10.2008, 12:17
Хыиуду Решить ее,тоесть вводить число и получать ответ.

Desos777
12.10.2008, 16:05
Решите кто-нибудь,плиз,уже 3 дня жду.

Хыиуду
18.10.2008, 13:25
Я не вижу задачи. Есть некий набор математических выражений, есть некий набор условий. Задачи нет.

flash1989
03.11.2010, 17:26
Пиши, сделаю
icq: 588002847
email: flash_1989@ukr.net

Sheka
03.11.2010, 23:48
Сделаю. 255507394