Составить программу, которая определяет количество положительных элементов до последнего нулевого элемента

@m@l@a · Регистрация: 14.12.2009

РЕБЯТ,ППОМОГИТЕ ПОЖАЛУЙСТА
1)Составить программу для нахождения суммы минимального и максимального значений среди элементов каждой из линейных таблиц Х[10] и Y[6].C использованием функций.

2)Составить программу упорядочивания последовательности 4 данных чисел x,y,z,t по убыванию с использованием подпрограммы-процедуры упорядочивания.С использованием процедур

3)Составить программу, которая определяет количество положительных элементов до последнего нулевого элемента и количество отрицательных после него в массивах Y(N) и X(M).С использованием процедур

4) Составить программу, которая преобразует массивы А(1..7) и В(1..10) следующим образом: до минимального элемента упорядочивает по возрастанию, а после него – по убыванию. Учесть, что в каждом из массивов значения элементов не повторяются.С использованием процедур

Добавлено через 16 минут
вот 1 я решила,а вывести мах и мин не могу.ПОДСКАЖИТЕ ПОЖАЛУЙСТА

Pascal

type massiv=array[1..100]of integer;
var x,y:massiv;
i,max,min,n,m:integer;
procedure vvod(a:massiv;e:integer;c:char);
var i:integer;
begin
write('введте размерность массива ',c,': ');
readln(e);
for i:=1 to e do
a[i]:=random(10)-5;
end;
procedure vivod(a:massiv;e:integer;c:char);
var i:integer;
begin
write('введте массив ',c);
for i:=1 to e do
write(a[i],' ');
writeln;
end;
function element(a:massiv;m,i,max,min:integer):real;
begin
max:=a[1];
min:=a[1];
for i:=2 to m do
if max<a[i] then
max:=a[i] else
if min>a[i] then
min:=a[i];
end;
begin
vvod(y,n,'y');
vvod(x,m,'x');
vivod(y,n,'y');
vivod(x,m,'x');

@Snoopy · 06.01.2010, 17:40

Сообщение от m@l@a

)Составить программу упорядочивания последовательности 4 данных чисел x,y,z,t по убыванию с использованием подпрограммы-процедуры упорядочивания.С использованием процедур

можно представить как массив или нужно только как числа?

Добавлено через 6 минут
3

Pascal

uses crt;
const n=10;
      m=10;
Type xrr=array[1..100] of integer;
     yrr=array[1..100] of integer;
 
procedure Masx(x:xrr; var pol,otr:integer);
var i,j,tempi:integer;
begin
 for i:=1 to n do
  if x[i]=0 then
   tempi:=i;
 pol:=0;
  for i:=1 to tempi-1 do
   if x[i]>0 then
    pol:=pol+1;
 otr:=0;
  for i:=tempi+1 to n do
   if x[i]<0 then
    otr:=otr+1;
end;
 
procedure Masy(y:yrr; var pol,otr:integer);
var i,j,tempi:integer;
begin
 for i:=1 to m do
  if y[i]=0 then
   tempi:=i;
 pol:=0;
  for i:=1 to tempi-1 do
   if y[i]>0 then
    pol:=pol+1;
 otr:=0;
  for i:=tempi+1 to n do
   if y[i]<0 then
    otr:=otr+1;
end;
 
var x:xrr;
    y:yrr;
    i,j,p1,p2,k1,k2:integer;
begin
ClrScr;
Randomize;
for i:=1 to n do
 begin
  x[i]:=random(20)-10;
  Write(x[i]:4);
 end;
Writeln;
Masx(x,p1,k1);
Writeln('Kol(pol) ',p1);
Writeln('Kol(otr) ',k1);
Writeln;
for i:=1 to m do
 begin
  y[i]:=random(20)-10;
  Write(y[i]:4);
 end;
Writeln;
Masy(y,p2,k2);
Writeln('Kol(pol) ',p2);
Writeln('Kol(otr) ',k2);
Readln;
end.

@insolent · 06.01.2010, 18:28

3.

Pascal

Program zero;
  Uses Crt;
  Const num = 100;
  Type
     arr = array[1..num] of integer;
  Var
    x,y : arr;
    n,m,k : byte;
 
  Function Find_Last_Zero(a : arr;
                          n : byte) : byte;
    Var i : byte;
    Begin
      Find_Last_Zero := 0;
      For i := n downto 1 do
        If a[i] = 0 Then
          Begin
            Find_Last_Zero := i;
            Break;
          End;
    End;
 
  Function Num_pos(a : arr) : byte;
    Var i,m : byte;
    Begin
      m := 0;
      For i := 1 to Find_last_Zero(x,m) do
        If a[i] > 0 Then Inc(m);
      Num_pos := m;
    End;
 
  Function Num_neg(a : arr;
                   n : byte) : byte;
    Var i,m : byte;
    Begin
      m := 0;
      For i := Find_last_Zero(x,m) to n do
        If a[i] < 0 Then Inc(m);
      Num_neg := m;
    End;
 
  Procedure InPut(var a : arr;
                  n : byte);
    Var i : byte;
    Begin
      Randomize;
      For i := 1 to n do
        a[i] := random(10)-5;
    End;
 
  Procedure Out(a : arr;
                n : byte);
    Var i : byte;
    Begin
      For i := 1 to n do
        Write(a[i]:6);
      Writeln;
    End;
 
BEGIN
  ClrScr;
  Write('Введите размерность Y(n): '); Readln(n);
  Write('Введите размерность X(m): '); Readln(m);
  InPut(x,m); Writeln('Массив X:'); Out(x,m);
  InPut(y,n); Writeln('Массив Y:'); Out(y,n);
  Writeln(Find_last_Zero(x,m),' - позиция последнего нулевого элемента мас. X.');
  Writeln('Положительных: ',Num_pos(x));
  Writeln('Отрицательных: ',Num_neg(x,m));
  Writeln(Find_last_Zero(y,n),' - позиция последнего нулевого элемента мас. Y.');
  Writeln('Положительных: ',Num_pos(y));
  Writeln('Отрицательных: ',Num_neg(y,n));
  Readkey;
END.

Добавлено через 11 секунд
Ой, уже ответили)

Добавлено через 34 минуты
1.

Pascal

Program m_m;
  Uses Crt;
  Const 
    num = 10;
    n = 10;
    m = 6;
  Type arr = array[1..num] of integer;
  Var
    x,y : arr;    
  
  Procedure Min_max(a : arr;
                    var min,max : integer;
                    n : byte);
    Var i : byte;
    Begin
      min := a[1];
      max := a[1];
      For i := 2 to n do
        Begin
           If a[i] > max Then max := a[i];
           If a[i] < min Then min := a[i];
        End;    
    End;
    
  Function Sum(a : arr;
               n : byte) : integer;
    Var min,max : integer;
    Begin
      Min_Max(a,min,max,n);
      Sum := min + max;
    End;
    
  Procedure InPut(var a : arr;
                  n : byte);
    Var i : byte;
    Begin
      {Randomize;}  
      For i := 1 to n do
        a[i] := random(20) - 10;
    End;
  
  Procedure Out(a: arr;
                n : byte);
    Var i : byte;
    Begin
      For i := 1 to n do
        Write(a[i]:6);
      Writeln;  
    End;
    
BEGIN
  ClrSrc;
  InPut(x,n); Writeln('Массив X:'); Out(x,n);
  InPut(y,m); Writeln('Массив Y:'); Out(y,m);
  Writeln('Сумма min и max массива X: ',Sum(x,n));
  Writeln('Сумма min и max массива Y: ',Sum(y,m));
  Readkey;
END.

@m@l@a · 07.01.2010, 15:10 **[ТС]**

спасибочки ребят большое.спасли)))
а 1 и 4 незнаете как решить?

@Snoopy · 07.01.2010, 15:57

4 единственное я не предустмаривал, чтоб элементы не повторялись

Pascal

uses crt;
Type arr=array[1..7] of integer;
     brr=array[1..10] of integer;
procedure Masa(a:arr);
var min,ai,i,j,x:integer;
begin
min:=a[1];
 for i:=1 to 7 do
  if a[i]<min then
   begin
    min:=a[i];
    ai:=i;
   end;
 for i:=1 to ai-1 do
  for j:=1 to ai-1 do
   if a[i]<a[j] then
    begin
     x:=a[i];
     a[i]:=a[j];
     a[j]:=x;
    end;
 for i:=ai+1 to 7 do
  for j:=ai+1 to 7 do
   if a[i]>a[j] then
    begin
     x:=a[i];
     a[i]:=a[j];
     a[j]:=x;
    end;
 for i:=1 to 7 do
  Write(a[i]:4);
Writeln;
Writeln('Min ',min,' [',ai,']');
Writeln;
end;
procedure Masb(b:brr);
var i,j,min,bi,x:integer;
begin
min:=b[1];
 for i:=1 to 7 do
  if b[i]<min then
   begin
    min:=b[i];
    bi:=i;
   end;
 for i:=1 to bi-1 do
  for j:=1 to bi-1 do
   if b[i]<b[j] then
    begin
     x:=b[i];
     b[i]:=b[j];
     b[j]:=x;
    end;
 for i:=bi+1 to 10 do
  for j:=bi+1 to 10 do
   if b[i]>b[j] then
    begin
     x:=b[i];
     b[i]:=b[j];
     b[j]:=x;
    end;
 for i:=1 to 10 do
  Write(b[i]:4);
Writeln;
Writeln('Min ',min,' [',bi,']');
Writeln;
end;
 
var a:arr;
    b:brr;
    i,j:integer;
begin
ClrScr;
Randomize;
Writeln('A');
for i:=1 to 7 do
 begin
  a[i]:=random(20)-10;
  Write(a[i]:4);
 end;
Writeln;
Masa(a);
Writeln('B');
for i:=1 to 10 do
 begin
  b[i]:=random(20)-10;
  Write(b[i]:4);
 end;
Writeln;
Masb(b);
Readln;
end.

@m@l@a · 07.01.2010, 17:21 **[ТС]**

это 4?

@Snoopy · 07.01.2010, 17:24

да

Добавлено через 28 секунд
п первая уже решена, вам писали

Добавлено через 1 минуту
насчет второй вопрос, можно ли представить как массив числа?

@m@l@a · 07.01.2010, 17:43 **[ТС]**

ДА

@Snoopy · 08.01.2010, 22:42

Pascal

uses crt;
const n=4;
Type arr=array[1..n] of integer;
procedure Sort(a:arr; x,y,z,t:integer);
var i,j,k:integer;
begin
 a[1]:=x;
 a[2]:=y;
 a[3]:=z;
 a[4]:=t;
 for i:=1 to n do
  for j:=i to n do
   if a[i]<a[j] then
    begin
     k:=a[i];
     a[i]:=a[j];
     a[j]:=k;
    end;
 for i:=1 to n do
  Write(a[i],'  ');
end;
var a:arr;
    x,y,z,t:integer;
begin
ClrScr;
Readln(x,y,z,t);
Sort(a,x,y,z,t);
Readln;
end.

@m@l@a 0 / 0 / 0 Регистрация: 14.12.2009 Сообщений: 63
	07.01.2010, 15:10 [ТС]	4
	спасибочки ребят большое.спасли))) а 1 и 4 незнаете как решить? 0

@m@l@a 0 / 0 / 0 Регистрация: 14.12.2009 Сообщений: 63
	07.01.2010, 17:21 [ТС]	6
	это 4? 0

@Snoopy 1915 / 1065 / 384 Регистрация: 06.12.2008 Сообщений: 2,802
	07.01.2010, 17:24	7
	да Добавлено через 28 секунд п первая уже решена, вам писали Добавлено через 1 минуту насчет второй вопрос, можно ли представить как массив числа? 1

@m@l@a 0 / 0 / 0 Регистрация: 14.12.2009 Сообщений: 63
	07.01.2010, 17:43 [ТС]	8
	ДА 0

Опции темы