Форум программистов, компьютерный форум CyberForum.ru
Наши страницы

Turbo Pascal

Войти
Регистрация
Восстановить пароль
 
Petrower
0 / 0 / 0
Регистрация: 14.12.2011
Сообщений: 23
#1

В заданной строке таблицы найти такое значение, которое принадлежит наибольшему количеству столбцов таблицы - Turbo Pascal

01.01.2012, 16:54. Просмотров 612. Ответов 6
Метки нет (Все метки)

Мне нужно было написать программу, которая использует двумерный динамический массив.
а) Сохраняет массив в типизированный файл.
б) Берет из типизированного файла массив.
в) Вывод массив
г) Обрабатывает таблицу. (То есть, выполняет задание, которое мне дано. ).
А задание таково: Среди заданной строки таблицы найти такое, которое принадлежит наибольшему количеству столбцов таблицы.

У меня, это условие происходит в procedure sravnenie(...). Вот оно, то у меня не робит, вернее не правильно. Если что то не дописал спрашивайте.

Pascal
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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
program lr2;
 
uses
    crt;
 
Type
   Telem = single;
   Tline = array[1..1] of Telem;
   Pline = ^Tline;                      {Ukazatel на Tline}
   TCol = array[1..1] of Pline;
   PCol = ^TCol;                        {Ukazatel на TCol}
   Matrix = record
    a: PCol;
    nrow, ncolumn: integer
    end;
 
{ Освобождает память, выделенную массивом, если она была выделена ранее. }
procedure DisposeMatrix(var K: Matrix);
var
    i: integer;
begin
    if K.a <> nil then begin
       for i := 1 to K.nrow do
      FreeMem(K.a^[i], K.ncolumn * sizeof(Telem));
      FreeMem(K.a, K.nrow * sizeof(Pline));
    K.a := nil;
 end
end;
 
{ Выделяет память под массив.
  Если размеры некорректны, ничего не происходит.
  Если память была выделена ранее, то она освоббождается. }
procedure NewMatrix(var K: Matrix; nrow, ncolumn: integer);
var
    i: integer;
begin
    if (nrow > 0) and (ncolumn > 0) then begin
    DisposeMatrix(K);
    K.nrow := nrow; K.ncolumn := ncolumn;
    GetMem(K.a, nrow * sizeof(Pline));
    for i := 1 to nrow do
        GetMem(K.a^[i], ncolumn * sizeof(Telem));
    end
end;
 
 
procedure Print(const K: Matrix);
var
    i, j: integer;
begin
    for i := 1 to K.nrow do begin
    for j := 1 to K.ncolumn do
        write(' ', K.a^[i]^[j]:5:2);
    writeln;
    end
end;
 
 
 
procedure sravnenie(const K: Matrix; var res: TElem);
Type
   Tmas=array [1..1] of TElem;
   Pmas=^Tmas;
var
    i, j, p, l, nrow: integer;
    lmax: Telem;
    B: Pmas;
begin
{I-}
repeat
Write('Введите номер строки из массива =',' '); readln(nrow);
until (IOResult=0) and (nrow>0);
{I+}
p:=nrow;
getmem(B, K.nrow*sizeof(Telem));
For j:=1 to K.ncolumn do
      begin
      For i:=1 to K.nrow do
      If K.a^[p]^[j] = K.a^[i]^[j] then  B^[j]:=B^[j]+1;
 
 
l:= 0;
lmax:= -1;
for j:=1 to K.ncolumn do
if B^[j] > lmax then
        begin
          lmax:= B^[j];
          l:= j;
        end;
    end;
res:=K.a^[p]^[l];
freemem(B, K.nrow*sizeof(TElem));
end;
 
{ Berem massiv iz faila }
function ReadMatrixFromFile(var K: Matrix): boolean;
 
var
    i, j, nrow, ncolumn: integer;
    f: file of Telem;
    Name: string;
    nrow_real, ncolumn_real: Telem;
begin
    ReadMatrixFromFile := false;
    {$I-}
    repeat
    write('Введите имя файла: ');
    readln(Name);
    Assign(f, Name);
    Reset(f)
    until IOResult = 0;
    {$I-}
    read(f, nrow_real);
    {$I+}
    if IOResult <> 0 then exit;
    {$I-}
    read(f, ncolumn_real);
    {$I+}
    if IOResult <> 0 then exit;
    nrow := trunc(nrow_real);
    ncolumn := trunc(ncolumn_real);
    NewMatrix(K, nrow, ncolumn);
    for i := 1 to nrow do
    for j := 1 to ncolumn do begin
        {$I-}
        read(f, K.a^[i]^[j]);
        {$I+}
        if IOResult <> 0 then begin
        DisposeMatrix(K);
        exit
        end;
    end;
    Close(f);
    ReadMatrixFromFile := true
end;
 
 
procedure Create(var K: Matrix);
 
var
    nummer: char;
    nrow, ncolumn, i, j: integer;
begin
    writeln;
    writeln('1. Read array from console');
    writeln('2. Заполнить случайными');
    writeln('3. Read array iz faila');
    write('Выберите действие: ');
    repeat
    nummer:= ReadKey;
    until (nummer = '1') or (nummer = '2') or (nummer = '3');
    writeln(nummer);
    case nummer of
    '1':
        begin
        {$I-}
        repeat
            write('Введите число строк: '); readln(nrow);
            write('Введите число столбцов: '); readln(ncolumn)
        until (IOResult = 0) and (nrow > 0) and (ncolumn > 0);
        {$I+}
        NewMatrix(K, nrow, ncolumn);
        for i := 1 to nrow do
            for j := 1 to ncolumn do
            {$I-}
            repeat
                write('Введите a[', i, ', ', j, ']: ');
                readln(K.a^[i]^[j]);
            until IOResult = 0;
            {$I+}
        end;
    '2':
        begin
        {$I-}
        repeat
            write('Введите число строк: '); readln(nrow);
            write('Введите число столбцов: '); readln(ncolumn)
        until (IOResult = 0) and (nrow > 0) and (ncolumn > 0);
        {$I+}
        NewMatrix(K, nrow, ncolumn);
        for i := 1 to K.nrow do
            for j := 1 to K.ncolumn do
            K.a^[i]^[j] := random(101)
        end;
    '3':
        if ReadMatrixFromFile(K) then
        writeln('Операция выполнена')
        else
        writeln('Операция не выполнена')
    end
end;
 
procedure SaveToFile(const K: Matrix);
var
    i, j: integer;
    Name: string;
    f: file of Telem;
    T:TElem;
begin
    if K.a = nil then exit;
    {$I-}
    repeat
    write('Введите имя файла: ');
    readln(Name);
    Assign(f, Name);
    Rewrite(f)
    until IOResult = 0;
    {$I+}
    T:=K.nrow;
    write(f, T);
    T:=K.ncolumn;
    write(f, T);
    for i := 1 to K.nrow do
    for j := 1 to K.ncolumn do begin
        write(f, K.a^[i]^[j]);
    end;
    Close(f)
end;
 
 
var
    nummer: char;
     K: Matrix;
    n1, n2: integer;
       res: TElem;
       p, l:integer;
begin
    ClrScr;
    Randomize;
    K.a := nil;
    repeat
    ClrScr;
    writeln('1.  Создать таблицу');
    writeln('2.  Обработать таблицу');
    writeln('3.  Print table');
    writeln('4.  Сохранить в файл');
    writeln('0.  Выход');
    writeln;
    write('Выберите действие: ');
    repeat
        nummer := ReadKey
    until (nummer = '1') or (nummer = '2') or (nummer = '3') or (nummer = '4') or (nummer = '0');
    writeln(nummer);
    case nummer of
        '1': Create(K);
        '2':
        if K.a <> nil then
        begin
            sravnenie(K, res);
            Print(K);
            writeln('Ответ: ', res:5:2);
        end
        else
            writeln('Таблица не задана');
        '3':
        if K.a <> nil then
            Print(K)
        else
            writeln('Таблица не задана');
        '4':
        if K.a <> nil then
            SaveToFile(K)
        else
            writeln('Таблица не задана');
    end;
    ReadKey
    until nummer = '0';
    DisposeMatrix(K)
end.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
01.01.2012, 16:54
Здравствуйте! Я подобрал для вас темы с ответами на вопрос В заданной строке таблицы найти такое значение, которое принадлежит наибольшему количеству столбцов таблицы (Turbo Pascal):

Среди точек первого множества найти такую, которая принадлежит наибольшему количеству множеств - Turbo Pascal
На плоскости задано множеств по точек в каждом. Среди точек первого множества найти такую, которая принадлежит наибольшему количеству...

Построить вектор, каждый элемент которого равен наибольшему количеству равных элементов в соответствующей строке матрицы - Turbo Pascal
program Project1; {$APPTYPE CONSOLE} uses SysUtils, Windows; const n=5;

Постройте вектор, каждый элемент которого равен наибольшему количеству равных элементов в соответствующей строке матрицы - Turbo Pascal
Помогите пожалуйста с задачей. Заранее благодарна) 17. Пусть дана матрица А(n x n). Постройте вектор, каждый элемент которого равен...

в строке найти такое слово которое отлично от последнего и являеся полиндромом... - Pascal
вот примерное решение ,нужно только доработать Program lab_5; const n=30; type mas_slovo=array of string; Var...

Найти наименьший элемент в каждой строчке таблицы, 10 строчек, 20 столбцов - Pascal
Помогите найти наименьший элемент в каждой строчке таблицы, 10 строчек, 20 столбцов

Вычислить и вывести на экран в виде таблицы значение функции, заданной с помощью ряда Тейлора - Turbo Pascal
Вычислить и вывести на экран в виде таблицы значения функции, заданной с помощью ряда Тейлора, на интервале от х начального до х конечного...

6
Mawrat
12786 / 5693 / 672
Регистрация: 19.09.2009
Сообщений: 8,838
02.01.2012, 04:15 #2
Petrower, можно не создавать отдельные динамические массивы на каждую строку таблицы. Весь двумерный массив можно оформить как один динамический массив. И заморок будет меньше.
Например, начать можно так:
Pascal
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
type
  TElem = Single;
  TArr = array[1..1, 1..1] of TElem;
  TPArr = ^TArr;
  TMatrix = record
    PArr : TPArr;
    nRow, nCol: integer;
  end;
 
procedure DisposeMatrix(var M : TMatrix);
begin
  if M.PArr = nil then Exit;
 
  FreeMem(M.PArr, M.nRow * M.nCol * SizeOf(TElem));
  M.PArr := nil;
  M.nRow := 0;
  M.nCol := 0;
end;
 
procedure NewMatrix(var M : TMatrix; const nRow, nCol : integer);
begin
  if (M.nRow = nRow) and (M.nCol = nCol) then Exit;
 
  DisposeMatrix(M);
  M.nRow := nRow;
  M.nCol := nCol;
  GetMem(M.PArr, M.nRow * M.nCol * SizeOf(TElem));
end;
 
procedure Print(const M : TMatrix);
var
  i, j : integer;
begin
  if M.PArr = nil then begin
    Writeln('Матрица не создана.');
    Exit;
  end;
  for i := 1 to M.nRow do begin
    for j := 1 to M.nCol do begin
      if j > 1 then Write(#9);
      Write(M.PArr^[i, j]:5:2);
    end;
    Writeln;
  end;
end;
1
Petrower
0 / 0 / 0
Регистрация: 14.12.2011
Сообщений: 23
02.01.2012, 08:24  [ТС] #3
Ну это то понятно, а как мне исправить процедуру сравнение, чтобы выполнялось это условие?


Среди заданной строки таблицы найти такое, которое принадлежит наибольшему количеству столбцов таблицы.
0
Mawrat
12786 / 5693 / 672
Регистрация: 19.09.2009
Сообщений: 8,838
02.01.2012, 17:40 #4
Petrower, как я понял, пользователь задаёт номер строки "p" и нужно в этой строке матрицы найти такой элемент, значение которого присутствует в наибольшем количестве столбцов. Таких элементов может быть несколько, поэтому будем брать первый из таких элементов.
В этом случае, код может быть таким:
Pascal
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
procedure sravnenie(const K: Matrix; var res: TElem);
type
  Tmas=array [1..1] of Integer;
  Pmas=^Tmas;
var
  i, j, l, lMax, p : integer;
  B: Pmas;
begin
  if K.a = nil then begin
    Writeln('Матрица не создана. Действие отменено.');
    Exit;
  end;
  {I-}
  repeat
    Write('Введите номер строки из массива 1..', K.nrow, ': ');
    Readln(p);
  until (IOResult=0) and (p>=1) and (p<=K.nrow);
  {I+}
  getmem(B, K.nrow*sizeof(Integer));
  (*Обнуление элементов массива счётчиков.*)
  for j := 1 to K.nrow do B^[j] := 0;
  (*Каждый j-й элемент массива счётчиков - это количество столбцов,
  матрицы K, в которых встретился элемент со значением, равным K.a^[p]^[j].*)
  for j:=1 to K.ncolumn do
  for l:=1 to K.ncolumn do
  for i:=1 to K.nrow do begin
    if K.a^[p]^[j] = K.a^[i]^[l] then begin
      Inc(B^[j]);
      Break;
    end;
  end;
 
  (*Ищем первый элемент строки K.a^[p]^ (таких элементов может
  быть несколько), значение которого присутствует в наибольшем
  количестве столбцов матрицы K.*)
  lMax := 1;
  for l := 2 to K.nrow do begin
    if B^[l] > B^[lMax] then lMax := l;
  end;
  Res := K.a^[p]^[lMax];
end;
Что касается архитектуры - можно было бы в процедуру sravnenie() поместить только действия по поиску нужного элемента. А вопросы диалога с пользователем (ввод номера строки) вынести за пределы процедуры.
1
Petrower
0 / 0 / 0
Регистрация: 14.12.2011
Сообщений: 23
02.01.2012, 18:15  [ТС] #5
Что то тут нет то. Я ввел для проверки матрицу:
1 2 3 4
2 6 7 9
10 45 35 8
12 26 18 11

Я выбрал 2 строку, по идее он должен вывести 2, а выводит 6
0
Mawrat
12786 / 5693 / 672
Регистрация: 19.09.2009
Сообщений: 8,838
02.01.2012, 18:49 #6
Сейчас проверю...
---
Petrower, я проверил и на тех данных, которые ты предоставил и также пробовал со своими данными - отрабатывает верно. Проверь код процедуры sravnenie() ещё раз - я через пару минут после публикации того кода вносил правки - возможно ты неисправленную версию скопировал. Скопируй ещё раз код sravnenie().
1
Petrower
0 / 0 / 0
Регистрация: 14.12.2011
Сообщений: 23
02.01.2012, 19:06  [ТС] #7
Хорошо. Сейчас проверим

Добавлено через 15 минут
Спаасибо. Все работает
0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
02.01.2012, 19:06
Привет! Вот еще темы с ответами:

Вычислить и вывести на экран в виде таблицы значение функции, заданной графически, на интервале от хнач до хкон с шагом dx - Pascal
Помогите решить задание 1: Вычислить и вывести на экран в виде таблицы значение функции, заданной графически, на интервале от хнач до...

Составить алгоритм и прогрмамму для задания из таблицы 1,выбрав значение "а" из таблицы.Подсчитать количество повторений цыклов. - Turbo Pascal
таблица тут

В заданной строке найти все числа и поменять их на значение 9- это число - Pascal
Пожалуйста помогите разобраться с задачей В заданной строке найти все числа и поменять их на значение 9- это число

Найти количество столбцов таблицы, среди которых нет "похожих" - Pascal
Задача звучит так: &quot;Два столбца таблицы будем называть &quot;похожими&quot;, если совпадают по составу и количеству наборы чисел, из которых они...


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

Или воспользуйтесь поиском по форуму:
7
Yandex
Объявления
02.01.2012, 19:06
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2017, vBulletin Solutions, Inc.
Рейтинг@Mail.ru