Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 03.06.2008, 23:55   #11
MyVLink
Пользователь Подтвердите свой е-майл
 
Регистрация: 12.05.2008
Сообщений: 13
По умолчанию

Вот получается такая программа, что я накосячил?

Program kypcoBou; {nazvanie programmu}
Uses crt; {zapysk modjuljaя CRT}
Const
n=100;
Var i,j,c,m,k1,k2:integer;
G,a,b,h:array [1..n] of integer;
k_a,k_b:integer;
Fg,fa,fb:text;
change:boolean;
Begin
Clrscr;
Assign (fa,'c:\aa.txt');
Assign (fb,'c:\bb.txt');
Assign (fg,'c:\gg.txt');
Rewrite(fa); rewrite (fb); rewrite (fg);
Writeln ('vvedite kolu4estvo elementov massiva'); readln (m);
Randomize;
Writeln ('dannie:'); writeln (fg, 'dannie:');
For i:=1 to m do
Begin
G[i]:=random(10)+8;
write(g[i]:4);
Write (fg,g[i]:4);
End;
k_a:=0; k_b:=0; k1:=1; k2:=1;
For i:=1 to m do
If (I mod 2)=0 then begin
A[k1]:=g[i];k1:=k1+1;k_a:=k_a+1;
Write (fa, a[k1]);
End
Else begin
B[k2]:=g[i];k2:=k2+1;k_b:=k_b+1;
Write (fb,b[k2]);
End;
write('A:');
for i:=1 to k_a do write(A[i]:5);
writeln;
repeat

for i:=1 to k_a-1 do
begin
if a[i] > a[i+1] then
begin C := a[i+1]; a[i+1] := a[i]; a[i]:=c;
end;
end;
write('A:');
for i:=1 to k_a do write(A[i]:5);
writeln;
repeat
change := false;
for i:=1 to k_a-1 do
begin
if a[i] > a[i+1] then
begin C := a[i+1]; a[i+1] := a[i]; a[i]:=c;
change := true;
end;
end;
until not change;
write('A:');
for i:=1 to k_a do write(A[i]:5);
writeln;
write('B:');
for i:=1 to k_b do write(b[i]:5);
writeln;
repeat
change := false;
for i:=1 to k_b-1 do
begin
if a[i] > b[i+1] then
begin C := b[i+1]; b[i+1]:=b[i]; b[i]:=c;
change := true;
end;
end;
until not change;
write('B:');
for i:=1 to k_b do write(b[i]:5);
writeln;
k1 := 1; k2 := 1;
for i:=1 to m do
begin if k1 > k_a then
begin
G[i]:=B[k2]; inc(k2);
end else if k2 > k_b then
begin
G[i] := A[k1]; inc(k1);
end else if A[k1]<B[k2] then
begin
G[i] := A[k1]; inc(k1); end else
begin
G[i] := B[k2]; inc(k2); end;
end;
write('G:');
for i:=1 to m do write(G[i]:5);
writeln;
Readln;
Writeln;
Writeln ('rezjyltat:'); writeln (fg,'rezyltat:');
For i:=1 to m do
Begin
Write (g[i]:4);
Write (fg,g[i]:4);
end;
Close (fa); close (fb); close (fg);
Readkey;
End.
MyVLink вне форума Ответить с цитированием
Старый 04.06.2008, 08:08   #12
alexBlack
Участник клуба
 
Регистрация: 12.10.2007
Сообщений: 1,204
По умолчанию

Какая ошибка ? Что не работает ? Мы должны проверять ?
Как минимум вот это:

a[i] > b[i+1]

в сортировке массива b

Последний раз редактировалось alexBlack; 04.06.2008 в 08:36.
alexBlack вне форума Ответить с цитированием
Старый 04.06.2008, 15:04   #13
MyVLink
Пользователь Подтвердите свой е-майл
 
Регистрация: 12.05.2008
Сообщений: 13
По умолчанию

Поправил, теперь сортируется, он все равно неправильно.



Program kypcoBou; {nazvanie programmu}
Uses crt; {zapysk modjuljaя CRT}
Const
n=100;
Var i,j,c,m,k1,k2:integer;
G,a,b,h:array [1..n] of integer;
k_a,k_b:integer;
Fg,fa,fb:text;
Begin
Clrscr;
Assign (fa,'c:\aa.txt');
Assign (fb,'c:\bb.txt');
Assign (fg,'c:\gg.txt');
Rewrite(fa); rewrite (fb); rewrite (fg);
Writeln ('vvedite kolu4estvo elementov massiva'); readln (m);
Randomize;
Writeln ('dannie:'); writeln (fg, 'dannie:');
For i:=1 to m do
Begin
G[i]:=random(10)+8;
write(g[i]:4);
Write (fg,g[i]:4);
End;
k_a:=0; k_b:=0; k1:=1; k2:=1;
For i:=1 to m do
If (I mod 2)=0 then begin
A[k1]:=g[i];k1:=k1+1;k_a:=k_a+1;
Write (fa, a[k1]);
End
Else begin
B[k2]:=g[i];k2:=k2+1;k_b:=k_b+1;
Write (fb,b[k2]);
End;
For i:=1 to k_a-1 do
If a[i]>a[i+1] then begin
C:=a[i+1];a[i+1]:=a[i];a[i]:=c;
Write(fa,a[i]);write(fa,a[i+1]);
End
Else
Begin
A[i]:=a[i];a[i+1]:=a[i+1];
Write (fa,a[i]);write(fa,a[i+1]);
End;
For i:=1 to k_b-1 do
If b[i]>b[i+1] then begin
C:=b[i+1]; b[i+1]:=b[i];b[i]:=c;
Write (fb,b[i]);write(fb,b[i+1]);
End
Else
begin
b[i]:=b[i];b[i+1]:=b[i+1];
write(fb,b[i]);write(fb,b[i+1])
End;
K1:=1;k2:=1;
For i:=1 to k_a+k_b do
If (k2<k_b) and ((k1>k_a) or (a[k1]>b[k2]))
Then begin g[i]:=b[k2]; k2:=k2+1; end
Else begin g[i]:=a[k1]; k1:=k1+1; end;
Writeln;
Writeln ('rezjyltat:'); writeln (fg,'rezyltat:');
For i:=1 to m do
Begin
Write (g[i]:4);
Write (fg,g[i]:4);
end;
Close (fa); close (fb); close (fg);
Readkey;
End.
Изображения
Тип файла: jpg Безимени-1.jpg (27.1 Кб, 150 просмотров)

Последний раз редактировалось MyVLink; 04.06.2008 в 15:21.
MyVLink вне форума Ответить с цитированием
Старый 04.06.2008, 16:36   #14
alexBlack
Участник клуба
 
Регистрация: 12.10.2007
Сообщений: 1,204
По умолчанию

Что это Вы опять старый исходник привели ?
Вот здесь все работает. Вывод в файл доделаете
Код:
const n=100;
var m, i:integer;
    k_a, k_b, C, k1, k2:integer;
    G, A, B : array [1..n] of integer;
    change : boolean;
//var i,j,c,m,k1,k2:integer;
//    G,a,b,h:
//    Fg,fa,fb:text;
begin
   Writeln ('vvedite kolu4estvo elementov massiva');
   {readln(m); }m := 11;

   randomize;
   Writeln('dannie:');

   for i:=1 to m do G[i]:=random(10)+8;

   write('G:'); for i:=1 to m do write(G[i]:5); writeln;

   k_a:=0; k_b:=0;
   for i:=1 to m do begin
     If (I mod 2)=0 then begin
        inc(k_a); A[k_a]:=g[i];
     end else begin
        inc(k_b); B[k_b]:=g[i];
     end;
   end;

   write('A:'); for i:=1 to k_a do write(A[i]:5); writeln;
   write('B:');for i:=1 to k_b do write(B[i]:5); writeln;

   repeat
      change := false;
      for i:=1 to k_a-1 do begin
        if a[i] > a[i+1] then begin
           C := a[i+1]; a[i+1] := a[i]; a[i]:=c;
           change := true;
        end;
      end;
   until not change;
   repeat
      change := false;
      for i:=1 to k_b-1 do begin
        if b[i] > b[i+1] then begin
           C := b[i+1]; b[i+1] := b[i]; b[i]:=c;
           change := true;
        end;
      end;
   until not change;

   write('A:'); for i:=1 to k_a do write(A[i]:5); writeln;
   write('B:');for i:=1 to k_b do write(B[i]:5); writeln;

   k1 := 1; k2 := 1;
   for i:=1 to m do begin
      if k1 > k_a then begin
         G[i] := B[k2]; inc(k2);
      end else
      if k2 > k_b then begin
         G[i] := A[k1]; inc(k1);
      end else
      if A[k1] < B[k2] then begin
         G[i] := A[k1]; inc(k1);
      end else begin
         G[i] := B[k2]; inc(k2);
      end;
   end;
   write('G:'); for i:=1 to m do write(G[i]:5); writeln;
   Readln;
alexBlack вне форума Ответить с цитированием
Старый 04.06.2008, 22:05   #15
MyVLink
Пользователь Подтвердите свой е-майл
 
Регистрация: 12.05.2008
Сообщений: 13
По умолчанию

Ура! Всё Работает! Спасибо огромное!
MyVLink вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Плиз, помогите с курсовым в Паскале!!!!СРОЧНО!!!! ~Brilliant~ Помощь студентам 2 21.02.2009 21:15
Помогите с курсовым на С++ Solovei_MC Помощь студентам 2 14.06.2008 15:10