Форум «Всё о Паскале» > Задачи:матрица-поиск и сравнение элементов в ней.

Roman

18.12.2003 14:45

Здрасте,
извиняюсь за прошлый топик, надеюсь, что такое название темы более информативно, к сожалению места хватило токо на описание 1 задачки.
Всего их 5 (есть ещё 3, но с их переводом у меня проблемы). Мне очень нужна ваша помощь. Пожалуста,помогите получить допуск к экзамену, а там я на теории вытяну боле менее положительную оценку.

1.Матрица до 20 рядов и 30колонн(вроде так их называют).Найти, есть ли в матрице зона 4*3 где значения элементов равны. Кол рядов и колон вводится пользователем(процедура), поиск одинаковых элементов-функция.
Ввод:

Код

TYPE MAT=ARRAY[1..20,1..30]of real;
VAR N,M:integer;
A:MAT;
Procedure Matvvod(VAR:MAT;VAR RJAD,KOLON:integer);
VAR I,J:integer;
BEGIN
Write(`vvedi kol rjadov`);
readln(RJAD);
Write(`kol kolon`);
readln(KOLON);
for i:=1 to rjad do {спасибо fms}
for j:=1 to KOLON do
read (A[I,J]);
end;

_________________-
2.програма читает из текст фаила слово(до 256 букв)
и:
а)находит кол. повторов заданного 3 значного буквосочетания.
б)сообщает чего больше- гласных или согласных букв.
в)производит замену 2 одинаковых рядом стоящих гласных, написанных с маленкой буквы, на большие(аа=>АА)
Выводит слово в указынное пользователем место и цветом(CRT) на экран.(буквы латинские)
_________________
3. Програма спрашивает у пользователя какоето время и число(не прошедшее) этого года, затем выводит на экран скоко осталось дней, часов,минут до этого момента.
________________
4. Написать модуль и тест програму для него, который позволяет:

октаэдер
http://www.tmn.fio.ru/works/22x/307/oktaed...osaedr_tabl.htm
http://bammako.narod.ru/octaedr.htm
1) ввод граней
2)вычислить площадь 1 стороны
3)объём
4)диогональ
5)полную площадь
_________________
5.написать графическую программу, которая будет геометр. тело (не круг) как можно плавнее двигать по экрану(анимация).

___________
заранее благодарен

oleg309

18.12.2003 20:59

По-моему решать сразу 5 задач в одной теме не реально

trminator

18.12.2003 21:17

Вот первая задача. Но лучше ее хорошо потестировать, а то мало ли... у меня времени почти не было.

Код

TYPE MAT=ARRAY[1..20,1..30]of integer;
VAR N,M : integer;
A : MAT;
i, j : integer;
flag : boolean;
Procedure Matvvod(VAR A:MAT;VAR RJAD,KOLON:integer);
VAR I,J:integer;
BEGIN
Write('vvedi kol rjadov ');
readln(RJAD);
Write('kol kolon ');
readln(KOLON);
for i:=1 to rjad do {спасибо fms}
for j:=1 to KOLON do
read (A[I,J]);
end;

function check(const l, k : integer): boolean;
var i, j : integer;
begin
for i:=k to l+3-1 do
for j:=l to k+4-1 do
if a[i, j] <> a[l, k] then
begin
check:=false; exit
end;
check:=true
end;

begin flag:=false;
Matvvod(A, N, M);
for i:=1 to N-4 do
for j:=1 to M-3 do
if check(i, j) then begin
flag:=true;
break
end;
if flag then write('YES') else write('NO')
end.

Roman

18.12.2003 22:11

спасибо,
вроде работает,а можно объяснить немного,
почему l+3-1 и к+4-1???
for i:=k to l+3-1 do
for j:=l to k+4-1 do
if a[i, j] <> a[l, k] then

trminator

18.12.2003 22:23

А черт знает... если честно, я особо не задумывался - времени .net, без -1 не работало, с ней вроде заработало. По идее, там типа какая-то граница не должна включается в цикле...

2oleg209: а ты не думай, ты решай ;) хотя вообще-то действительно может лучше разделить на разные темы.

Roman

19.12.2003 1:57

Ну, 2 задачку я перекинул в другой топик, или для всех сделаь отдельно?
мне не трудно, но как то неприлично весь форум для себя забирать

_____________________________________

жду ваших предложений для 3,4,5 задачки

Roman

19.12.2003 16:26

Код

program maatr;
type maat=array[1..20,1..30] of real;
var n,m:integer;
a:maat;
i,j:integer;
flag:boolean;
procedure vvod(var a:maat; var rjadi, koloni:integer);
var i,j:integer;
begin
write('rjadi: ');
readln(rjadi);
write('koloni: ');
readln(koloni);
for i:=1 to rjadi do
for j:=1 to koloni do
read(a[i,j]);
end;
function check(const l,k:integer):boolean;
var i,j:integer;
begin
for i:=k to l+3-1 do
for j:=l to k+4-1 do
if a[i,j]<>a[l,k] then
begin
check:=false;
end;
check:=true;
end;
begin flag:=false;
vvod(a,n,m);
for i:=1 to n-4 do
for j:=1 to m-3 do
if check(i,j)then begin
flag:=true;
break
end;
if flag then write('yes')else write('no');
readln;
readln;

end.

не работает(говорит "no" даже если все эл.одинаковы) если матрица 4*4, 4*5 или меньше, начиная с 5*4
5*5... работает.

Roman

19.12.2003 19:11

вот вариант 3 задачки.

Код

program prog3;
uses dos, crt;
var h,h1,m,m1,s,s1,c,d,c1,d1,y,f1,f:word;
sum,sum1,sum2:LongInt;
i,j,k:integer;
z:string;
A:array [1..12] of integer;

function check(s:string; v:integer; u:integer):integer;
var tmp:integer;
begin
val(z,tmp,j);
if j<>0 then writeln('It must be a number');
if ((tmp<v) or (tmp>u)) and (j=0)
then writeln('It must be ',v,'..',u);
check:=tmp;
end;

begin
ClrScr;
GetDate (y,c,d,f);
GetTime (h,m,s,f1);
A[1]:=31;
if (y mod 4)=0 then
A[2]:=29
else A[2]:=28;
A[3]:=31;
A[4]:=30;
A[5]:=31;
A[6]:=30;
A[7]:=31;
A[8]:=31;
A[9]:=30;
A[10]:=31;
A[11]:=30;
A[12]:=31;
writeln ('Enter date.');
repeat
write ('month: ');
readln (z);
c1:=check(z,1,12);
until (c1>=1) and (c1<=12) and (j=0);
repeat
write ('date: ');
readln (z);
d1:=check(z,1,A[c1]);
until (d1>=1) and (d1<=A[c1]) and (j=0);
writeln ('Enter time.');
repeat
write ('hour: ');
readln (z);
h1:=check(z,0,23);
until (h1>=0) and (h1<=23) and (j=0);
repeat
write ('minutes: ');
readln (z);
m1:=check(z,0,59);
until (m1>=0) and (m1<=59) and (j=0);
repeat
write ('seconds: ');
readln (z);
s1:=check(z,0,59);
until (s1>=0) and (s1<=59) and (j=0);
sum:=0;
for i:=1 to c-1 do
sum:=sum+A[i];
sum:=sum+d-1;
sum:=sum*3600*24;
sum:=sum+h*3600+m*60+s;
sum1:=0;
for i:=1 to c1-1 do
sum1:=sum1+A[i];
sum1:=sum1+d1-1;
sum1:=sum1*3600*24+h1*3600+m1*60+s1;
sum2:=Abs (sum1-sum);
d:=sum2 div 86400;
h:=(sum2-d*86400) div 3600;
m:=(sum2-d*86400-h*3600) div 60;
s:=sum2-d*86400-h*3600-m*60;
if sum>sum1
then write ('Time past ',d, ' days ', h, ' hours ', m, ' minutes ', s, ' seconds ')
else write ('Time left ',d, ' days ', h, ' hours ', m, ' minutes ', s, ' seconds ');
readln;
end.

Roman

19.12.2003 19:20

вариант 5 задачки.
может чтото можно упростить, исправить и тд?

Код

program prog5;

uses crt, graph;

var
gd, gm, i, j, n, m : integer;
path : string;
x11, y11, x12, y12,
x22, y22 : integer;

function stepen: boolean;
var
i, d, nr : integer;
begin
d := 1;
randomize;
nr := random(100);
for i := 1 to nr do
begin
d := (0 - 1) * d;
end;
if d > 0 then stepen := true else stepen := false;
end;

begin
gd := 9;
gm := 2;
initgraph(gd, gm, 'c:tpbgi');
i := 320;
j := 250;
x11 := i; y11 := j; x12 := i-50; y12 := j+100;
x22 := i+50; y22 := j+100;
line(x11, y11, x12, y12);
line(x12, y12, x22, y22);
line(x22, y22, x11, y11);

repeat
begin
if stepen then n := 1 else n := -1;
repeat
begin
clearviewport;
x11 := x11 + n;
x12 := x12 + n;
x22 := x22 + n;
y11 := y11 + 1;
y12 := y12 + 1;
y22 := y22 + 1;
line(x11, y11, x12, y12);
line(x12, y12, x22, y22);
line(x22, y22, x11, y11);
end;
until (y12 > 360) or (x12 <160) or (x22 >480) or keypressed;

if y12 >= 359 then
begin
if stepen then n := 1 else n := -1;
repeat
begin
clearviewport;
x11 := x11 - n;
x12 := x12 - n;
x22 := x22 - n;
y11 := y11 - 1;
y12 := y12 - 1;
y22 := y22 - 1;
line(x11, y11, x12, y12);
line(x12, y12, x22, y22);
line(x22, y22, x11, y11);
end;
until (x12 < 160) or (x22 > 480) or keypressed;
end;
if y11 <= 119 then
begin
if stepen then n := 1 else n := -1;
repeat
begin
clearviewport;
x11 := x11 + n;
x12 := x12 + n;
x22 := x22 + n;
y11 := y11 + 1;
y12 := y12 + 1;
y22 := y22 + 1;
line(x11, y11, x12, y12);
line(x12, y12, x22, y22);
line(x22, y22, x11, y11);
end;
until (x12 < 160) or (x22 > 480) or keypressed;
end;
if x12 <= 159 then
begin
if stepen then n := 1 else n := -1;
repeat
begin
clearviewport;
x11 := x11 + 1;
x12 := x12 + 1;
x22 := x22 + 1;
y11 := y11 + n;
y12 := y12 + n;
y22 := y22 + n;
line(x11, y11, x12, y12);
line(x12, y12, x22, y22);
line(x22, y22, x11, y11);
end;
until (y11 < 120) or (y12 > 360) or keypressed;
end;
if x22 >= 479 then
begin
if stepen then n := 1 else n := -1;
repeat
begin
clearviewport;
x11 := x11 - 1;
x12 := x12 - 1;
x22 := x22 - 1;
y11 := y11 + n;
y12 := y12 + n;
y22 := y22 + n;
line(x11, y11, x12, y12);
line(x12, y12, x22, y22);
line(x22, y22, x11, y11);
end;
until (y11 < 120) or (y12 > 360) or keypressed;
end;
end;
until keypressed;
closegraph;
end.

trminator

19.12.2003 21:06

Похоже, что в задаче про матрицу перепутаны местами "ряды" и "колонны"

fms

19.12.2003 22:14

хе.. ряды и колонны эт наверно я перепутала..

извините..

trminator

19.12.2003 22:18

Ну в общем там, где эта программа ожидает увидеть
1 2 3 4 5
1 2 3 4 5
1 2 3 4 5
получается
1 2 3
4 5 1
2 3 4
5 1 2
3 4 5
(вместо массива 5*3 имеем 3*5)

oleg309

20.12.2003 2:59

Цитата

хе.. ряды и колонны эт наверно я перепутала..

извините..

Раз как-то AlaRik мне сказал: Олег хватит комментировать! >:( Либо помогай, либо молчи >:(. FMS! по-моему и к тебе пора такую предъяву кинуть!!! >:( >:( >:(

fms

20.12.2003 14:09

oleg309, я это написала, т.к. я писала что ввод неправильный. и просто признала свою ошибку. так что не надо пожалуйста.
у тебя кстати не меньше кооментариев осталось.

и вообще чего ты злой то такой?

_____
добавлено:

за собой последи: http://forum.pascal.net.ru/?board=zd;actio...;num=1071837867

Roman

20.12.2003 20:30

за матрицу спасибо, и если не трудно, то тыкните пальцем где они перепутаны?
(

IQ 20 )

а насчёт октаэдера идеи есть?
я с таким типом задач раньше не сталкивался, просто не представляю как ЭТО оформить.

trminator

20.12.2003 21:02

Цитата

а насчёт октаэдера идеи есть?

На геометрии я обычно делал домашку по алгебре, и препода не слышал (не слушал). Но наскольно я помню, есть формулы для всего что тебе нужно.

В пятой задаче можно применить процедуры GetImage PutImage.

AlaRic

20.12.2003 23:04

oleg309, fms: Брейк! Хватит флудить, разборки в привате >:(

fms

20.12.2003 23:08

есть, сэр.. умолкаю..