Модераторы: Snowy, MetalFan, bems, Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Процедура 
V
    Опции темы
Vaz007
Дата 22.11.2011, 20:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 114
Регистрация: 13.5.2009
Где: Москва

Репутация: нет
Всего: нет



Ввести элементы матрицы А(8,8). Сформировать вектор В, элементами которого являются средние арифметические значения неотрицательных элементов строк матрицы А. Определить минимальный элемент вектора В. Элементы, предшествующие ему переставить в убывающем порядке, после – в возрастающем порядке. При выводе результатов элементы вектора В вывести в строчку с точностью до 3-х знаков. Сортировку оформить в виде подпрограммы.
Помогите написать процедуру:
Код

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const N1 = 8;
      N2 = 8;
 Type mass = array[1..N1,1..N2] of real;

 var A:mass;
 var i,j,k,index_min:integer; Sr_sum,min_B,buf1,buf2:real;
 var B:array[1..N1] of real;


 Procedure Sort (x: array [1..N1] of integer);
    Begin

End;

 begin
   index_min:=0;
   for i:=1 to N1 do
   for j:=1 to N2 do
   readln(A[i][j]);    //Ввод массива

   for i:=1 to N1 do
   begin
    Sr_sum:=0;
    k:=0;
   for j:=1 to N2 do
     if(A[i][j]>0) then
       begin
     Sr_sum:=Sr_sum+A[i][j];
     k:=k+1;
        end;
   B[i]:=Sr_zn/k;
    end;                     //Инициализация массива B
      min_B:=B[1];

     for i:=1 to N1 do
     begin
    // writeln(floattostr(B[i])+' ');
      if(min_B>B[i]) then
      begin
      min_B:=B[i];
      index_min:=i;                //Нахождение минимального и индекса минимального
      end;

      end;
    //  writeln(floattostr(index_min));
                                       //здесь проблемы как для общего случая c помощью процедуры написать
      for i:=1 to index_min do
       for j:=1 to index_min-i do


       if(B[j]<B[j+1]) then
       begin
       buf1:=B[j+1];
       B[j+1]:=B[j];
       B[j]:=buf1;
       end;

       for i:=index_min+1 to N1 do
       for j:=index_min+1  to N1-1 do
         if(B[j]>B[j+1] ) then
       begin
       buf2:=B[j+1];
       B[j+1]:=B[j];
       B[j]:=buf2;
       end ;



        for i:=1 to N1 do
         writeln(floattostr(B[i])+' ');                  //Вывод массива
    readln;

end.

PM MAIL Jabber   Вверх
14SatanA88
Дата 22.11.2011, 21:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 393
Регистрация: 13.5.2010

Репутация: нет
Всего: 5



Код

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  n=8;

type
  TMas = array [1..n, 1..n] of integer;
  TVector = array [1..n] of real;

var
  A: TMas;
  B: TVector;
  index: integer;

procedure Initialize(var mas: TMas);
var i,j: integer;
begin
  Randomize;
  for i:=1 to n do
    for j:=1 to n do
      mas[i,j]:=Random(99)-Random(99);
end;

procedure ShowMas(mas: TMas);
var i,j: integer;
begin
  for i:=1 to n do
  begin
    for j:=1 to n do
      write(mas[i,j]:4);
    writeln;
  end;
end;

procedure GetVector(var vector: TVector; mas: TMas);
var i,j: integer;
    avgsum, avgkol: integer;
begin
  for i:=1 to n do
  begin
    avgsum:=0;
    avgkol:=0;
    for j:=1 to n do
      if mas[i,j]>=0 then
      begin
        avgsum:=avgsum+mas[i,j];
        inc(avgkol);
      end;
    if avgkol<>0 then vector[i]:=avgsum/avgkol else vector[i]:=0;
  end;
end;

procedure ShowVector(vector: TVector);
var i: integer;
begin
  for i:=1 to n do write(vector[i]:8:3);
end;

function FindMin(vector: TVector): integer;
var min: real;
    i, index: integer;
begin
  min:=vector[1];
  index:=1;
  for i:=1 to n do
    if vector[i]<min then
    begin
      min:=vector[i];
      index:=i;
    end;
  result:=index;
end;

procedure Swap(var a,b: real);
var t: real;
begin
  t:=a;
  a:=b;
  b:=t;
end;

procedure Sort(var vector: TVector; minindex: byte);
var i,j: integer;
begin
  for i:=1 to minindex-1 do
    for j:=1 to minindex-1 do
      if vector[i]>vector[j] then Swap(vector[i],vector[j]);
  for i:=minindex+1 to n do
    for j:=minindex+1 to n do
      if vector[i]<vector[j] then Swap(vector[i],vector[j]);
end;

begin

  Initialize(A);
  writeln('source array');
  ShowMas(A);
  writeln('source vector');
  GetVector(B,A);
  ShowVector(B);
  writeln;
  writeln('index of min = ',FindMin(B));
  Sort(B,FindMin(B));
  writeln('sorted vector');
  ShowVector(B);

  writeln;
  write('press any key');
  readln;

end.


вот
PM MAIL ICQ   Вверх
Vaz007
Дата 22.11.2011, 22:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 114
Регистрация: 13.5.2009
Где: Москва

Репутация: нет
Всего: нет



спасибо большое))))
PM MAIL Jabber   Вверх
14SatanA88
Дата 22.11.2011, 22:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 393
Регистрация: 13.5.2010

Репутация: нет
Всего: 5



ну закрывайте тему
PM MAIL ICQ   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Для новичков | Следующая тема »


 




[ Время генерации скрипта: 0.0435 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.