К сегодняшней лекции: программа, которая делает n-й бит числа равным 1
begin
var a:=ReadInteger('Введите а');
var n:=ReadInteger('Введите номер бита, который должен быть заменён на 1');
a:= a or (1 shl (n-1);
Writeln(a);
end.(1 курс ФИИТ) ОП - лекц - 2015 (устарело)
Romanovsky
#23
Haku
#24
Вариант решения домашней задачи о проверки нахождения точки внутри треугольника: (Можно ли его упростить?)
function Side(x1, y1, x2, y2: integer): real; begin result := sqrt(sqr(x2 - x1) + sqr(y2 - y1)); end;
function Area(a, b, c: real): real; begin var p: real; p := (a + b + c) / 2; result := sqrt(p * (p - a) * (p - b) * (p - c)); end;
begin writeln(‘Введите координаты точек A,B,C,M:’); var xa, ya, xb, yb, xc, yc, xm, ym: integer; readln(xa, ya, xb, yb, xc, yc, xm, ym); var ac := Side(xa, ya, xc, yc); //Находим стороны треугольников var bc := Side(xb, yb, xc, yc); var ab := Side(xa, ya, xb, yb); var am := Side(xa, ya, xm, ym); var bm := Side(xb, yb, xm, ym); var cm := Side(xc, yc, xm, ym); Write('Точка М '); if (Area(am, bm, ab) + Area(bm, bc, cm) + Area(ac, cm, am)) <> Area(ab, ac, bc) then Write('не '); Write('лежит внутри треугольника '); end.
Haku
#26
Тогда ветка if не выполняется,и ответ выводится без “не”, т.е. “Точка М лежит внутри треугольника”. Или ты спрашиваешь о чем-то другом?
Ilya
#29
но он не всегда верно работает, например я ввел точку, которая лежит на стороне треугольника и алгоритм написал, что она не лежит внутри
Ilya
#31
я тоже думаю, что из-за этого, кстати я ввел точку внутри теугольника(не на стороне) и он все равно сказал что она не лежит внутри
Haku
#32
Тоже так получилось в этот раз. Но как его изменить? Если округлить, то площади тоже могут получиться разными.
Ilya
#34
задача, которая определяет, является ли четырех-угольник соответствующим условию задачи. (невыпуклый тоже считается требуемым)
//в данном решении выбирается прямые , на которых лежат 1 и 3 точки,2 и 4 , вычиcляется их k и b
//затем по уравнению расстояния от точки до прямой вычисляется,
//с какой стороны прямой лежат 2 другие точки, и на основании этого дается ответ
begin
var x1, x2, x3, x4, y1, y2, y3, y4: real;
var k, k2, b, b2: real;
var t1: boolean = false;
var t2: boolean = false;
writeln('введите координаты точек 4-угольника');
readln(x1, y1, x2, y2, x3, y3, x4, y4);
//1 сторона(AC) и проверка точек B и D
if x3 <> x1 then
begin
k := (y3 - y1) / (x3 - x1);
b := y1 - k * x1;
t1 := (sign( (-1)*k*x2 + y2 - b ) = (-1) * sign( (-1)*k*x4 + y4 - b ) );
end
else
t1 := ((x2 > x1) = (x4 < x1));
//2 сторона (BD) и проверка точек A и C
if x2 <> x4 then
begin
k2 := (y4 - y2) / (x4 - x2);
b2 := y2 - k * x2;
t2 := (sign( (-1)*k2*x1+y1-b2) = (-1) * sign( (-1)*k2*x3 + y3 - b2) );
end
else
t2 := ((x3 > x2) = (x1 < x2));
if t1 or t2 then
writeln('это 4-угольник')
else
writeln('это не 4-угольник');
end.
Haku
#35
Вот мое решение второй задачи. Делала через косинусы углов. Но решение не всегда получается правильным. В чем моя ошибка?
function Side(x1, y1, x2, y2: integer): real; begin result := sqrt(sqr(x2 - x1) + sqr(y2 - y1)); end;
function Cosin(x1, x2, y1, y2, x3, y3: integer; a, b: real): real; begin result := ((x2 - x1) * (x3 - x1) + (y2 - y1) * (y3 - y1)) / (a * b); end;
begin writeln(‘Введите координаты точек A,B,C,D:’); var xa, ya, xb, yb, xc, yc, xd, yd: integer; readln(xa, ya, xb, yb, xc, yc, xd, yd); var ad := Side(xa, ya, xd, yd); //Находим стороны фигуры var bc := Side(xb, yb, xc, yc); var ab := Side(xa, ya, xb, yb); var cd := Side(xc, yc, xd, yd); var a := Cosin(xa, ya, xb, yb, xd, yd, ad, ab); //находим косинусы углов var b := Cosin(xb, yb, xc, yc, xa, ya, bc, ab); var c := Cosin(xc, yc, xb, yb, xd, yd, cd, bc); var d := Cosin(xd, yd, xc, yc, xa, ya, ad, cd); if (a > 0) and (b > 0) and (c > 0) and (d > 0) then writeln(‘Не является четырехугольником’) else if (a = 0) and (b = 0) and (c = 0) and (d = 0) then writeln(‘Является четырехугольником’) else if a * b * c * d = 0 then writeln(‘Не является четырехугольником’) else write(‘Является четырехугольником’); end.
Ilya
#39
если у тебя хотя бы 1 угол прямой(cos=0) ,например в прямой трапеции то в последнем if выполняется первая ветка. к тому же можно построить не четырех угольник с тупым или 2 тупыми углами, и тогда первое условие не выполнится
// анал геом посвящается следущая программа, т.к. идея с площадами была нещадно украдена // за два часа, как я до не додумался, то вот следующий алгоритм, но пока не полный, чуть позже, мб, доделаю
function find_x_y (xm, ym, x, y, x1, y1, x2, y2, ixmin, iymin, ixmax, iymax: real): boolean; //с начала нахождение точки пересечения с двумя прямыми (основания (пусть верш 1, 2) и прям( m и 3 верш)) begin// потом смотрит находится ли точка в треугольнике(соответствует ixmin, iymin. ixmax iymax) var k,k1, xfunc, yfunc:real; k:=(y1-y)/(x1-x); k1:=(ym-y2)/(xm-x2);
xfunc:=(kx-k1x+y2-y)/(k-k1); yfunc:=y2+k1*(xfunc-x2);
if (xfunc>=ixmin) and (xfunc<=ixmax) and (yfunc>=iymin) and (yfunc<=iymax) then find_x_y:= True else find_x_y:=False; end;
function find_x_y1 (xm, ym, x, y, x1, y1, x2, y2, ixmin, iymin, ixmax, iymax: real): boolean; //с начала нахождение точки пересечения с двумя прямыми (основания (пусть верш 1, 2) и прям( m и 3 верш)) begin// потом смотрит находится ли точка в треугольнике(соответствует ixmin, iymin. ixmax iymax) var k,k1, xfunc, yfunc:real; k:=(y2-y)/(x2-x); k1:=(ym-y1)/(xm-x1);
xfunc:=(k1x1-kx+y-y1)/(k1-k); yfunc:=y1+k1*(xfunc-x1);
if (xfunc>=ixmin) and (xfunc<=ixmax) and (yfunc>=iymin) and (yfunc<=iymax) then find_x_y1:= True else find_x_y1:=False; end;
var ix, iy, x, y: array of real; begin SetLength(x, 3); SetLength(iy, 3); SetLength(y, 3); SetLength(ix, 3); writeln(‘Введите координаты точек треугольника, такие, что их ординаты не равны и абсциссы тоже’); for var i:=0 to 2 do begin readln(x[i], y[i]); ix[i]:=x[i]; iy[i]:=y[i]; end;
var a:=sqrt(sqr(x[0]-x[1])+sqr(y[0]-y[1])); var b:=sqrt(sqr(x[0]-x[2])+sqr(y[0]-y[2])); var c:=sqrt(sqr(x[2]-x[1])+sqr(y[2]-y[1])); var bo:=(a+b>c) and (a+c>b) and (c+b>a);
if (x[0]<>x[1]) and (x[2]<>x[1]) and (x[0]<>x[2]) and (y[0]<>y[1]) and (y[2]<>y[1]) and (y[0]<>y[2]) then if bo then begin sort(iy); sort(ix); var xm:=readreal(‘Введите абсциссу точки M, такую, чтобы xm<>x1,x2,x3’); var ym:=readreal(‘Введите ординату точки M, такую, чтобы ym<>y1,y2,y3’);
if (xm<>x[1]) and (xm<>x[2]) and (xm<>x[0]) and (ym<>y[1]) and (ym<>y[2]) and (ym<>y[0]) then
if (xm<ix[0]) or (xm>x[2]) or (ym<y[0]) or (ym>y[2]) then writeln('Точка вне треугольника') else
begin writeln('Теперь приступим к анал геом!');
if find_x_y1(xm, ym, x[0], y[0], x[1], y[1], x[2], y[2], ix[0], iy[0], ix[2], iy[2]) and find_x_y(xm, ym, x[0], y[0], x[1], y[1], x[2], y[2], ix[0], iy[0], ix[2], iy[2]) then
writeln ('Точка лежит в треугольнике! или на границе, кто знает?!')
else writeln('ДАже анал геом не помогла этой точке лежать в треугольнике или на границе, это фейл');
end
else writeln('Вы печалити меня')
end
else writeln('Вы не прошли защиту от дураков..')
else writeln(‘Уныние - страшный грех, лучше встанте из-за компьютера и пробежитесь кружок вокруг вашего микрорайона/города’);
end.
Есть небольшой фейл( насчет функций ), они обе соответсвуют друг другу, просто там идут некоторые вычисления, и очень сильно лень копаться, где должне быть какой параметр, а вообще можно обойтись одной, но трудно
Ilya
#43
моя программа на определение того, лежит ли точка внутри треугольника, на его стороне, или вне его
программа основана на формуле нахождения расстояния от точки до прямой. Сначала определяется ,
с какой стороны прямых, на которой лежат стороны треугольника лежит наша точка.
для этого мы берем точку внутри треугольника,
которой является ее центр, и сравниваем, лежат ли точка M и средняя точка по одну и
ту же сторону от прямых. Если это условие выполняется для всех сторон, то точка внутри.
Так как если точка лежит на стороне, то при подстановке ее координат в уравнение прямой
должен получаться 0.
function Side(k, b, x, y: real): real;
begin
result := (-1) * k * x + y - b;
end;
var
x1, x2, x3, y1, y2, y3, xm, ym: real;
k1, k2, k3, b1, b2, b3, xsr, ysr: real;
equ1, equ2, equ3, Nast: boolean;
begin
writeln('введите координаты точек треугольника');
readln(x1, y1, x2, y2, x3, y3);
writeln('введите координаты точки m');
readln(xm, ym);
equ1 := false;
equ2 := false;
equ3 := false;
Nast := false;
xsr := (x1 + x2 + x3) / 3;
ysr := (y1 + y2 + y3) / 3;
if x2 <> x1 then
begin
k1 := (y2 - y1) / (x2 - x1);
b1 := y1 - k1 * x1;
equ1 := (Sign(Side(k1, b1, xm, ym)) = Sign(Side(k1, b1, xsr, ysr)) );
end
else
if (xm = x1) and (ym <= max(y2, y1)) and (ym >= min(y2, y1))then //если прямая вертикальная
Nast := true
else
equ1 := Sign(xm - xsr) = Sign(x1 - xsr);
if x2 <> x3 then
begin
k2 := (y3 - y2) / (x3 - x2);
b2 := y2 - k2 * x2;
equ2 := (Sign(Side(k2, b2, xm, ym)) = Sign(Side(k2, b2, xsr, ysr)) );
end
else
if (xm = x2) and (ym <= max(y3, y2)) and (ym >= min(y3, y2)) then
Nast := true
else
equ2 := Sign(xm - xsr) = Sign(x2 - xsr);
if x3 <> x1 then
begin
k3 := (y3 - y1) / (x3 - x1);
b3 := y3 - k3 * x3;
equ3 := (Sign(Side(k3, b3, xm, ym)) = Sign(Side(k3, b3, xsr, ysr)) );
end
else
if (xm = x3) and (ym <= max(y3, y1)) and (ym >= min(y3, y1)) then
Nast := true
else
equ3 := (Sign(xm - xsr) = Sign(x3 - xsr));
if Nast or (Side(k1, b1, xm, ym) = 0) or (Side(k2, b2, xm, ym) = 0)
or (Side(k3, b3, xm, ym) = 0) then
writeln('точка лежит на стороне треугольника')
else
if equ1 and equ2 and equ3 then
writeln('точка лежит внутри треугольника')
else
writeln('точка лежит вне треугольника');
end.
je_day
#44
Задача о нахождении точки внутри и на сторонах заданного треугольника. Программа определяет нахождение точки, если точка и вершина треугольника находятся на одной строне от противолежащей стороны(правильность такого условия для трех сторон гаранитирует нахождение точки в пределах треугольника).
var a,x1,x2,x3,y1,y2,y3,x,y:real;
f1:boolean;
function sides(x,y,x1,y1,x2,y2:real):real;
begin
result:=(y1-y2)/(x1-x2)*(x-x1)+(y1-y);
end;
begin
writeln('x,y');
readln(x,y);
writeln('x1,y1');
readln(x1,y1);
writeln('x2,y2');
readln(x2,y2);
writeln('x3,y3');
readln(x3,y3);
a:=sides(x,y,x1,y1,x2,y2);
f1:=(a*sides(x3,y3,x1,y1,x2,y2)>=0);// для стороны x1y1_x2y2
f1:=f1 and ((a*sides(x1,y1,x3,y3,x2,y2))>=0); // для стороны x3y3_x2y2
f1:=f1 and ((a*sides(x2,y2,x3,y3,x1,y1))>=0); // для стороны x3y3_x1y1
writeln('Точка в треугольнике:',f1);
end.
x,y 0.5 0.5 x1,y1 0 0 x2,y2 1 2 x3,y3 2 1 Точка в треугольнике:False x,y 0 0 x1,y1 2 1 x2,y2 1 2 x3,y3 0.5 0.5 Точка в треугольнике:False
не стал разбираться какая именно точка m (из х и y или x3 и y3), но точка 0,5 0,5 лежит в этом треугольнике, что можно проверить на графике, кстати, меня тоже не работает, так чт о не расстраивайся!