Форум программистов, компьютерный форум, киберфорум
Наши страницы
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
Real Madrid
1 / 1 / 1
Регистрация: 23.05.2013
Сообщений: 202
#1

Удалить все элементы массива до первого четного - Turbo Pascal

25.09.2013, 09:46. Просмотров 349. Ответов 6
Метки нет (Все метки)

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
program Lab1;
uses crt;
var f:file of integer;
    g:file of integer;
    k:byte;
    n,i,j,count:integer;
    a:array[0..1000] of integer;
 
    begin
    clrscr;
    Assign (f,'d:\r\data1.txt');
    Assign (g,'d:\r\data2.txt');
    reset(f);
    reset(g);
 
    IF filesize (f)=0 then
    begin
       Rewrite (f);
        repeat
 
         Writeln ('@___@_____@_____@______@______@@@____@_');
         Writeln ('@___@____@_@____@______@_____@___@__@@@');
         Writeln ('@@@@@___@@@@@___@______@_____@___@__@@@');
         Writeln ('@___@__@_____@__@______@_____@___@___');
         Writeln ('@___@__@_____@__@@@@@__@@@@@__@@@____@');
         Writeln;
         Writeln;
         Writeln ('File pust i gotov k zapisi');
         Writeln;
         Write ('vvedite kolichestvo chisel n=');
         Readln (n);
             writeln ('Vvedite elementi massiva:');
             for i:=1 to n do
             begin
             Write('a[',i,']=');
             read (a[i]);
             write (f,a[i]);
             end;
 
                                j:=0;
                                k:=0;
                                for i:=1 to n do
                                begin
                                if (a[i] mod 2 =0) then
                                k:=i;
                                end;
 
                                if k=0 then
                                writeln('V massive net chisla chetnoe');
                                if k=1 then writeln('Chislo chetnoe stoit na 1 meste')
                                else
                                begin
                                     for i:=1 to k-1 do
                                     begin
                                         for k:=i to n-1 do
                                             a[j]:=a[j+1];
                                                 n:=n-1;
                                     end;
 
                                     for i:=1 to n do
                                     begin
                                     writeln(a[i]);
                                     write (g,a[i]);
                                     end;
 
                                 end;
Write ('Nachat zanovo?   1-Da, 2-Net  = ');
read(k);
until k=2;
WriteLn('seans raboti zakonchen, nagmite Enter');
Close (f);
Close (g);
    end
    else
         begin
         Writeln ('@___@_____@_____@______@______@@@____@_');
         Writeln ('@___@____@_@____@______@_____@___@__@@@');
         Writeln ('@@@@@___@@@@@___@______@_____@___@__@@@');
         Writeln ('@___@__@_____@__@______@_____@___@___');
         Writeln ('@___@__@_____@__@@@@@__@@@@@__@@@____@');
         Writeln;
         Writeln;
         Writeln ('File ne pust');
         Writeln;
Writeln ('soderzhimoe iskhodnogo fayla');
While Not Eof(f) Do
begin
read (f,a[i]);
writeln(a[i]);
end;
Writeln;
Writeln ('soderzhimoe rezult. fail');
While Not Eof(g) Do
begin
read (g,a[i]);
writeln(a[i]);
end;
 
           WriteLn('Menu:');
           WriteLn;
 
           WriteLn('Vibrat deystvie:');
           WriteLn( '1 - Perezapisat.');
           WriteLn( '2 - Vihod.');
            Read(count);
            case count of
            1 :
            begin
            repeat
            rewrite (f);
            rewrite (g);
            Writeln ('vvedite kolichestvo chisel n=');
           Readln (n);
               writeln ('Vvedite elementi massiva:');
               for i:=1 to n do
               begin
               Write('a[',i,']=');
               read (a[i]);
               write (f,a[i]);
               end;
            reset (f);
            j:=0;
            k:=0;
              for i:=1 to n do
              begin
              if (a[i] mod 2 =0) then
              k:=i;
              end;
 
                 if k=0 then
                 writeln('V massive net chisla  chetnoe');
                 if k=1 then writeln('Chislo chetnoe stoit na 1 meste')
                 else
                   begin
                   for i:=1 to k-1 do
                      begin
                      for k:=i to n-1 do
                      a[j]:=a[j+1];
                      n:=n-1;
                      end;
                   for i:=1 to n do
                   begin
                   writeln(a[i]);
                   write (g,a[i]);
                   end;
                 end;
Write ('Nachat zanovo?   1-Da, 2-Net  = ');
read(k);
until k=2;
WriteLn('seans raboti zakonchen, nagmite Enter');
            end;
           2 :
 
           WriteLn('seans raboti zakonchen, nagmite Enter');
            end;
 
            Close (f);
            Close (g);
           readln;
      end;
End.

http://www.cyberforum.ru/pascal/thread1871547.html
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
25.09.2013, 09:46
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Удалить все элементы массива до первого четного (Turbo Pascal):

Просматривая список в обратном направлении удалить все элементы до первого нулевого
Дан список l , элементы которого являются целыми числами . просматривая список...

Просматривая список в обратном направлении удалить все элементы до первого нулевого
Ребят!!помогите плиз решить задачу со списками Добавлено через 2 минуты...

Получить третий массив, в который входят все элементы первого массива и те элементы второго, которые не встречались в первом
Задача по теме "массив". "Объединение массивов". Напишите программу, которая...

Поиск первого четного элемента массива
Две задачи есть: 1. Слои пирамиды перенумерованы сверху вниз, начиная с...

Найти номер первого четного элемента массива.
Помогите с решением или блок-схемой плиз!!!! Заранее благодарен. Ввести...

6
Puporev
Модератор
54131 / 41764 / 28875
Регистрация: 18.05.2008
Сообщений: 98,291
25.09.2013, 10:16 #2
Цитата Сообщение от Real Madrid Посмотреть сообщение
Удалить все элементы массива до первого четного
Не программа, а чушь какая-то и какое отношение все это имеет к приведенному заданию?

Добавлено через 15 минут
Если чисто по условию, то так
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
uses crt;
const nmax=100;
var a:array[1..nmax] of integer;
    n,i,j,k:integer;
begin
clrscr;
randomize;
repeat
write('Размер массива до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Исходный массив:');
k:=0;
for i:=1 to n do
 begin
  a[i]:=random(50);
  write(a[i]:4);
  if(a[i] mod 2=0)and(k=0) then k:=i
 end;
writeln;
if k=0 then writeln('В масиве нет четных элементов')
else if k=1 then writeln('Элемент номер 1 четный, удаления нет')
else
 begin
  writeln('Первый четный элемент ',a[k],' имеет индекс=',k);
  for i:=1 to k-1 do
   begin
    for j:=1 to n-1 do
    a[j]:=a[j+1];
    n:=n-1
   end;
  writeln('Удаление');
  for i:=1 to n do
  write(a[i]:4);
 end;
readln
end.
0
Real Madrid
1 / 1 / 1
Регистрация: 23.05.2013
Сообщений: 202
06.10.2013, 17:14  [ТС] #3
Можете мне помочь с Меню
Вот моя программа:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
uses crt;
var f:file of integer;
    n,i,j,k:integer;
    c:integer;
    p,t:byte;
    {a:array[1..nmax] of integer;}
    a:array[0..1000] of integer;
Procedure MENU(var p:byte);
var i:byte;
Begin
writeln('Menu');
writeln('1.Vvod dannih');
writeln('2.Obrabotka dannih');
writeln('3.Vivod rezultatov');
writeln('4.vihod');
writeln;
writeln('vash vibor - ') ;
readln(p);
writeln;
end;
Begin
clrscr;
randomize;
Assign (f,'d:\w\data1.txt');
rewrite(f);
Begin
repeat
    MENU(p);
    Begin
    case p of
    1: Begin
Write ('vvedite kolichestvo chisel n=');
         Readln (n);
             writeln ('Vvedite elementi massiva:');
             for i:=1 to n do
             begin
             Write('a[',i,']=');
             read (a[i]);
             write (f,a[i]);
             end;
             end;
2:Begin
writeln;
k:=0;
for i:=1 to n do
 begin
  a[i]:=random(50);
  write(a[i]:4);
  if(a[i] mod 2=0)and(k=0) then k:=i
 end;
writeln;
if k=0 then writeln('В масиве нет четных элементов')
else if k=1 then writeln('Элемент номер 1 четный, удаления нет')
else
 begin
  writeln('Первый четный элемент ',a[k],' имеет индекс=',k);
  for i:=1 to k-1 do
   begin
    for j:=1 to n-1 do
    a[j]:=a[j+1];
    n:=n-1
   end;
  close(f);
 end;
end;
 3:Begin
writeln('Удаление');
  for i:=1 to n do
  write(a[i]:4);
 end;
 4:Begin
 readln;
end;
end;
until p=4;
end;
close(f);
readln;
 
end.
0
Puporev
Модератор
54131 / 41764 / 28875
Регистрация: 18.05.2008
Сообщений: 98,291
06.10.2013, 17:38 #4
Вот для чего здесь типизированный файл? Где и как он используется?
0
Real Madrid
1 / 1 / 1
Регистрация: 23.05.2013
Сообщений: 202
06.10.2013, 17:41  [ТС] #5
Если вы про Assign. Это файл (блокнот там результаты которые мы получим во время идентификации остаётся и через Rewrite я перезаписываю каждый раз) правильно думаю?
0
Puporev
Модератор
54131 / 41764 / 28875
Регистрация: 18.05.2008
Сообщений: 98,291
06.10.2013, 17:42 #6
Цитата Сообщение от Real Madrid Посмотреть сообщение
через Rewrite я перезаписываю каждый раз)
Ну и зачем? Ты пробовал его открывать?
0
Real Madrid
1 / 1 / 1
Регистрация: 23.05.2013
Сообщений: 202
06.10.2013, 17:45  [ТС] #7
Да у меня программа не идёт (компиляция) и результата нету а во первом программе (та которая в начале) у меня идёт но не сохр. в блокнот результат
0
06.10.2013, 17:45
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
06.10.2013, 17:45
Привет! Вот еще темы с решениями:

Вставить 0 после первого четного элемента массива
вставить 0 после первого четного элемента. Обязательно использовать как минимум...

После первого четного элемента массива вставить 0
после первого четного элемента вставить 0. С использованием процедур и функций...

После первого четного элемента массива вставить 0
После первого четного элемента вставить 0

Найти номер первого четного элемента массива
дан массив из N целых чисел, найти номер первого четного элемента массива


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
7
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru