33 / 33 / 43
Регистрация: 07.02.2014
Сообщений: 89
|
|
24.12.2014, 16:01
|
2
|
 Сообщение было отмечено maastah как решение
Решение
| 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
| Uses crt;
Const nmax = 50;
Type mas = array[1..nmax] of integer;
Var a : mas;
i, j, n, k, neg : byte;
za, zb : boolean;
Function F(x:mas; b:byte) : byte;
Var indx:byte;
Begin
indx:=0;
For i:=1 to b do
if x[i] < 0 then
begin
indx:=i;
break
end;
F:=indx;
End;
Procedure Newmas(var x:mas; b:byte);
Begin
For i:=1 to b do x[i]:=Random(30)-6;
End;
Procedure Print(var x:mas; b:byte);
Begin
For i:=1 to b do Write(x[i],' '); WriteLn;
End;
BEGIN
clrscr;
Randomize;
Repeat
Write('Введите размер массива : ');
ReadLn(n);
Until ( ( n>0 ) and ( n<51 ) );
Newmas(a,n);
Print(a,n);
neg:=F(a,n);
IF neg<>0 THEN
Begin
WriteLn('Первое отрицательное число находится на ',neg,' элементе');
za:=false;
zb:=false;
k:=1;
WHILE k<>neg DO
Begin
if ( (odd (a[k])) and (za=false) ) then
begin
WriteLn('Удалили первое нечётное число : ',a[k]);
for j:=k to n-1 do a[j]:=a[j+1];
za:=true;
n:=n-1;
dec(k)
end;
if ( (not odd (a[k])) and (zb=false) ) then
begin
WriteLn('Удалили первое чётное число : ',a[k]);
for j:=k to n-1 do a[j]:=a[j+1];
zb:=true;
n:=n-1;
dec(k)
end;
inc(k);
neg:=F(a,n)
End;
WriteLn('Массив после удаления :');
Print(a,n)
End
ELSE WriteLn('Массив не имеет отрицательных чисел');
Readkey
END. |
|
Добавил процедуру Delete
| 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
| Uses crt;
Const nmax = 50;
Type mas = array[1..nmax] of integer;
Var a : mas;
i, j, n, k, neg : byte;
za, zb : boolean;
Function F(x:mas; b:byte) : byte;
Var indx:byte;
Begin
indx:=0;
For i:=1 to b do
if x[i] < 0 then
begin
indx:=i;
break
end;
F:=indx;
End;
Procedure Newmas(var x:mas; b:byte);
Begin
For i:=1 to b do x[i]:=Random(30)-6;
End;
Procedure Print(var x:mas; b:byte);
Begin
For i:=1 to b do Write(x[i],' '); WriteLn;
End;
Procedure Delete(var v:boolean; s:string);
Begin
WriteLn('Удалили первое ',s,' число : ',a[k]);
for j:=k to n-1 do a[j]:=a[j+1];
v:=true;
n:=n-1;
dec(k)
End;
BEGIN
clrscr;
Randomize;
Repeat
Write('Введите размер массива : ');
ReadLn(n);
Until ( ( n>0 ) and ( n<51 ) );
Newmas(a,n);
Print(a,n);
neg:=F(a,n);
IF neg<>0 THEN
Begin
WriteLn('Первое отрицательное число находится на ',neg,' элементе');
za:=false;
zb:=false;
k:=1;
WHILE k<>neg DO
Begin
if ( (odd (a[k])) and (za=false) ) then Delete(za,'нечётное');
if ( (not odd (a[k])) and (zb=false) ) then Delete(zb,'чётное');
inc(k);
neg:=F(a,n)
End;
WriteLn('Массив после удаления :');
Print(a,n)
End
ELSE WriteLn('Массив не имеет отрицательных чисел');
Readkey
END. |
|
1
|
(
Сообщение было отмечено maastah как решение
