Колдунчик.ру
Информационный ресурс для всех любителей активных игр на роликовых и ледовых коньках.
FAQ
Поиск Карта сайта
паскаль помогите!!!
Страница 1 из 1 [ Сообщений: 11 ]
person
Зарегистрирован:
Ср фев 13, 2008 5:04 pm
заданы 2 числовых массива без повторений.Сформировать третий, в который поместить числа:
а)содержащиеся в обоих массивах
б)содержащиеся в первом , но отсутствующие во втором
в)содержащиеся хотя бы в одном из двух массивов,т.е или в первом, или во втором (если числа есть в обоих массивах, в новом массиве оно должно появиться один раз).
пожалуйста помогите!!!
никак не могу решить такие задачи, но очень нужно!!!
PuFF
Зарегистрирован:
Пт окт 14, 2005 4:42 pm
Колдую с:
0- 0-2005
мммм.. в школе такое делали...
person
Зарегистрирован:
Ср фев 13, 2008 5:04 pm
просто в школе язык програмирования не изучаем, а решать курсовые очень надо , но не получается
помогите!!!
pro
Зарегистрирован:
Ср июл 13, 2005 1:01 pm
Колдую с:
01.05.2005
Амплуа:
организатор паники
Мне вот интересно.
Неужели рядом с вами нет сокурсников которые могли-бы помочь, что приходится писать на РОЛЛЕРСКИЙ форум?
Если у вас не получается решать задачи попросите кого-нибудь позаниматься с вами, наймите репетитора, если вы, конечно учиться хотите, а не просто диплом получить.
вот ваша программа, разбирайтесь:
Код:
program prog_arrays;
const MAX_ARR_MEM=100;
type int_array = array [1..MAX_ARR_MEM] of integer;
type int_arrayd = array [1..MAX_ARR_MEM*2] of integer;
var
a1,a2,a3: int_array;
a4: int_arrayd;
a1l,a2l,a3l,a4l: integer;
procedure input_array(var a:int_array;var al: integer);
var
tmp:integer;
begin
al := 0;
writeln('Input array (-1 ends input): ');
while true do begin
readln(tmp);
if tmp <> -1 then begin
al := al + 1;
a[al] := tmp
end else begin
break
end;
if al >= MAX_ARR_MEM then
break
end
end;
procedure print_array(a:array of integer;al:integer);
begin
for al := 0 to al-1 do
write(a[al],' ');
writeln();
end;
procedure qsort(var a:array of integer;l:integer;r:integer);
var x,y,i,j: integer;
begin
i := l;
j := r;
x := a[(l+r) DIV 2];
repeat
while a[i] < x do i:=i+1;
while x < a[j] do j:=j-1;
if i<=j then begin
y := a[i]; a[i] := a[j]; a[j] := y;
i := i+1; j := j-1
end
until i > j;
if l < j then qsort(a,l,j);
if i < r then qsort(a,i,r);
end;
procedure intersect_ordered(
a1 :int_array;
a1l :integer;
a2 :int_array;
a2l :integer;
var a3 :int_array;
var a3l :integer
);
var
i,j :integer;
begin
i := 1;
j := 1;
a3l := 0;
while (i<=a1l) and (j<=a2l) do begin
if (a1[i] < a2[j]) then
i := i+1
else if (a1[i] > a2[j]) then
j := j+1
else begin
a3l := a3l + 1;
a3[a3l] := a1[i];
while (a1[i] = a3[a3l]) and (a1[i] = a2[j]) and (i<=a1l) and (j<=a2l) do begin
i := i+1;
j := j+1;
end
end;
end
end;
procedure substract_ordered(
a1 :int_array;
a1l :integer;
a2 :int_array;
a2l :integer;
var a3 :int_array;
var a3l :integer
);
var
i,j :integer;
begin
i := 1;
j := 1;
a3l := 0;
while (i<=a1l) and (j<=a2l) do begin
if (a1[i] < a2[j]) then begin
a3l := a3l + 1;
a3[a3l] := a1[i];
i := i+1
end else if a1[i] > a2[j] then
j := j+1
else begin
while (a1[i] = a2[j]) and (i<=a1l) and (j<=a2l) do begin
i := i+1;
j := j+1;
end
end;
end;
while (i<=a1l) do begin
a3l := a3l + 1;
a3[a3l] := a1[i];
i := i+1
end
end;
procedure merge_ordered(
a1 :int_array;
a1l :integer;
a2 :int_array;
a2l :integer;
var a3 :int_arrayd;
var a3l :integer
);
var
i,j :integer;
begin
i := 1;
j := 1;
a3l := 0;
while (i<=a1l) and (j<=a2l) do begin
if (a1[i] < a2[j]) then begin
a3l := a3l + 1;
a3[a3l] := a1[i];
i := i+1
end else if (a1[i] > a2[j]) then begin
a3l := a3l + 1;
a3[a3l] := a1[i];
j := j+1
end else begin
a3l := a3l + 1;
a3[a3l] := a1[i];
while (a3[a3l] = a1[i]) and (a1[i] = a2[j]) and (i<=a1l) and (j<=a2l) do begin
i := i+1;
j := j+1;
end
end;
end;
while (i<=a1l) do begin
a3l := a3l + 1;
a3[a3l] := a1[i];
i := i+1
end;
while (j<=a2l) do begin
a3l := a3l + 1;
a3[a3l] := a2[j];
j := j+1
end
end;
{
COMPLEXITY EVALUATION PROOF:
qsort ~ N*log(N)+M*log(M)
intersect_ordered ~ MIN(N,M)
substract_ordered ~ N
merge_ordered ~ MAX(N,M)
total ~ N*log(N)+M*log(M)+O(MAX(N,M)) ~ O(MAX(N,M)*log(MAX(N,M)))
AGAINST TRIVIAL ALGORITHMS:
intersect_trivial ~ N*M/2
substract_trivial ~ N*M/2
merge_trivial ~ N*M/2
total ~ O(N*M/2)
}
begin
input_array(a1,a1l);
input_array(a2,a2l);
qsort(a1,0,a1l-1);
qsort(a2,0,a2l-1);
writeln('First array: ');
print_array(a1,a1l);
writeln('Second array: ');
print_array(a2,a2l);
writeln('Array intersection: ');
intersect_ordered(a1,a1l,a2,a2l,a3,a3l);
print_array(a3,a3l);
writeln('Array substraction: ');
substract_ordered(a1,a1l,a2,a2l,a3,a3l);
print_array(a3,a3l);
writeln('Array merge: ');
merge_ordered(a1,a1l,a2,a2l,a4,a4l);
print_array(a4,a4l);
end.
Наши админы не любят глупых вопросов!
Wolfer
Зарегистрирован:
Сб авг 13, 2005 10:31 pm
Колдую с:
29.08.2004
Амплуа:
Колдун 80го уровня
И ведь не придерёшься)
pro
Зарегистрирован:
Ср июл 13, 2005 1:01 pm
Колдую с:
01.05.2005
Амплуа:
организатор паники
Придраться можно, когда log(N)>M, но на практике такое бывает редко
Еще придрать можно к тому, что я так бессовестно исключил -1 из входного алфавита (по идее терминальные символы не должны входить в алфавит задачи, если это особенно не оговорено).
Ну и еще тысяча мелких придирок

Наши админы не любят глупых вопросов!
person
Зарегистрирован:
Ср фев 13, 2008 5:04 pm
я единственная кто вообще занимается паскалем в моем классе , учитель занималась со мной, ей постоянно не хватает на это время,а репетиторов в нашей глуши не найдешь.вот я и написала на этот форум,
чтобы объяснили хотя бы одну задачу из курсовой.
pro
Зарегистрирован:
Ср июл 13, 2005 1:01 pm
Колдую с:
01.05.2005
Амплуа:
организатор паники
Так объяснить, или код написать?
Вот представил я код программы - вы не задали ни одного вопроса
Не стесняйтесь, спрашивайте.
Наши админы не любят глупых вопросов!
person
Зарегистрирован:
Ср фев 13, 2008 5:04 pm
вот ,пожалуйста ,объясните,как решать такие задачи с помощью циклов с неизвестным числом повторения
не понимаю.
вот другой вариант задачи
Код:
program l;
uses wincrt;
var a,b:array[1..1000] of integer;
n1,n2,j,i:integer;
function numberin(x,size:integer;y:array[1..1000] of integer):boolean;
begin
i:=1;
while (i<=size)and(y[i]<>x) do inc(i);
numberin:=(i<=size);
end;
begin
writeln('Количество чисел 1-го массива');
read(n1);
writeln('Числа:');
for j:=1 to n1 do
read(a[j]);
writeln('Количество чисел 2-го массива');
read(n2);
writeln('Числа:');
for j:=1 to n2 do
read(b[j]);
{Задание a) }
Write('В обоих массивах:');
for j:=1 to n1 do
if numberin(a[j],n2,b) then write(a[j],', ');
writeln;
{Задание б) }
writeln('В первом есть, во втором нет:');
for j:=1 to n1 do
if not numberin(a[j],n2,b) then write(a[j],', ');
writeln;
{Задание в) }
writeln('Есть хотя бы в одном массиве');
for j:=1 to n1 do write(a[j],', ');
for j:=1 to n2 do
if not numberin(b[j],n1,a) then write(b[j],', ');
writeln;
readln;
end.
Wolfer
Зарегистрирован:
Сб авг 13, 2005 10:31 pm
Колдую с:
29.08.2004
Амплуа:
Колдун 80го уровня
pro писал(а):Придраться можно, когда log(N)>M, но на практике такое бывает редко

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

Я не про сам код - не до конца вникал, а про ответ на поставленный вопрос... Как средневекового естествоиспытателя, желающего научиться летать посадить в ракету/реактивный самолёт и нажать кнопку "Пуск"
Вроде, и летит, и летит круто, но толку...

pro
Зарегистрирован:
Ср июл 13, 2005 1:01 pm
Колдую с:
01.05.2005
Амплуа:
организатор паники
Wolfer: угу
Person:
Идея у вас верная. Но есть одна грубая ошибка.
Но сначала немного про оформление:
Код можно заключать в вот такие теги:
{code}
Тут ваша программа.
{/code}
Только вместо { скобок нужны [ скобки.
Так вот, ошибка. Использовать глобальные переменные в процедурах - очень вредно.
Вот ваш код:
Код:
...
function numberin(x,size:integer;y:array[1..1000] of integer):boolean;
begin
i:=1;
while (i<=size)and(y[i]<>x) do inc(i);
numberin:=(i<=size);
end;
...
Здесь используется глобальная переменная i. Чем это плохо? может оказаться что вы используете эту переменную в другой части программы. При вызове функции numberin значение переменной i будет затерто. Вот например:
Код:
for i := 1 to 10000 do begin
writeln(i);
numberin(1,10,[1,2,3,4,5,6,7,8,9,10]);
end;
Такой кусок кода в реальности зациклится. В теории программа должна сломаться.
Вот так надо было реализовать эту функцию:
Код:
function numberin(x,size:integer;y:array of integer):boolean;
var
i:integer;
begin
i:=1;
while (i<=size) and (y[i]<>x) do i := i+1;
numberin := (i<=size);
end;
Еще небольшое замечание, в классическом паскале нет процедуры inc(var a: integer)! Использовать ее, конечно можно, но нежелательно.
В остальном идея правильная, хотя решение отнюдь не оптимальное, но этого пока от вас не требуется (а зря

).
Наши админы не любят глупых вопросов!
Страница 1 из 1 [ Сообщений: 11 ]
Пользователи онлайн
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 0
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения
© 2004 — 2016 koldunchik.ru