Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Форум программистов и сисадминов Киберфорум > Форум программистов > Delphi > Delphi для начинающих
Войти
Регистрация
Восстановить пароль
Правила Карта форума Темы раздела Блоги Социальные группы Поиск Сообщения за день  
 
Рейтинг 4.67/3: Рейтинг темы: голосов - 3, средняя оценка - 4.67
0 / 0 / 0
Регистрация: 12.12.2016
Сообщений: 5
1

Задача на двухмерный массив

12.12.2016, 13:12. Показов 615. Ответов 8
Метки нет (Все метки)
Студворк — интернет-сервис помощи студентам
Собственно, текст задачи:

В данной двумерной целочисленной таблице размером N × N требуется найти три элемента, сумма которых максимальна. При этом первый элемент должен быть соседним по горизонтали или вертикали со вторым, а второй — с третьим.
Входные данные

Входной файл INPUT.TXT содержит в первой строке число N (1 < N ≤ 2000). В следующих N строках записано по N чисел – элементы таблицы. Элементы матрицы по абсолютной величине не превышают 100.
Выходные данные

Выходной файл OUTPUT.TXT должен содержать единственное число — максимальную сумму.

Ниже написан код моей программы. Но на сайте, откуда я взял её, она проходит лишь 2 теста. Возможно, я неверно понимаю условие.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97

program zadanie;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
const nz=0; kz=5000;
type T=array [nz..kz,nz..kz] of integer;
var a:T; n:integer;
procedure schitka(var a1:T; var n:integer);
var i,j:integer; f:textfile;
begin
  Reset(f, 'input.txt');
  Readln(f,n);
  For i:=nz to n-1 do
  begin
    For j:=nz to n-1 do
      Read(f, a1[i,j]);
    Readln(f);
  end;
  Closefile(f);
end;
procedure raschet(var a2:T; var n:integer);
type D=array [nz..kz] of integer;
var i,j,l,k,max:integer; z:textfile; summ:D;
begin
l:=0;
  For i:=nz to n-1 do
  begin
    For j:=nz to n-1 do
    begin
        summ[l]:=a2[i,j]+a2[i+1,j]+a2[i+1,j+1];
        inc(l);
        summ[l]:=a2[i,j]+a2[i,j+1]+a2[i+1,j+1];
      if (i-1>=0) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i,j+1]+a2[i-1,j+1];
      end;
      if (i-1>=0) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i-1,j]+a2[i-1,j+1];
      end;
      if (i-1>=0) and (j-1>=0) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i-1,j]+a2[i-1,j-1];
      end;
      if (i-1>=0) and (j-1>=0) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i,j-1]+a2[i-1,j-1];
      end;
      if (i-1>=0) and (j-1>=0) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i,j-1]+a2[i+1,j-1];
      end;
      if (j-1>=0) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i+1,j]+a2[i+1,j-1];
      end;
        inc(l);
        summ[l]:=a2[i,j]+a2[i+1,j]+a2[i+2,j];
        inc(l);
        summ[l]:=a2[i,j]+a2[i,j+1]+a2[i,j+2];
      if (i-2>=0) and (i-1>=0)  then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i-1,j]+a2[i-2,j];
      end;
      if (j-1>=0) and (j-2>=0) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i,j-1]+a2[i,j-2];
      end;
 
      end;
      inc(l);
    end;
max:=summ[0];
for i:=nz to l do
begin
  if summ[i]>=max then
    max:=summ[i];
end;
Rewrite(z, 'output.txt');
Writeln(z,max);
Closefile(z);
end;
begin
  schitka(a,n);
  raschet(a,n);
end.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
 12.12.2016, 13:12
Ответы с готовыми решениями:

Задача на двухмерный массив
Преобразовать матрицу, разделив каждый элемент матрицы на ее минимальный элемент

Задача на двухмерный массив
Ask the user to input two positive integers M and N. Make the 2 dimensional array of integers with...

задача на двухмерный массив!!!
Найти сумму положительных элементов лежащих выше главной диагонали! Решать с помощью процедур!

Задача на двухмерный массив размерностью 8х8
Помогите пожалуйста решить ... Спасибо большое !!! Дан массив из 64 последовательных элементов...

8
1040 / 856 / 335
Регистрация: 08.12.2016
Сообщений: 3,283
12.12.2016, 13:50 2
я так думаю, это из-за того, что ты позволяешь суммировать за пределами таблицы, где стоят нули, например

-5 -5 1000
-5 -5 -5
-5 -5 -5

правильный ответ здесь -990, а у тебя будет 1000: summ[l]:=a2[i,j]+a2[i,j+1]+a2[i,j+2];
1
0 / 0 / 0
Регистрация: 12.12.2016
Сообщений: 5
12.12.2016, 15:36  [ТС] 3
Допустим, эту проблему я решил, ограничив все i и j в пределах от 0 до n-1
Это, увы, не решает проблемы: как было 2 теста, так и осталось.
(Возможно, конечно, что я просто неправильно делаю ограничение...)

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

program zadanie;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
const nz=0; kz=5000;
type T=array [nz..kz,nz..kz] of integer;
var a:T; n:integer;
procedure schitka(var a1:T; var n:integer);
var i,j:integer; f:textfile;
begin
  Reset(f, 'input.txt');
  Readln(f,n);
  For i:=nz to n-1 do
  begin
    For j:=nz to n-1 do
      Read(f, a1[i,j]);
    Readln(f);
  end;
  Closefile(f);
end;
procedure raschet(var a2:T; var n:integer);
type D=array [nz..kz] of integer;
var i,j,l,k,max:integer; z:textfile; summ:D;
begin
l:=0;
  For i:=nz to n-1 do
  begin
    For j:=nz to n-1 do
    begin
      if (i+1<=n-1) and (j+1<=n-1) then
      begin
        summ[l]:=a2[i,j]+a2[i+1,j]+a2[i+1,j+1];
        Writeln('summ[',l,']=', summ[l]);
      end;
      if (i+1<=n-1) and (j+1<=n-1) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i,j+1]+a2[i+1,j+1];
        Writeln('summ[',l,']=', summ[l]);
      end;
      if (i-1>=0) and (j+1<=n-1) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i,j+1]+a2[i-1,j+1];
        Writeln('summ[',l,']=', summ[l]);
      end;
      if (i-1>=0) and (j+1<=n-1) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i-1,j]+a2[i-1,j+1];
        Writeln('summ[',l,']=', summ[l]);
      end;
      if (i-1>=0) and (j-1>=0) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i-1,j]+a2[i-1,j-1];
        Writeln('summ[',l,']=', summ[l]);
      end;
      if (i-1>=0) and (j-1>=0) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i,j-1]+a2[i-1,j-1];
        Writeln('summ[',l,']=', summ[l]);
      end;
      if (i-1>=0) and (j-1>=0) and (i+1<=n-1) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i,j-1]+a2[i+1,j-1];
        Writeln('summ[',l,']=', summ[l]);
      end;
      if (j-1>=0) and (i+1<=n-1) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i+1,j]+a2[i+1,j-1];
        Writeln('summ[',l,']=', summ[l]);
      end;
      if (i+1<=n-1) and (i+2<=n-1) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i+1,j]+a2[i+2,j];
        Writeln('summ[',l,']=', summ[l]);
      end;
      if (j+1<=n-1) and (j+2<=n-1) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i,j+1]+a2[i,j+2];
        Writeln('summ[',l,']=', summ[l]);
      end;
      if (i-2>=0) and (i-1>=0)  then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i-1,j]+a2[i-2,j];
        Writeln('summ[',l,']=', summ[l]);
      end;
      if (j-1>=0) and (j-2>=0) then
      begin
        inc(l);
        summ[l]:=a2[i,j]+a2[i,j-1]+a2[i,j-2];
        Writeln('summ[',l,']=', summ[l]);
      end;
      end;
      inc(l);
    end;
max:=summ[0];
for i:=nz to l do
begin
  if summ[i]>=max then
    max:=summ[i];
end;
Rewrite(z, 'output.txt');
Writeln(z,max);
Closefile(z);
end;
begin
  schitka(a,n);
  raschet(a,n);
  Readln;
end.
Добавлено через 16 минут
Похоже, разобрался, почему не работало! Всё дело в l в первом элементе суммы. Но теперь не менее важный вопрос: как уменьшить время выполнения программы.
0
1040 / 856 / 335
Регистрация: 08.12.2016
Сообщений: 3,283
12.12.2016, 15:58 4
Цитата Сообщение от ВладимирКиев Посмотреть сообщение
Всё дело в l в первом элементе суммы.
тогда и inc(l) в конце тела цикла лишнее, т.к. l увеличивается всегда перед добавлением, а это только "дыры" делает.

А со временем что за проблемы?
0
0 / 0 / 0
Регистрация: 12.12.2016
Сообщений: 5
12.12.2016, 20:05  [ТС] 5
Слишком долго программа работает. Ума не приложу, как увеличить быстродействие существенно не меняя алгоритм
0
1040 / 856 / 335
Регистрация: 08.12.2016
Сообщений: 3,283
13.12.2016, 00:25 6
если сделать циклы
For i:=1 to n-2 do
For j:=1 to n-2 do
т.е. внутри прямоугольника, заведомо не забредая наружу, при этом a2[i,j] - центральная ячейка треугольника 3х3,
то все эти проверки
if (j+1<=n-1) and (j+2<=n-1) then
просто будут не нужны

только надо будет переписать код для случая трех вертикальных и трех горизонтальных ячеек, т.к. там a2[i,j] у тебя не центральная, причем для этих комбинаций у тебя написан код дважды
Миниатюры
Задача на двухмерный массив  
0
1040 / 856 / 335
Регистрация: 08.12.2016
Сообщений: 3,283
13.12.2016, 01:06 7
0,8 сек на матрице 5000х5000 это много?


Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

unit Unit2;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Label2: TLabel;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form2: TForm2;
  a2: array of array of integer;
  n: integer;
  max, sum: integer;
  start, stop: Tdatetime;
implementation
 
{$R *.dfm}
 
procedure TForm2.Button1Click(Sender: TObject);
var
  i, j: integer;
begin
 
 
  max := a2[1, 1] + a2[1, 0] + a2[0, 1];
  start := Now();
 
  for i :=1 to n-2 do
  for j :=1 to n-2 do begin
    sum :=a2[i,j]+a2[i+1,j]+a2[i+1,j+1]; if sum > max then max := sum;
    sum := a2[i,j]+a2[i,j+1]+a2[i+1,j+1]; if sum > max then max := sum;
    sum := a2[i,j]+a2[i,j+1]+a2[i-1,j+1]; if sum > max then max := sum;
    sum := a2[i,j]+a2[i-1,j]+a2[i-1,j+1]; if sum > max then max := sum;
    sum := a2[i,j]+a2[i-1,j]+a2[i-1,j-1]; if sum > max then max := sum;
    sum := a2[i,j]+a2[i,j-1]+a2[i-1,j-1]; if sum > max then max := sum;
    sum := a2[i,j]+a2[i,j-1]+a2[i+1,j-1]; if sum > max then max := sum;
    sum := a2[i,j]+a2[i+1,j]+a2[i+1,j-1]; if sum > max then max := sum;
    sum := a2[i,j]+a2[i-1,j]+a2[i+1,j];   if sum > max then max := sum;
    sum := a2[i,j]+a2[i,j-1]+a2[i,j+1];   if sum > max then max := sum;
   end;
 
   Button1.Caption := IntToStr(max);
   stop := Now();
   Label1.Caption := FloatToStr((stop - start) * 24 * 3600) + ' сек';
end;
 
 
procedure TForm2.Button2Click(Sender: TObject);
var
  i, j: integer;
begin
 n := StrToInt(Edit1.Text);
 SetLength(a2, n, n);
 Button1.Caption := 'Найти';
 Randomize();
 start := Now();
 for i := 1 to n-1 do
 for j := 1 to n-1 do begin
   a2[i, j] := Random(n);
   if Random(n) < n div 4 then
     a2[i, j] := - a2[i, j]
 end;
 stop := Now();
 Label2.Caption := FloatToStr((stop - start) * 24 * 3600) + ' сек';
end;
 
end.
0
1040 / 856 / 335
Регистрация: 08.12.2016
Сообщений: 3,283
13.12.2016, 01:07 8
скрины
Миниатюры
Задача на двухмерный массив   Задача на двухмерный массив  
0
0 / 0 / 0
Регистрация: 12.12.2016
Сообщений: 5
13.12.2016, 10:33  [ТС] 9
Цитата Сообщение от YuryK Посмотреть сообщение
0,8 сек на матрице 5000х5000 это много?
Отлично, большое спасибо. Всё приняло.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
 13.12.2016, 10:33
Помогаю со студенческими работами здесь

Тривиальная задача: двухмерный динамический массив
задача простая: считать из файла размеры двухмерной матрицы, динамически ее создать, провести над...

Задача двухмерный массив размерностью 3X4
Помогите пожалуста решить задачу))))!!! Дан двухмерный массив размерностью 3X4. Необходимо найти...

Задача на Двухмерный массив . ! В исходной матрице заменить элементы главной диагонали на единицу
Дан массив из 64 последовательных элементов {a1, a2,…, a64}. Для вычисления элементов массива...

двухмерный массив, просто массив и дана строка, состоящая из русских слов
Пожалуйста помогите=))))))и если можно напишите что значит каждая строка кода=) 1.Дан массив...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
9
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2023, CyberForum.ru