Хостинг портала RFpro.ru:
Московский хостер
Профессиональный платный хостинг на базе Windows 2008

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

Boriss Статус: Академик Рейтинг: 1691 ∙ повысить рейтинг »

Micren Статус: Профессионал Рейтинг: 1451 ∙ повысить рейтинг »

_Ayl_ Статус: Студент Рейтинг: 1438 ∙ повысить рейтинг »

Вопрос № 175988: здравствуйте,нужно решить задачу Даны два массива x[1] ≤… ≤ x[k], y[1] ≤ … ≤ y[l]. Найти их «пересечение», т.е. массив z[1] ≤… ≤ z[m], содержащий их общие элементы, причем, кратность каждо...

здравствуйте,нужно решить задачу
Даны два массива x[1] ≤… ≤ x[k], y[1] ≤ … ≤ y[l]. Найти их «пересечение», т.е. массив z[1] ≤… ≤ z[m], содержащий их общие элементы, причем, кратность каждого элемента в массиве z равняется минимуму из его кратностей в массивах x и y .Число действий должно быть порядка k+ l.

Отправлен: 11.01.2010, 12:33
Вопрос задал: Benqq, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
{ Даны два массива x[1] <= ... <= x[k], y[1] <= ... <= y[l]. Найти их "пересечение", т.е. массив z[1] <= ... <= z[m], содержащий их общие элементы, причем, кратность каждого элемента в массиве z равняется минимуму из его кратностей в массивах x и y. Число действий должно быть порядка k+l. } Program InterSect; Const cMaxIndex = 100; { максимальное число элементов для определения массива } Type TIndex = 1..cMaxIndex; { тип для описания индекса } TArray = array [0..cMaxIndex] of Word; { описание массива. Элемент с индексом 0 - верхняя граница массива } Var x : TArray; { массив x } y : TArray; { массив y } z : TArray; { массив z } { Процедура печати массива } Procedure Print (a : TArray; title : string); var i : TIndex; begin write (title, \':\'); for i := 1 to a [0] do write (\' \', a [i]); writeln; end; { Процедура ввода массива } Procedure Input (var a : TArray; title : string); var i : TIndex; begin writeln (\'Введите элементы массива \', title, \' (не более \', cMaxIndex, \' элементов). Введите 0 для окончания ввода\'); a [0] := 0; for i := 1 to cMaxIndex do begin readln (a [i]); if a [i] = 0 then break else Inc (a [0]); end; end; { Процедура для вормирования "пересечения" массивов } Procedure InterSection (a : TArray; b : TArray; var c : TArray); var i : TIndex; { переменная для перебора элементов первого массива } j : TIndex; { переменная для перебора элементов второго массива } n : TIndex; { количество элементов первого массива } m : TIndex; { количество элементов второго массива } begin n := a [0]; m := b [0]; c [0] := 0; j := 1; i := 1; { пока есть элементы в первом массиве } while i <= n do begin { находим первый элемент во втором массиве, который не меньше текущего из первого } while (j <= m) and (b [j] < a [i]) do Inc (j); if j > m then break; { добавляем одинаковые элементы в третий массив (меньшая кратность получается автоматически) } while a [i] = b [j] do begin { Заносим элемент в массив c } Inc (c [0]); c [c [0]] := a [i]; { переходим к следующим элементам исходных массивов } Inc (i); Inc (j); { проверяем границы массивов } if (i > n) or (j > m) then break; end; { пропускаем элементы первого массива до тех пор, пока очередной элемент не станет больше или равен текущего элемента второго массива } while (i <= n) and (a [i] < b [j]) do Inc (i); end; end; Begin Input (x, \'x\'); Input (y, \'y\'); Print (x, \'x\'); Print (y, \'y\'); InterSection (x, y, z); Print (z, \'z\'); End.

Ответ отправил: _Ayl_, Студент
Ответ отправлен: 11.01.2010, 15:30

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258553 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Эксперты, помогите пожалуйста

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

вот условия для решения:
В данной лабораторной работе необходимо сделать типизированный файл, где каждой компонентой будет число, массив или матрица. Количество компонент заранее не определено, поэтому, при обработке файла необходимо использовать либо булевское значение функции EOF (конец файла), либо значение функции FILESIZE (размер файла).
Сами значения каждой компоненты можно задавать генератором случайных чисел.
Вывод исходного файла и файла с результатами сделать процедурой (и, если файлы одного типа, то одной процедурой).

у меня есть программа, но её надо переделать, добавить процедуры и делать не в двумерном массиве.

Отправлен: 11.01.2010, 23:46
Вопрос задал: aggressor92, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
{ Создать файл, где компонентой будет массив из N чисел. Определить минимальное и максимальное значение в каждой компоненте (массиве) и числа, находящиеся между ними, рассортировать по убыванию. После сортировки каждую компоненту записать в новый файл. Ту компоненту, где максимальное и минимальное значения находятся наиболее близко друг к другу, удалить из файла. } Program CompFile; Const N = 20; { размер компоненты } cCompMin = 10; { минимальное число компонент в файле } cCompMax = 20; { максимальное число компонент в файле } cMin = 1; { минимальное значение элемента компоненты } cMax = 100; { максимальное значение элемента компоненты } cSourceFName = \'175997.t01\'; cTempFName = \'175997.t02\'; cResultFName = \'175997.t03\'; Type TIndex = 1..N; { тип индекса для компонеты } TFileRange = 0..cCompMax; { диапазон номеров компонент в файле } TComponent = array [TIndex] of Integer; { тип для описания компоненты } TCompFile = file of TComponent; { файл компонент } { Процедура очистки экрана } Procedure ClrScr; assembler; asm mov ax, 3 int 10h end; { Прцедура аварийного завершения программы } Procedure Fatal (msg : string); begin ClrScr; writeln (\'Аварийное завершение программы!\'); writeln (msg); Halt (1); end; { Функция получения случайного числа в заданных границах } Function Rand (a : Integer; b : Integer) : Integer; begin Rand := Random (b - a + 1) + a; end; { Процедура создания случайной компоненты } Procedure CreateComponent (var c : TComponent); var i : TIndex; begin for i := 1 to N do c [i] := Rand (cMin, cMax); end; { Процедура создания файла } Procedure CreateFile (fname : string); var f : TCompFile; i : TFileRange; c : TComponent; begin {$I-} Assign (f, fname); Rewrite (f); {$I+} if IOResult <> 0 then Fatal (\'Не могу создать файл \' + fname + \'!\'); for i := 1 to Rand (cCompMin, cCompMax) do begin CreateComponent (c); write (f, c); end; Close (f); end; { Процедура вывода значений компоненты } Procedure OutComponent (c : TComponent); var i : TIndex; begin for i := 1 to N do write (\' \', c [i]); writeln; end; { Процедура вывода файла на экран } Procedure OutFile (fname : string); var f : TCompFile; c : TComponent; i : TFileRange; begin ClrScr; {$I-} Assign (f, fname); Reset (f); {$I+} if IOResult <> 0 then Fatal (\'Не могу открыть файл \' + fname + \'!\'); i := 0; while not eof (f) do begin read (f, c); Inc (i); write (\'#\', i, \':\'); OutComponent (c); end; Close (f); write (\'Нажмите Enter для продолжения ...\'); readln; end; { Процедура обмена значений } Procedure Swap (var a : Integer; var b : Integer); var t : Integer; begin t := a; a := b; b := t; end; { Процедура сортировки элементов компоненты, находящимися между заданными элементами, по убыванию } Procedure SortComponent (var c : TComponent; start_pos : TIndex; end_pos : TIndex); var i : TIndex; j : TIndex; begin for i := start_pos to end_pos - 1 do for j := i + 1 to end_pos do if c [i] > c [j] then Swap (c [i], c [j]); end; { Процедура определения позиций минимального и максимального элементов компоненты } Procedure ComponentInfo (c : TComponent; var min_pos : TIndex; var max_pos : TIndex); var i : TIndex; min : Integer; max : Integer; begin min_pos := 1; max_pos := 1; min := c [1]; max := c [1]; for i := 2 to N do if c [i] < min then begin min := c [i]; min_pos := i; end else if c [i] > max then begin max := c [i]; max_pos := i; end; end; { Процедура преобразования файла с формированием нового файла } Procedure PrepareFile (fname_in : string; fname_out : string; var compNum : TFileRange); var f1 : TCompFile; f2 : TCompFile; c : TComponent; i : TFileRange; mn : TIndex; mx : TIndex; d : Integer; begin {$I-} Assign (f1, fname_in); Reset (f1); {$I+} if IOResult <> 0 then Fatal (\'Не могу открыть файл \' + fname_in + \'!\'); {$I-} Assign (f2, fname_out); Rewrite (f2); {$I+} if IOResult <> 0 then Fatal (\'Не могу создать файл \' + fname_out + \'!\'); i := 0; d := N + 1; while not eof (f1) do begin read (f1, c); Inc (i); ComponentInfo (c, mn, mx); if mn < mx then SortComponent (c, mn + 1, mx - 1) else SortComponent (c, mx + 1, mn - 1); write (f2, c); if d > abs (mn - mx) then begin compNum := i; d := abs (mn - mx); end; end; Close (f1); Close (f2); end; { Процедура удаления заданной компоненты из файла с формированием нового файла } Procedure DeleteCompFromFile (fname_in : string; fname_out : string; compNum : TFileRange); var f1 : TCompFile; f2 : TCompFile; c : TComponent; i : TFileRange; begin {$I-} Assign (f1, fname_in); Reset (f1); {$I+} if IOResult <> 0 then Fatal (\'Не могу открыть файл \' + fname_in + \'!\'); {$I-} Assign (f2, fname_out); Rewrite (f2); {$I+} if IOResult <> 0 then Fatal (\'Не могу создать файл \' + fname_out + \'!\'); i := 0; while not eof (f1) do begin read (f1, c); Inc (i); if i <> compNum then write (f2, c); end; Close (f1); Close (f2); end; Var compNum : TFileRange; Begin Randomize; CreateFile (cSourceFName); OutFile (cSourceFName); PrepareFile (cSourceFName, cTempFName, compNum); OutFile (cTempFName); DeleteCompFromFile (cTempFName, cResultFName, compNum); OutFile (cResultFName); End.

Ответ отправил: _Ayl_, Студент
Ответ отправлен: 12.01.2010, 19:25

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258575 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает lanakarta, 2-й класс :
Здравствуйте, aggressor92.
вот вам мой скромный ответ

Приложение:
program q; const n=10; v=5; type ar_int=array [1..n]of integer; var f1,f2:file of ar_int; a:ar_int; rezult_min:array [1..v]of integer; i,j,max,min,min1,ind_max,ind_min,i1,i2,k,ind_min1:integer; procedure sort(k1,k2:integer;var a:ar_int); var n,i,j:integer; h:boolean; begin repeat h:=true; for i:=k1 to k2-1 do begin j:=i+1; if a[i]>a[j] then begin h:=false; n:=a[j]; a[j]:=a[i]; a[i]:=n; end; end; until h ; end; procedure write_file(f:file of ar_int;a:ar_int); //вывод на экран var i:integer; begin reset(f); while not eof(f1)do begin read(f,a); for i:=1 to n do write(a[i]:4); writeln(\' \'); end; end; begin randomize; assign(f1,\'f1f\'); //подключили файлы к переменным assign(f2,\'f2f\'); rewrite(f1); //создаем исходный файл for i:=1 to v do begin for j:=1 to n do a[j]:=random(100); write(f1,a); end; //--------------------------------------- writeln(\'исходный файл\'); write_file(f1,a); //вывод на экран reset (f1); //открываем созданный файл для считывания массивов rewrite(f2);//создаем и открываем файл для записи массивов j:=0; while not eof(f1)do begin read(f1,a); //считываем массив с файла и проводим манипуляции :) j:=j+1; max:=a[1]; min:=a[1]; ind_max:=1; ind_min:=1; for i:=2 to n do begin if max<a[i] then begin max:=a[i]; ind_max:=i; end; if min>a[i] then begin min:=a[i]; ind_min:=i; end; end; rezult_min[j]:=abs(ind_max-ind_min)-1; //колл чисел между min max if ind_max>ind_min then begin i1:=ind_min; i2:=ind_max; end; if ind_max<ind_min then begin i2:=ind_min; i1:=ind_max; end; i1:=i1+1; i2:=i2-1; sort(i1,i2,a); write(f2,a); end; min1:=rezult_min[1]; ind_min1:=1; for i:=2 to v do //ищем прядковый номер массива где расстояние между min max наименьшее if min1>rezult_min[i] then begin min1:=rezult_min[i]; ind_min1:=i; end; reset(f2); //открываем созданный файл для считывания массивов rewrite(f1);//создаем и открываем файл для записи массивов j:=0; while not eof(f2)do begin read(f2,a); // удаляет последний массив сминимальным расстоян если таких несколько j:=j+1; if j<>ind_min1 then write(f1,a); end; writeln(\'результат\'); write_file(f1,a); //вывод на экран close(f1); close(f2); end.

Ответ отправил: lanakarta, 2-й класс
Ответ отправлен: 15.01.2010, 00:45

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 258626 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »