Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

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

Автор: 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/oktaedr_dodekaedr_ikosaedr_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 задачку я перекинул в другой топик, или для всех сделаь отдельно?
мне не трудно, но как то неприлично весь форум для себя забирать smile.gif
_____________________________________

жду ваших предложений для 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

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

Автор: 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

Цитата
хе.. ряды и колонны эт наверно я перепутала.. smile.gifsmile.gifsmile.gif извините..


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

Автор: fms 20.12.2003 14:09

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

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

_____
добавлено:

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

Автор: Roman 20.12.2003 20:30

за матрицу спасибо, и если не трудно, то тыкните пальцем где они перепутаны?
( sad.gif IQ 20 )


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

Автор: trminator 20.12.2003 21:02

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

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

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

Автор: AlaRic 20.12.2003 23:04

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

Автор: fms 20.12.2003 23:08

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