koldunchik.ru

Колдунчик.ру

Информационный ресурс для всех любителей активных игр на роликовых и ледовых коньках.
FAQ  Поиск  Карта сайта

паскаль помогите!!!

 
 
 
Страница 1 из 1   [ Сообщений: 11 ] 
 
 
 
person
 
Аватара пользователя

u  
Зарегистрирован:
    Ср фев 13, 2008 5:04 pm
заданы 2 числовых массива без повторений.Сформировать третий, в который поместить числа:
а)содержащиеся в обоих массивах
б)содержащиеся в первом , но отсутствующие во втором
в)содержащиеся хотя бы в одном из двух массивов,т.е или в первом, или во втором (если числа есть в обоих массивах, в новом массиве оно должно появиться один раз).
пожалуйста помогите!!!
никак не могу решить такие задачи, но очень нужно!!!
 
 
 
 
PuFF
 
Аватара пользователя

u  
Зарегистрирован:
    Пт окт 14, 2005 4:42 pm
Колдую с:
    0- 0-2005
мммм.. в школе такое делали...
 
 
 
 
person
 
Аватара пользователя

u  
Зарегистрирован:
    Ср фев 13, 2008 5:04 pm
просто в школе язык програмирования не изучаем, а решать курсовые очень надо , но не получается
помогите!!!
 
 
 
 
pro
 
Аватара пользователя

u  
Зарегистрирован:
    Ср июл 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
 

u  
Зарегистрирован:
    Сб авг 13, 2005 10:31 pm
Колдую с:
    29.08.2004
Амплуа:
    Колдун 80го уровня
:lol:
И ведь не придерёшься)
 
 
 
 
pro
 
Аватара пользователя

u  
Зарегистрирован:
    Ср июл 13, 2005 1:01 pm
Колдую с:
    01.05.2005
Амплуа:
    организатор паники
Придраться можно, когда log(N)>M, но на практике такое бывает редко =)

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

Ну и еще тысяча мелких придирок =)
Наши админы не любят глупых вопросов!
 
 
 
 
person
 
Аватара пользователя

u  
Зарегистрирован:
    Ср фев 13, 2008 5:04 pm
я единственная кто вообще занимается паскалем в моем классе , учитель занималась со мной, ей постоянно не хватает на это время,а репетиторов в нашей глуши не найдешь.вот я и написала на этот форум, :arrow:
чтобы объяснили хотя бы одну задачу из курсовой.
 
 
 
 
pro
 
Аватара пользователя

u  
Зарегистрирован:
    Ср июл 13, 2005 1:01 pm
Колдую с:
    01.05.2005
Амплуа:
    организатор паники
Так объяснить, или код написать?

Вот представил я код программы - вы не задали ни одного вопроса =)
Не стесняйтесь, спрашивайте.
Наши админы не любят глупых вопросов!
 
 
 
 
person
 
Аватара пользователя

u  
Зарегистрирован:
    Ср фев 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
 

u  
Зарегистрирован:
    Сб авг 13, 2005 10:31 pm
Колдую с:
    29.08.2004
Амплуа:
    Колдун 80го уровня
pro писал(а):
Придраться можно, когда log(N)>M, но на практике такое бывает редко =)

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

Ну и еще тысяча мелких придирок =)


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

u  
Зарегистрирован:
    Ср июл 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
 
 
  Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения
 
cron
© 2004 — 2016 koldunchik.ru