Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Центр помощи > [Pascal] Массивы

Автор: nitrak 25.12.2006, 19:26

2) Дан одномерный целочисленный массив A, состоящий
              из N элементов,отличных от нуля :
                  - сформировать массив B из элементов массива A,
                            которые делятся на каждую из своих цифр.
                  - упорядочить массив B по убыванию, методом прямого обмена или
                            методом "пузырька"
                  -Удалить из массива A максимальный элемент и сжать массив

                             сортировка массива методом "пузырька"

Код


   const n = 10;
                                    VAR
                                           A:ARRAY[1..n] OF   byte;
                                           I,J,K : INTEGER;
                                           X: BYTE;
                                        BEGIN
                                               writeln('vvod razmera massiva');
                                               readln(K);
                                               writeln('vvod elementov massiva');
                                               FOR I:=1 TO K DO
                                                      READ(A[I]);
                                               FOR I:=1 OT K-1 DO
                                                     FOR J:=1 OT 1 DO 
                                                            IF A[J] > A[J+1] THEN
                                                                 BEGIN 
                                                                       X:=A[J];
                                                                       A[J]:=A[J+1];
                                                                       A[J+1]:=X
                                                                 END;
                                           FOR I:=1 TO K DO 
                                                       writeln(A[I])
                                         END.

M
alexeis1

Модератор: выделяйте пожалуйста код http://forum.vingrad.ru/index.php?showtopic=126445

Автор: Rodman 27.12.2006, 20:48

Код


const n = 10;
                                    VAR
                                           A,B:ARRAY[1..n] OF   byte;
                                           b:boolean; 
                                           I,J,K,o : INTEGER;
                                           X: BYTE;
                                        BEGIN
                                               writeln('vvod razmera massiva');
                                               readln(K);
                                               writeln('vvod elementov massiva');
                                               FOR I:=1 TO K DO
                                                      READ(A[I]);
                                               FOR I:=1 OT K-1 DO
                                                     FOR J:=1 OT 1 DO 
                                                            IF A[J] > A[J+1] THEN
                                                                 BEGIN 
                                                                       X:=A[J];
                                                                       A[J]:=A[J+1];
                                                                       A[J+1]:=X
                                                                 END;
                                           FOR I:=1 TO K DO 
                                                       writeln(A[I])
                                           o:=1;
                                          FOR I:=1 OT K-1 DO
                                                begin
                                                   b:=false;
                                                     FOR J:=1 OT 1 DO 
                                                            IF A[i] mod A[J+1] <> 0 THEN
                                                                 b:=true;
                                                     if(not b)then
                                                     begin
                                                           b[o]:=a[i];
                                                           o:=+1;
                                                     end;                                                     
                                                 end;
                                              FOR I:=1 OT o DO
                                                     FOR J:=1 OT 1 DO 
                                                            IF b[J] > b[J+1] THEN
                                                                 BEGIN 
                                                                       X:=b[J];
                                                                       b[J]:=b[J+1];
                                                                       b[J+1]:=X
                                                                 END;
                                                     FOR I:=1 TO o DO 
                                                       writeln(b[I]);
                                           for i:=1 to k-1 do
                                                   a[i]:=a[i+1];     
                                              FOR I:=1 TO o-1 DO 
                                                       writeln(a[I]);      
                                         END.

Добавлено @ 20:51
вроде так... не тестил...

посмотри, если что напиши ошибки