IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Задачи:матрица-поиск и сравнение элементов в ней.
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 10

Репутация: -  0  +


Здрасте,
извиняюсь за прошлый топик, надеюсь, что такое название темы более информативно, к сожалению места хватило токо на описание 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.написать графическую программу, которая будет геометр. тело (не круг) как можно плавнее двигать по экрану(анимация).

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

Сообщение отредактировано: volvo -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


профи
**

Группа: Пользователи
Сообщений: 109
Пол: Мужской

Репутация: -  1  +


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


--------------------
Тело, находящееся в состоянии покоя, стремится смотреть телевизор.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


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

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.


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

Группа: Пользователи
Сообщений: 10

Репутация: -  0  +


спасибо,
вроде работает,а можно объяснить немного,
почему 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


   
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


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

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


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 10

Репутация: -  0  +


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

жду ваших предложений для 3,4,5 задачки
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

Группа: Пользователи
Сообщений: 10

Репутация: -  0  +


Код

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... работает.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Новичок
*

Группа: Пользователи
Сообщений: 10

Репутация: -  0  +


вот вариант 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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Новичок
*

Группа: Пользователи
Сообщений: 10

Репутация: -  0  +


вариант 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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


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


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Бывалый
***

Группа: Пользователи
Сообщений: 195
Пол: Женский

Репутация: -  0  +


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


--------------------
непонимающая..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


Ну в общем там, где эта программа ожидает увидеть
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)


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


профи
**

Группа: Пользователи
Сообщений: 109
Пол: Мужской

Репутация: -  1  +


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


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


--------------------
Тело, находящееся в состоянии покоя, стремится смотреть телевизор.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Бывалый
***

Группа: Пользователи
Сообщений: 195
Пол: Женский

Репутация: -  0  +


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

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

_____
добавлено:

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


--------------------
непонимающая..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Новичок
*

Группа: Пользователи
Сообщений: 10

Репутация: -  0  +


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


а насчёт октаэдера идеи есть?
я с таким типом задач раньше не сталкивался, просто не представляю как ЭТО оформить.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


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

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

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


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


...
*****

Группа: Пользователи
Сообщений: 1 347
Пол: Мужской

Репутация: -  3  +


oleg309, fms: Брейк! Хватит флудить, разборки в привате  >:(
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Бывалый
***

Группа: Пользователи
Сообщений: 195
Пол: Женский

Репутация: -  0  +


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


--------------------
непонимающая..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 




- Текстовая версия 26.09.2017 9:03
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"