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

Автор: I_am_HATED 26.05.2009 23:18

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

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

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

Автор: volvo 26.05.2009 23:44

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

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

Автор: Krjuger 26.05.2009 23: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 23:53

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

Автор: Krjuger 27.05.2009 0:00

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

Автор: volvo 27.05.2009 0:32

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

Автор: Krjuger 27.05.2009 2: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 27.05.2009 2:09

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

Автор: Krjuger 27.05.2009 2:17

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

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

Автор: -volvo- 27.05.2009 12:52

Автор: Krjuger 28.05.2009 0: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 16:15

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

Автор: Krjuger 28.05.2009 17:29

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

Автор: Lapp 28.05.2009 17:44

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

Автор: Krjuger 28.05.2009 18: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 18:50

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

Автор: Lapp 28.05.2009 18:55

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

Автор: Krjuger 28.05.2009 19:28

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

Unconnected

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

Автор: Unconnected 28.05.2009 19: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.

Автор: volvo 28.05.2009 19:36

Автор: Unconnected 28.05.2009 19:43

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

Автор: Krjuger 28.05.2009 19:46

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

Автор: volvo 28.05.2009 19:48

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

Автор: Unconnected 28.05.2009 19: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 19: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 20:00

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

Автор: Krjuger 28.05.2009 20: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 20:07

Переделывай:


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

Автор: Unconnected 28.05.2009 20: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 21: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;

Автор: volvo 28.05.2009 23:15

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

Автор: Unconnected 28.05.2009 23: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 29.05.2009 0:03

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

Автор: volvo 29.05.2009 0:32

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

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

Автор: Krjuger 29.05.2009 1: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 9:46

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

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

  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=m*n;

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