var x: array[1..3, 1..30] of integer;
y: array[1..3, 1..30] of integer;
i, k, n, m: integer;
q1, q2, q3, q4: integer;
function Quarter(x, y: integer): integer;
begin
if (x>=0)and(y>=0) then Quarter := 1;
if (x<=0)and(y>=0) then Quarter := 2;
if (x<=0)and(y<=0) then Quarter := 3;
if (x>=0)and(y<=0) then Quarter := 4;
end;
function Triangle(x1, y1, x2, y2, x3, y3: integer): integer;
begin
if (Quarter(x1, y1)=Quarter(x2, y2))and(Quarter(x2, y2)=Quarter(x3, y3)) then
Triangle := Quarter(x1, y1)
else Triangle := -1;
end;
begin
write('Введите кол-во треугольников: '); readln(n);
for i:=1 to n do
begin
writeln('Введите ', i, 'треугольник: ');
writeln('1ая точка');
readln(x[1, i], y[1, i]);
writeln('2ая точка');
readln(x[2, i], y[2, i]);
writeln('3я точка');
readln(x[3, i], y[3, i]);
end;
q1 := 0;
q2 := 0;
q3 := 0;
q4 := 0;
for i:=1 to n do
begin
k := Triangle(x[1, i], y[1, i], x[2, i], y[2, i], x[3, i], y[3, i]);
if k = 1 then Inc(q1);
if k = 2 then Inc(q2);
if k = 3 then Inc(q3);
if k = 4 then Inc(q3);
end;
writeln(q1:3, q2:3, q3:3, q4:3);
end.
[Pascal]Подсчет треугольников лежащих в каждой коорд четверти
Сама Задача такова:
Пусть дано п треугольников. Посчитать кол-во треугольников, лежащих в каждой коорд четверти и не пересекающих оси координат. Используйте функцию для определения коорд четверти, в которой лежит треугольник.
Вот мой первый вариант (отвергнутый преподом):
Вот с изменениями (по совету преподавателя), но не доделал (сомневаюсь как писать):
Здесь, как я понимаю нужно заполнить массив, состоящий из четвертей (type TCount) числом треугольников, но как сделать проходку я не знаю.
+напечатать массив (плиз)
Помогите! Если можно сегодня (25.04.2007). Заранее Спасибо!
_____________
И в голове должны быть мышцы!
Пусть дано п треугольников. Посчитать кол-во треугольников, лежащих в каждой коорд четверти и не пересекающих оси координат. Используйте функцию для определения коорд четверти, в которой лежит треугольник.
Вот мой первый вариант (отвергнутый преподом):
Код:
Вот с изменениями (по совету преподавателя), но не доделал (сомневаюсь как писать):
Код:
const n=2;
type
TPoint = array ['x'..'y'] of integer;
TTriangle = array [1..3] of TPoint;
TMas = array [1..n] of TTriangle;
TCount = array [1..4] of integer;
var
t:ttriangle;
a:TMas;
i, k: integer;
{ввод точек}
procedure REadPoint (var p : Tpoint);
var i : char;
begin
for i:='x' to 'y' do
begin
write(i,'=');
readln(p);
end;
end;
{ввод треугольникa}
procedure REadTriangle (var t : TTriangle);
var i : integer;
begin
for i:=1 to 3 do
REadPOint(t)
end;
procedure ReadMas (var a:TMas);
var i:integer;
begin
for i:=1 to n do
Readtriangle(a);
end;
{функция определения коорд четверти}
function Quarter(p : TPoint): integer;
var m:integer;
begin
if (p['x']>=0)and(p['y']>=0) then m := 1;
if (p['x']<=0)and(p['y']>=0) then m := 2;
if (p['x']<=0)and(p['y']<=0) then m := 3;
if (p['x']>=0)and(p['y']<=0) then m := 4;
quarter:=m;
end;
{проверка принадлежности}
function Triangle(T:TTriangle): integer;
begin
i := Quarter(T[1]);
if (Quarter(T[2])=i) and (Quarter(T[3])=i) then
Triangle := Quarter(T[1])
else Triangle := 0;
end;
begin {main}
{обращение к русскому языку}
setconsoleCp(1251);
setconsoleOutputCp(1251);
{ввод}
readmas(a);
readln;
end.
type
TPoint = array ['x'..'y'] of integer;
TTriangle = array [1..3] of TPoint;
TMas = array [1..n] of TTriangle;
TCount = array [1..4] of integer;
var
t:ttriangle;
a:TMas;
i, k: integer;
{ввод точек}
procedure REadPoint (var p : Tpoint);
var i : char;
begin
for i:='x' to 'y' do
begin
write(i,'=');
readln(p);
end;
end;
{ввод треугольникa}
procedure REadTriangle (var t : TTriangle);
var i : integer;
begin
for i:=1 to 3 do
REadPOint(t)
end;
procedure ReadMas (var a:TMas);
var i:integer;
begin
for i:=1 to n do
Readtriangle(a);
end;
{функция определения коорд четверти}
function Quarter(p : TPoint): integer;
var m:integer;
begin
if (p['x']>=0)and(p['y']>=0) then m := 1;
if (p['x']<=0)and(p['y']>=0) then m := 2;
if (p['x']<=0)and(p['y']<=0) then m := 3;
if (p['x']>=0)and(p['y']<=0) then m := 4;
quarter:=m;
end;
{проверка принадлежности}
function Triangle(T:TTriangle): integer;
begin
i := Quarter(T[1]);
if (Quarter(T[2])=i) and (Quarter(T[3])=i) then
Triangle := Quarter(T[1])
else Triangle := 0;
end;
begin {main}
{обращение к русскому языку}
setconsoleCp(1251);
setconsoleOutputCp(1251);
{ввод}
readmas(a);
readln;
end.
Здесь, как я понимаю нужно заполнить массив, состоящий из четвертей (type TCount) числом треугольников, но как сделать проходку я не знаю.
+напечатать массив (плиз)
Помогите! Если можно сегодня (25.04.2007). Заранее Спасибо!
_____________
И в голове должны быть мышцы!
ну так вы уже сами написали все необходимое
осталось использовать
осталось использовать
Код:
var x:Tcount; p:integer;
-----
for i:=1 to 4 do x:=0;
for i:=1 to n do{по всем треугольникам}
begin
p:=triangle(a);
if p>0 then x:=x+1
end
-----
for i:=1 to 4 do x:=0;
for i:=1 to n do{по всем треугольникам}
begin
p:=triangle(a);
if p>0 then x:=x+1
end
Да, как-то сам вот с этим: p:=triangle(a) протупил. Спасибо, Nilbog теперь всё работает!
вообще то можно было сделать еще проще
одна строчка :) - только массив счетчик нужно начинать с нуля - тогда в x[0] у нас накопяться пересекающие оси треуг
Код:
for i:=1 to n do inc(x[triangl(a)])
одна строчка :) - только массив счетчик нужно начинать с нуля - тогда в x[0] у нас накопяться пересекающие оси треуг
*alt, [COLOR=red]если будешь называть темы подобным образом или нарушать другие правила форума - буду удалять темы без предупреждения. советую ознакомиться с правилами раздела(см. прикрепленные сверху данного раздела темы).[/COLOR]
Цитата: OlgaKr
*alt, [COLOR=red]если будешь называть темы подобным образом или нарушать другие правила форума - буду удалять темы без предупреждения. советую ознакомиться с правилами раздела(см. прикрепленные сверху данного раздела темы).[/COLOR]
Правила я читал, но не знал как по другому назвать сию тему. ПроШу не сердиться - исправлюсь!
Я, короче, так зарубил, Думаю пойдет:
Код:
const n=4;
type
TPoint = array ['x'..'y'] of integer;
TTriangle = array [1..3] of TPoint;
TMas = array [1..n] of TTriangle;
TCount = array [1..4] of integer;
var x:tcount;
a:TMas;
i: integer;
{ввод точек}
procedure REadPoint (var p : Tpoint);
var i : char;
begin
for i:='x' to 'y' do
begin
write(i,'=');
readln(p);
end;
end;
{ввод треугольникa}
procedure REadTriangle (var t : TTriangle);
var i : integer;
begin
for i:=1 to 3 do
REadPOint(t)
end;
procedure ReadMas (var a:TMas);
var i:integer;
begin
for i:=1 to n do
Readtriangle(a);
end;
{функция определения коорд четверти}
function Quarter(p : TPoint): integer;
var m:integer;
begin
if (p['x']>=0)and(p['y']>=0) then m := 1;
if (p['x']<=0)and(p['y']>=0) then m := 2;
if (p['x']<=0)and(p['y']<=0) then m := 3;
if (p['x']>=0)and(p['y']<=0) then m := 4;
quarter:=m;
end;
{проверка принадлежности}
function Triangle(T:TTriangle): integer;
begin
i := Quarter(T[1]);
if (Quarter(T[2])=i) and (Quarter(T[3])=i) then
Triangle := Quarter(T[1])
else Triangle := 0;
end;
procedure count(var x:tcount; a:Tmas);
var p,i:integer;
begin
for i:=1 to 4 do x:=0;
for i:=1 to n do{по всем треугольникам}
begin
p:=triangle(a);
if p>0 then x:=x+1
end;
end;
begin {main}
writeln ('Введите координаты треугольников: ');
readmas(a);
count(x,a);
Writeln ('Кол-во треугольников по четвертям:');
for i:=1 to 4 do
writeln(x) ;
readln;
end.
type
TPoint = array ['x'..'y'] of integer;
TTriangle = array [1..3] of TPoint;
TMas = array [1..n] of TTriangle;
TCount = array [1..4] of integer;
var x:tcount;
a:TMas;
i: integer;
{ввод точек}
procedure REadPoint (var p : Tpoint);
var i : char;
begin
for i:='x' to 'y' do
begin
write(i,'=');
readln(p);
end;
end;
{ввод треугольникa}
procedure REadTriangle (var t : TTriangle);
var i : integer;
begin
for i:=1 to 3 do
REadPOint(t)
end;
procedure ReadMas (var a:TMas);
var i:integer;
begin
for i:=1 to n do
Readtriangle(a);
end;
{функция определения коорд четверти}
function Quarter(p : TPoint): integer;
var m:integer;
begin
if (p['x']>=0)and(p['y']>=0) then m := 1;
if (p['x']<=0)and(p['y']>=0) then m := 2;
if (p['x']<=0)and(p['y']<=0) then m := 3;
if (p['x']>=0)and(p['y']<=0) then m := 4;
quarter:=m;
end;
{проверка принадлежности}
function Triangle(T:TTriangle): integer;
begin
i := Quarter(T[1]);
if (Quarter(T[2])=i) and (Quarter(T[3])=i) then
Triangle := Quarter(T[1])
else Triangle := 0;
end;
procedure count(var x:tcount; a:Tmas);
var p,i:integer;
begin
for i:=1 to 4 do x:=0;
for i:=1 to n do{по всем треугольникам}
begin
p:=triangle(a);
if p>0 then x:=x+1
end;
end;
begin {main}
writeln ('Введите координаты треугольников: ');
readmas(a);
count(x,a);
Writeln ('Кол-во треугольников по четвертям:');
for i:=1 to 4 do
writeln(x) ;
readln;
end.
Цитата: *alt
Правила я читал, но не знал как по другому назвать сию тему.
просто вынеси в название основную цель(суть) задачи, как я и сделала. это делается для удобства людей, которые помагают и вообще для порядка. зачем заходить в тему, если не знаешь ответ или нет желания отвечать на определенные вопросы.
alt
замечание - лучше всегда если возможно передавайте массив по ссылке
замечание - лучше всегда если возможно передавайте массив по ссылке
Код:
procedure count(var x:tcount;var a:Tmas);