/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Выпуск № 460
от 07.10.2007, 10:35

Вопрос № 103.940

Помогите, пожалуйста написать программу в PASCAL: Дан теугогльник, полученный припересечении прямых a1x+b1y+c1=0, a2x+b2y+c2=0, a3x+b3y+c3=0 вершины треугольника A(x1,y1) B (x2,y2) C (x3,y3) Надо определить находится ли точка D (x4,y4) внутри треугольника Все координаты- натуральные числа.

Отправлен: 01.10.2007, 18:34 Вопрос задала: Byzly (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Verena Здравствуйте, Byzly! Из вашего условия не очень понятно, даны ли вершины треугольника в виде точек, или их надо искать, исходя из данных прямых. Я написала код для заданных точек, но, если их необходимо найти, это несложно сделать - просто выделить формулы для x и y, приравнивая прямые, и вычислить координаты программно. Проверить, находится ли точка внутри треугольника, заданного своими вершинами, можно используя следующую формулу: r = (y - y0) (x1 - x0) - (x - x0) (y1 - y0) , где x, y - координаты заданой точки, а x0, y0, x1, y1 - координаты двух соседних вершин треугольника (например, A(x1,y1) и B (x2,y2) в Вашем примере). Если точка лежит внутри треугольника, r < 0 для всех сторон. Если хоть для одной стороны r < 0, точка лежит вне треугольника. Если r=0, точка лежит на стороне. В случае треугольника это довольно просто, но можно использовать и для любого полигона. Реализацию смотрите в приложении. Удачи! Приложение: var r, i: integer ; x: array [1..4] of word; {координаты вершин и заданной точки по х} y: array [1..4] of word;{координаты вершин и заданной точки по у} begin for i:=1 to 4 do begin writeln; {ввод вершин треугольника и заданной точки} {(точка для проверки - последняя} read (x[i], y[i]); {вводить можно в виде 1 2, если х=1, а у=2} end; for i:=1 to 3 do {проверяем r для всех сторон} begin if i=3 then {отдельно проверяем, не последняя ли это сторона} r:= (y[4]-y[i])*(x[i-2]-x[i]) - (x[4]-x[i])*(y[i-2]-y[i]) else r:= (y[4]-y[i])*(x[i+1]-x[i]) - (x[4]-x[i])*(y[i+1]-y[i]); if r>=0 then break; {если условие не выполнилось - прервём цикл} end; if r<0 then writeln ('Точка лежит внутри треугольника') else if r>0 then writeln ('Точка не лежит внутри треугольника') else writeln ('Точка лежит на одной из сторон треугольника'); end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Студент) Ответ отправлен: 01.10.2007, 20:33

Вопрос № 103.944

Здравствуйте! Помогите написать программу: Для одномерного массива длиной N целых чисел составить двухмерный и трёхмерный массив. Наибольшие значение индексов каждого из массивов должны быть равны. Сообщить индексы свободных мест.

Отправлен: 01.10.2007, 19:10 Вопрос задал: Alex_timonov (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Витек Здравствуйте, Alex_timonov! кажется все правильно, единственное используются статичные массивы, нет времени написать и проверить с динамичными. послезавтра буду посвободней, пиши если надо с динамичными, попробую помочь const nm=100;nm3=20; var mas1:array[1..nm] of integer; mas2:array[1..nm,1..nm] of integer; mas3:array[1..nm3,1..nm3,1..nm3] of integer; k,i,j,n:integer; n3,n2,s:integer; r:real; begin write('Укажите N'); readln(n); writeln('Заполните массив:'); for i:=1 to n do readln(mas1[i]); r:=(exp((1/2)*ln(n))); n2:=round(r); r:=(exp((1/3)*ln(n))); n3:=round(r); if n2*n2<n then inc(n2); if n3*n3*n3<n then inc(n3); write('Двумерный массив ',n2,' на ',n2); s:=0; for i:=1 to n2 do for j:=1 to n2 do begin if n2*(i-1)+j<=n then mas2[i,j]:=mas1[i*(j-1)+j] else writeln('Элемент свободен - ',i,':',j) end; write('Трехмерный массив ',n3,', ',n3,' на ',n3); for i:=1 to n2 do for j:=1 to n2 do for k:=1 to n2 do begin if (n3*n3*(i-1))+n3*(j-1)+k<=n then mas3[i,j,k]:=mas1[i*(j-1)+j] else writeln('Элемент свободен - ',i, ':', j,':', k) end; readln; end. --------- ohne fleis, keine preis

Ответ отправил: Витек (статус: 3-ий класс) Ответ отправлен: 03.10.2007, 13:24

Отвечает: Зенченко Константин Николаевич Здравствуйте, Alex_timonov! Смотрите приложение. Программа формирует N-мерные массивы при выводе. Ввод одномерного массива продолжается до нулевого элемента. Удачи! Приложение: program q103944; var a:packed array[1..200]of integer; b,x,y,z:integer; begin {вводим одномерный массив} z:=0; repeat inc(z); write('enter a[',z,']:'); readln(a[z]); until (a[z]=0)or(z=200); dec(z); {извлекаем корень из введенного количества элементов} b:=round(int(exp(ln(z)/2))); {выводим свободные ячейки} writeln('2-x free:',z-b*b); for x:=1 to b do begin for y:=1 to b do {формируем двухмерный массив} write(a[b*(x-1)+y]:6); writeln; end; {извлекаем корень 3-ей степени из введенного количества элементов} b:=round(int(exp(ln(z)/3))); {выводим свободные ячейки} writeln('3-x free:',z-b*b*b); for x:=1 to b do begin writeln('x:',x); for y:=1 to b do begin for z:=1 to b do {формируем трёхмерный массив} write(a[b*b*(x-1)+b*(y-1)+z]:6); writeln; end; end; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Специалист) Ответ отправлен: 03.10.2007, 17:10

Вопрос № 103.999

Уважаемые эксперты! Помогите, пожалуйста, решить задачи: 1. Дано целое число. Получить из него новое, цифры которого идут в обратном порядке. Определить, какое из чисел больше: исходное или полученное. 2. Дано целое число. Если количество цифр его десятичной записи четно, добавить в средину нуль, если нечетно, удалить среднюю цифру. (Пример: 3218 - 32018, 47369 - 4769). 3. Вводится последовательность чисел, признак окончания - число, оканчивающееся нулем. Подсчитать количество пар взаимно простых чисел. 4. Дана обыкновенная дробь (числитель и знаменатель вводятся как целые числа). Сократить ее, представив результат в виде 24/15 = 8/5. Если это возможно, то в наиболее простом варианте и с комментариями. Заранее огромное спасибо! Swallow.

Отправлен: 02.10.2007, 08:03 Вопрос задала: Ласточка (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Delph Здравствуйте, Ласточка! Предоставляю Вам решение первой и второй задач (другим экспертам кусочек хлеба тоже не помешает) - смотрите приложение. Приложение: { решение первой задачи } Program Pr1; uses CRT; Var a, b, x: Longint; arr: Array[0..11] of Byte; i, n: Byte; Begin ClrScr; n := 0; b := 0; Write('Int a = '); ReadLn(a); x := a; { сохраняем исходное значение a } While a > 0 do begin arr[n] := a mod 10; a := a div 10; inc(n); end; { n получается на 1 больше, чем нужно нам } dec(n); { в массиве цифры уже расположены в обратном порядке, поэтому просто считываем их } for i := 0 to n do b := b * 10 + arr[i]; WriteLn; WriteLn('b = ', b); if x > b then Writeln('a > b') else if x < b then WriteLn('a < b') else WriteLn('a = b'); Repeat Until KeyPressed; End. { решение второй задачи } Program Pr2; uses CRT; Var a, b: Longint; arr: Array[0..11] of Byte; i, n: Byte; Begin ClrScr; n := 0; b := 0; Write('Int a = '); ReadLn(a); if a > 10 then begin While a > 0 do begin arr[n] := a mod 10; a := a div 10; inc(n); end; if (n mod 2 = 0) then begin for i := n downto n div 2 do arr[i] := arr[i - 1]; arr[n div 2] := 0; end else begin for i := n div 2 to n - 2 do arr[i] := arr[i + 1]; arr[n - 1] := 0; if n > 0 then dec(n); end; { в массиве цифры расположены в обратном порядке, поэтому считываем их тоже в обратном порядке } for i := n downto 0 do b := b * 10 + arr[i]; WriteLn; WriteLn('b = ', b); end else WriteLn('b = ', 0); Repeat Until KeyPressed; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: 10-ый класс) Ответ отправлен: 02.10.2007, 09:00 Оценка за ответ: 5 Комментарий оценки: Большое спасибо за помощь, Delph!

Отвечает: Andreev Oleg Здравствуйте, Ласточка! Высылаю решения двух задач: program rusfaq103999; var ch,ch2:longint; st,st2:string; i,cd:integer; begin st2:=''; readln(ch); str(ch,st);{Preobrazuem v stroku} for i:=length(st) downto 1 do st2:=st2+st[i]; val(st2,ch2,cd); write('Vtoroe chislo:',ch2); if ch2>ch then writeln(' bolshe pervogo') else if ch>ch2 then writeln(' menshe pervogo') else writeln(' ravno pervomy') end. program rusfaq103999; var ch:longint; st:string; cd :integer; begin readln(ch); str(ch,st);{Preobrazuem v stroku} if length(st) mod 2 =0 (*deystvuem v zavisimosti ot chetnosti dliny striki*) then st:=copy(st,1,(length(st) div 2)) +'0'+copy(st,length(st)div 2 +1,length(st)) else st:=copy(st,1,(length(st) div 2)) +copy(st,length(st)div 2 +2,length(st)); val(st,ch,cd); writeln(ch) end.

Ответ отправил: Andreev Oleg (статус: Заблокирован) Ответ отправлен: 02.10.2007, 09:04 Оценка за ответ: 5 Комментарий оценки: Большое спасибо за решения, Andreev Oleg!

Отвечает: Зенченко Константин Николаевич Здравствуйте, Ласточка! В приложении 3-я и 4-я задачи. Удачи! Приложение: program q103999c; var b,x,y,z:integer; a:packed array[1..100] of integer; begin z:=0; {цикл ввода} repeat inc(z); write('enter a[',z,']:'); readln(a[z]); until(((a[z] mod 10)=0)or(z=100)); {только для 2 и более чисел} if z>1 then for x:=1 to z-1 do for y:=x+1 to z do begin {ищем меньшее} if a[y]>a[x] then b:=a[x] else b:=a[y]; {цикл поиска делителей} while((((a[x]mod b)>0)or((a[y]mod b)>0))and(b>1)) do begin dec(b); end; {если делителей небыло выводим пару} if b=1 then write(a[x],':',a[y],' '); end; end. program q103999d; var a,b,c:integer; begin {вводим числа} write('enter A:'); readln(a); write('enter B:'); readln(b); {берем наименьшее} if a>b then c:=b else c:=a; {поиск общего делителя} while ((((a mod c)>0)or((b mod c)>0))and(c>1))do begin dec(c); end; {выводим результат} writeln('result:',(a div c),'/',(b div c)); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Специалист) Ответ отправлен: 02.10.2007, 14:46 Оценка за ответ: 5 Комментарий оценки: Большое спасибо вам за решения, Константин Николаевич!

Отвечает: Артём1983 Здравствуйте, Ласточка! Я решил только первые две задачи. Код в приложении. Приложение: {103999_1} uses crt; var a,b,c,d:longint;{-2147483648..2147483647 :-) } i,k:integer; s:string; begin clrscr; write('введите целое число ='); readln(a); if a>0 then begin str(a,s); k:=length(s); c:=a; repeat d:=1; K:=k-1; for i:=k downto 1 do begin d:=d*10; end; b:=b+(c mod 10)*d; c:= trunc((c-(c mod 10))/10); until c=0; writeln('получилось =',b); end else begin str(a,s); k:=length(s)-1; c:=a; repeat d:=1; K:=k-1; for i:=k downto 1 do begin d:=d*10; end; b:=b+(c mod 10)*d; c:= trunc((c-(c mod 10))/10); until c=0; writeln('получилось =',b); end; if b>a then writeln('полученное число больше') else writeln('исходное число больше'); readln; end. {103999_2} uses crt; var a:longint; code:integer; s:string; begin clrscr; write('введите целое число ='); readln(a); str(a,s); if length(s)mod 2=0 then begin insert('0',s,length(s) div 2+1) end else begin delete(s,length(s) div 2+1,1); end; val(s,a,code); writeln(a); readln; end.

Ответ отправил: Артём1983 (статус: 3-ий класс) Ответ отправлен: 03.10.2007, 20:33 Оценка за ответ: 5 Комментарий оценки: Большое спасибо за помощь, Артём1983!

© 2001-2007, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.60.10 от 27.09.2007
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru