Форум «Всё о Паскале» > 2 задачи про массивы

Помощь - Поиск - Пользователи - Календарь

Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи

I_am_HATED

26.05.2009 19:18

1. Нахождение максимального значения в массиве среди всех чётных чисел. Длина массива вводится с клавиатуры. Печатать элементы массивы по 9 штук, по формату :6. Тип обрабатываемых данных - целые.

2. Заполнить двумерный массив A(MxN) элементов символами из одномерного массива В (длиной не более 256 элементов) "змейкой" от конца к началу - сперва N-ю строку справа налево, затем N-1-ю слева направо и т.д. Массив B предварительно заполняется из входного текстового файла. Оба массива распечатать. Предельные значения числа строк 16, столбцов 16. Тип обрабатываемых данных - символьный.

Помогите решить, я что-то путаюсь в них..

volvo

26.05.2009 19:44

Что сама делала? Или хотя бы пыталась делать?

Что является основной проблемой при решении?

Цитата

Помогите решить

Ключевое слово выделено, ты начинай, сделай хоть что-то, а мы поможем...

Krjuger

26.05.2009 19:48

Черт взяли и удалила именно ту тему,куда писал)))По поводу второй задачи, заполнять змейкой,то что то в духе


k:=1;{индекс массива В}
s:=1;{переменная для чередования строк}
for i:=n downto 1 do begin
 if s mod 2=0 then begin
   for j:=1 to m do begin
   A[i,j]:=B[k];
   k:=k+1;
  end;
 else
  for j:=m downto 1 do begin
   A[i,j]:=B[k];
   k:=k+1;
  end;
 end;
s:=s+1;
end;

Вот сам процесс заполнения,сначала справа налево,а потом меняеться.Так же надо предусмотреть когда массив В станет пустым,чтоб нули не приписывать.

УЧТИ.Я лиш подал идею.Это не является решением твоей задачи.(чтоб это стало решением задачи, нужно еще доделать)

volvo

26.05.2009 19:53

"Змеек" как минимум 4 способа выложено на форуме, половина из них - в FAQ-е, отлаженные и оттестированные. Зачем опять велосипед - непонятно... Что, поиск можно отключать, никто не пользуется? Устроили здесь соревнования Formula I, главное быстрее ответить и счетчик накрутить?

Krjuger

26.05.2009 20:00

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

volvo

26.05.2009 20:32

Попроще - не значит правильнее, правда? Вот у тебя в решении - явное дублирование кода. Избавишься от условия if внутри цикла по строкам, +1 в репутацию тебе обеспечен (за освоение новых, более интересных, чем ты сейчас это делаешь, методов решения

) Нельзя же все время делать все "в лоб", надо учиться и другим методам...

Krjuger

26.05.2009 22:07

Хорошо побежал подключать аспирантов...


k:=1;{индекс массива В}
s:=1;{переменная для чередования строк}
for i:=n downto 1 do begin
 for j:=1 to m do begin
   if s mod 2=0 then 
     A[i,j]:=B[k];
    else
      A[i,m-j+1]:=B[k];
 
   k:=k+1;
  end;
 s:=s+1;
end;

Лучше этого придумать пока что ничего не смог.

volvo

26.05.2009 22:09

Даже не думай, я ж еще и вопросы задавать буду, почему так, а не иначе...

Чужими мозгами долго не протянешь...

Krjuger

26.05.2009 22:17

Мож тогда чему нибудь и научусь

,yes my master,покажи мне путь истины.а вообще флуд уже начался,где там создатель темы???Умер чтоли??

Эм ну и где моя обещанная концетка*?

-volvo-

27.05.2009 8:52

Цитата

ну и где моя обещанная концетка*?

Ты ж от if-а не избавился

... Избавляйся - будет "конфетка"

Krjuger

27.05.2009 20:48


k:=1;{индекс массива В}
s:=m;{переменная для чередования строк}
p:=m;
d:=1;
 for j:=m downto 1 do begin
   for i:=n downto 1 do begin  
     A[i,s]:=B[k];
     s:=abs(s-p)+1;
      k:=k+m;
  end;
 d:=d+1;
 k:=d;
 s:=p-1;
 end;

Не бей сильно,я не знаю будет работать или нет))))паскаля нету щас с собой(не дома).Это все на что меня хватило,но это уже изврат)

Lapp

28.05.2009 12:15

Цитата(Krjuger @ 27.05.2009 21:48)

я не знаю будет работать или нет))))

Не, не будет

.
Хоть я и не Паскаль..))

Krjuger

28.05.2009 13:29

Ну подкиньте хоть идейку....Хотяб из теории,а то что то мой нерациональный ум ничего рационального не придумывает,а самому уже стало интересно.пока что я дошел только до варианта,где кол во строк четно.

Lapp

28.05.2009 13:44

Цитата(Krjuger @ 28.05.2009 14:29)

Ну подкиньте хоть идейку..
...
пока что я дошел только до варианта,где кол во строк четно.

А при чем тут количество строк?

Идейку?.. Ну, смотри.
Сделай переменную для величины изменения, d. Сначала положи d:=-1. Потом во внешнем цикле (в конце) умножай ее на -1.
Второй индекс, i2, сначала положи равным m, а потом так: Inc(i2,d).

Krjuger

28.05.2009 14:32


k:=1;{индекс массива В}
s:=1;{переменная для чередования строк}
for i:=n downto 1 do begin 
j:=m;
while (s mod 2=0) and (j>=1) do begin 
     A[i,j]:=B[k];
     k:=k+1;
     j:=j-1;
  end;
 while (s mod 2<>0)  and (j>=1) do begin 
      A[i,m-j+1]:=B[k];
      k:=k+1;
      j:=j-1;
   end;
   s:=s+1;
end;

Вот еще вариантик.олько,что то мне подсказывает,что его ты тоже забракуеш,потому что

Цитата

Вот у тебя в решении - явное дублирование кода

Опять же пишу из универа.через чужой ноут без паскаля(в плане паскаля у человека нет).

Unconnected

28.05.2009 14:50

Компилятор в голове... самонадеянно

Lapp

28.05.2009 14:55

Цитата(Krjuger @ 28.05.2009 15:32)

что то мне подсказывает,что его ты тоже забракуеш,потому что

Цитата

Вот у тебя в решении - явное дублирование кода

Не только поэтому. Ты заменил if на while - и думаешь, прокатит? ))

Чем моя "идейка" не понравилась? вникай..))

Krjuger

28.05.2009 15:28

Я не знаю почему,но на момент размещения своего варианта,я твою идею,не видел.насчет -1,щас посмотрим...)))

Unconnected

компилятора в голове нету(процессор слишком слабенький,не тянет),задача больше математическая.Жаль до -1 сам не дошел(

Unconnected

28.05.2009 15:32

uses crt;
const m=5;n=5;z=25;
var i,j,f:byte;
    d:integer;
    b:array[1..z] of byte;
    a:array[1..m,1..n] of byte;
begin
  clrscr;
  randomize;
  for i:=1 to z do
    begin
      b[i]:=random(10);
      write(b[i],' ');
    end;
  readln;
  d:=-1;
  f:=1;
  i:=m;
  j:=n;
  repeat
    repeat
      a[i,j]:=b[f];
      write(a[i,j],'  ');
      delay(50000);
      inc(f);
      j:=j+d;
    until (j+d=-1) or (j+d=n+1);
    d:=-d;
    dec(i);
    writeln;
  until (i=0);
  readln;
end.

Мой вариант:)

Не знаю правда, это ли Lapp имел в виду, когда говорил про d:=-1;, но кажется принцип похож)

volvo

28.05.2009 15:36

Цитата

но кажется принцип похож)

Принцип, может, и похож, но у тебя вылет по ошибке 201 - Range Check, проверяй

(не забудь включить контроль границ, естественно)

Unconnected

28.05.2009 15:43

Как так, у меня всё прекрасно работает, TP7?..
Контроль границ, в настройках компилятора, включен.

Krjuger

28.05.2009 15:46


until (j+d=-1) or (j+d=n+1);

инвини конешно,то как у тебя в минус 1 уходит если при 0 уже должно выходить...у тебя нету нулового элемента,чтоб до -1 добраться.

volvo

28.05.2009 15:48

Цитата

у меня всё прекрасно работает, TP7?..

Не работает ни в TP7, ни в других компиляторах:

  repeat
    repeat
      writeln('i = ', i, ' j = ', j); { <--- Добавь и убедись, что J становится равным 0, а это RTE 201 }
      a[i,j]:=b[f];

Unconnected

28.05.2009 15:51

uses crt;
const m=5;n=5;z=25;
var i,j,f:byte;
    d:integer;
    b:array[1..z] of byte;
    a:array[1..m,1..n] of byte;
begin
  clrscr;
  randomize;
  for i:=1 to z do
    begin
      b[i]:=random(10);
      write(b[i],' ');
    end;
  readln;
  d:=-1;
  f:=1;
  i:=m;
  j:=n;
  repeat
    repeat
      a[i,j]:=b[f];
      write(a[i,j],'  ');
      delay(50000);
      inc(f);
      j:=j+d;
    until (j=0) or (j=n);
    d:=-d;
    dec(i);
    writeln;
  until (i=0);
  readln;
end.

Вот так лучше?.. Здесь по идее никак не произойдёт обращение к нулевому элементу массива...

Нет, так не лучше, что-то неправильно, сейчас проверю.

Krjuger

28.05.2009 15:58

Вот вариант,реализации того что Лап посоветовал.


d:=-1;
i2:=m;
for i:=n downto 1 do begin
 for j:=m downto 1 do begin
      A[i2,j]:=B[k];
      k:=k+1;
      inc(i2,d);
  end;
 d:=d*(-1);
end;

volvo

28.05.2009 16:00

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

Krjuger

28.05.2009 16:04


uses crt;
const m=5;n=5;z=25;
var 
    i, j, d, k, i2 :integer;
    b:array[1..z] of integer;
    a:array[1..n,1..m] of integer;{сори тут помарочка была}
begin
  clrscr;
  randomize;
  for i:=1 to z do
    begin
      b[i]:=random(100);
      write(b[i],' ');
    end;
  readln;
d:=-1;
i2:=m;
k:=1;
for i:=n downto 1 do begin
 for j:=m downto 1 do begin
      A[i2,j]:=b[k];
      k:=k+1;
      write(a[i2,j],' ');{чтоб красиво и наглядно}
      inc(i2,d);
  end;
 d:=d*(-1);
 writeln;
end;
readln;
end.

мда я уже совсем.....переменные забыл обьявить.

Теперь работает,а вообще где сам виновник торжества то?

volvo

28.05.2009 16:07

Переделывай:
Нажмите для просмотра прикрепленного файла

Ну вы что, ребята, думать совсем разучились? Вы что вообще? Простейшая задача вводит в ступор? А что с более сложными делать?

Unconnected

28.05.2009 16:50

Блин.. уже эти итерации чуть ли не на пальцах считаю, всё равно сдвиг идёт, хотя вроде исправил там кое-что..(

uses crt;
const m=5;n=5;z=25;
var d,i,j,f:integer;
    b:array[1..z] of byte;
    a:array[1..m,1..n] of byte;
begin
  clrscr;
  randomize;
  for i:=1 to z do
    begin
      b[i]:=random(8)+1;
      write(b[i],' ');
    end;
  writeln;
  readln;
  d:=-1;
  f:=1;
  i:=m;
  j:=n;
  repeat
    repeat
      a[i,j]:=b[f];
      write(a[i,j],' ');
      inc(f);
      inc(j,d);
    until (j=0) or (j=n+1);
    if j=n+1 then dec(j);
    d:=-d;
    dec(i);
    writeln;
  until (i=0);
  writeln;
  for i:=1 to m do
    begin
      for j:=1 to n do write(a[i,j],' ');
      writeln;
    end;
  readln;
end.

Client

28.05.2009 17:11

var
  a:array[1..5,1..5]of integer;
  b:array[1..25]of integer;
  i,j,k,m,c:integer;
begin
  randomize;
  for i:=1 to 25 do
    b[i]:=i;
  k:=0;
  m:=1;
  c:=0;
  for i:=5 downto 1 do begin
    for j:=5 downto 1 do begin
      inc©;
      a[i,abs(j-k)+1-m]:=b[c];
    end;
    k:=abs(k-5);
    m:=abs(abs(m)-1);
  end;
  {for i:=1 to 5 do
    for j:=1 to 5 do
      StringGrid1.Cells[j-1,i-1]:=inttostr(a[i,j])} // это я на дельфи проверял
end;

А можно мне +1?

volvo

28.05.2009 19:15

Цитата(Unconnected)

Блин.. уже эти итерации чуть ли не на пальцах считаю, всё равно сдвиг идёт

Думай дальше...

Цитата(Krjuger @ 28.05.2009 16:04)

Теперь работает

Тебе хочется, чтоб работало - не значит, что оно работает:
Нажмите для просмотра прикрепленного файла
Тоже думай дальше...

Client, наконец-то... Хоть кто-то добрался до невылетающей программы.

Unconnected

28.05.2009 19:37

И как я Это проморгал?

uses crt;
const m=5;n=5;z=25;
var d,i,j,f:integer;
    b:array[1..z] of byte;
    a:array[1..m,1..n] of byte;
begin
  clrscr;
  randomize;
  for i:=1 to z do
    begin
      b[i]:=random(8)+1;
      write(b[i],' ');
    end;
  writeln;
  readln;
  d:=-1;
  f:=1;
  i:=m;
  j:=n;
  repeat
    repeat
      a[i,j]:=b[f];
      write(a[i,j],' ');
      inc(f);
      inc(j,d);
    until (j=0) or (j=n+1);
    if j>0 then dec(j);
    if j=0 then inc(j);                 {Здесь забыл второе условие}
    d:=-d;
    dec(i);
    writeln;
  until (i=0);
  writeln;
  for i:=1 to m do
    begin
      for j:=1 to n do write(a[i,j],' ');
      writeln;
    end;
  readln;
end.

Krjuger

28.05.2009 20:03

Volvo,ты ошибаешся,я то, что ты сказал, что не работает, просто отредактировал и не стал создавать новое сообщение.и вообще у меня просто 2 переменные не были инициализированы.и я об этом написал.

volvo

28.05.2009 20:32

Я скопировал программу из твоего сообщения в 19:12 по времени GMT+2... Твой пост был отредактирован в 16:24 по тому же времени. Пост содержит фразу "Теперь работает". Тестирование выдало то, что приведено у меня на скриншоте. Что я делаю не так?

В общем, халява кончилась, Client получает +1, за первое верное решение. Остальным - спасибо за участие...

Krjuger

28.05.2009 21:02

Все нашел,ошибку,volvo удали пост пожалуста этот,а то он пустой а я не могу,хотя вот рабочий вариант)



uses crt;
const m=5;n=5;z=25;
var 
    i, j, d, k, i2 :integer;
    b:array[1..z] of integer;
    a:array[1..n,1..m] of integer;{сори тут помарочка была}
begin
  clrscr;
  randomize;
  for i:=1 to z do
    begin
      b[i]:=random(100);
      write(b[i],' ');
    end;
  readln;
d:=-1;
i2:=m;
k:=1;
for i:=n downto 1 do begin
 for j:=m downto 1 do begin
      A[i,i2]:=b[k];
      k:=k+1;
      inc(i2,d);
  end;
 i2:=i2-d;{вот он корень зла где крылся}
 d:=d*(-1);
end;
readln;
end.

Lapp

29.05.2009 5:46

Цитата(Krjuger @ 28.05.2009 22:02)

 i2:=i2-d;{вот он корень зла где крылся}

Угу)). Это была ловушка)). Я все ждал - станешь ли ты возмущаться, что тебе типа идею не до конца выдали.
Не стал.. Получай +1 от меня)). И пару замечаний заодно..

1. Во внутреннем цикле незачем идти downto...
2. ... и тогда можно избавиться от одной лишней переменной:

  d:=-1;
  i2:=m;
  for i:=n downto 1 do begin
    for j:=1 to m do begin
      A[i,i2]:=b[(n-i)*m+j];
      inc(i2,d);
    end;
    i2:=i2-d;
    d:=-d;
  end;

И последнее. Константу z определяй так:

z=m*n;

- либо не определяй вообще:

b: array[1..m*n]of integer;

Успехов))

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.