Версия для печати темы

Автор: Militium 20.05.2007 22:14

Тянула до последнего, сдавать завтра... Помогите решить, сама две задачки сделала, надо еще три, а голова неварит

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

Отсортировать массив следующим образом: сначала все нулевые элементы, затем отрицательные и потом все положительные. - хоть убей....

Пусть даны числа R1, R2, R3 ... R17, среди которых есть как отрицательные, так и неотрицательные(положительные и нули). Получить x1*y1+x1*y2+...+x17*y17, где где x - отрицательные числа, в зятые в порядке их следования, y - неотрицательный, взятые в обратном порядке. - ваще улет...

Автор: мисс_граффити 20.05.2007 22:29

первые две точно решались
пользуйся поиском по форуму

Автор: Militium 20.05.2007 22:49

Первую то решила щас, а вот вторую немогу найти, и с третей трабл... <censored>короче

М

А вот ругаться не надо

Добавлено через 9 мин.
Учту)))


Вот, вторая, но там точно что-то неправильно, не подскажите что???

program r;
var a:array [1..10] of integer; j, y, k: integer; f : char;
Begin
for j:=1 to 10 do begin
readln (a[j]);
end;
k:=1; y:=10;
for j:=1 to 10 do begin
if a[j]=0 then begin a[j]:=a[k]; k:=k+1; end;
if a[j]>0 then begin a[j]:=a[y]; y:=y-1; end;
end;
for j:=1 to 10 do begin
write (a[j]:3);
end;
readln (f);
end. 

Автор: klem4 20.05.2007 23:19

Вторая что-то вроде этого:

uses crt;

const
  n = 11;

var
  x: Array [1..n] of Integer = (1, 0, -10, 0, 2, 3, -10, -3, 4, 0, 0);
  i, j, T, curr: Integer;
begin
  clrscr;
  for i := 1 to n do write(x[i]:3);

  curr := 1;

  while (curr < n) and (x[curr] = 0) do inc(curr);

  i := n;

  while (i > curr) do begin
    if x[i] = 0 then begin
      inc(curr);
      for j := i downto curr do begin
        T := x[j];
        x[j] := x[j - 1];
        x[j - 1] := T;
      end;
    end else dec(i);
  end;

  i := n;

  while (i > curr) do begin
    if x[i] < 0 then begin
      inc(curr);
      for j := i downto curr do begin
        T := x[j];
        x[j] := x[j - 1];
        x[j - 1] := T;
      end;
    end else dec(i);
  end;


  writeln;
  for i := 1 to n do write(x[i]:3);
  readln;
end.

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

Автор: Militium 20.05.2007 23:21

йоооооооооооооо

Автор: klem4 20.05.2007 23:36

Щас если успею, сделаю короче, одним циклом.

Вот третья:

const
  n = 11;

var
  x: Array [1..n] of Integer = (1, 0, 10, 0, 2, 3, 10, -3, -4, 0, -12);
  i, j, s: Integer;

begin
  for i := 1 to n do write(x[i]:3);

  i := 1;
  j := n;
  s := 0;

  repeat
    while (i < j) and (x[i] <= 0) do inc(i);
    if (i < j) then begin
      while (j > i) and (x[j] >= 0) do dec(j);
      if (i < j) then s := s + x[i] * x[j];
      dec(j);
      inc(i);
    end;
  until (i >= j);

  writeln;
  writeln(s);
end.

Автор: volvo 20.05.2007 23:56

Собственно, объединить-то практически одинаковые циклы надо было сразу... Copy+Paste - не наш метод

uses crt;

const
  n = 11;

var
  x: Array [1..n] of Integer = (1, 0, -10, 0, 2, 3, -10, -3, 4, 0, 0);
  i, j, T, curr: Integer;

  k, divider: integer;

begin
  clrscr;
  for i := 1 to n do write(x[i]:3);


  curr := 1;
  while (curr < n) and (x[curr] = 0) do inc(curr);


  for k := 0 downto -1 do begin

    i := n;

    while (i > curr) do begin

      divider := abs(x[i]);
      if x[i] = 0 then inc(divider);

      if (x[i] div divider) = k then begin
        inc(curr);
        for j := i downto curr do begin
          T := x[j];
          x[j] := x[j - 1];
          x[j - 1] := T;
        end;
      end else dec(i);
    end;

  end;

  writeln;
  for i := 1 to n do write(x[i]:3);
  readln;
end.