Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 05.11.2011, 23:34   #1
Camaro Chevelle
Форумчанин
 
Регистрация: 05.11.2011
Сообщений: 102
По умолчанию исследование Алгоритмов Сортировки

Приветствую всех! постараюсь коротко изложить суть дела. В универе задание сделать отчёт по алгоритмам сортировки пузырьком, простыми вставками и Шеллом. Сделать надо на Паскале, Фортране и Си++. Написал исходник на Паскале. Для краткости всё сделал в одной проге с использованием директив условной компиляции. В зависимости от условных символов, определённых в начале проги выбирается алгоритм сортировки, происходит исследование времени, числа сравнений или числа пересылок. Массив тоже в зависимости от условных директив отсортированный, обратно отсортированный или случайный, это в задании нужно для того, чтобы исследовать наилучший, наихудший и "среднестатистический" случай. Так вот, ребята, проблема в том, что я ни бум-бум в Фортране вообще. А сроки жмут... Не могли бы вы помочь? Вот выкладываю своё "чудо" на Паскале. Надо сделать примерно такое же, но на Фортране. Да, чуть не забыл. Для измерения времени в проге есть нестандартный модуль measure2. В нем есть процедуры StartTimer, StopTimer и функция GetTime, возвращающая время в секундах, прошедшее с момента вызова StartTimer до момента вызова StopTimer.
Camaro Chevelle вне форума Ответить с цитированием
Старый 05.11.2011, 23:36   #2
Camaro Chevelle
Форумчанин
 
Регистрация: 05.11.2011
Сообщений: 102
По умолчанию

Код:
{$A+,B-,D+,E-,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S-,T-,V-,X-}
{$M 16384,0,655360}
{$Define Time}     (* если определён условный символ Time,        *)
                   (* исследуется время поиска, в противном       *)
                   (* случае исследуются сравнения и пересылки    *)
{$Define AdvBubble}(* определяет алгоритм сортировки: AdvBubble   *)
                   (* - улучшенная пузырьковая сортировка,        *)
                   (* Insert – сортировка простыми вставками,     *)
                   (* Shell - сортировка методом Шелла.           *)
{$Define Ascend}   (* определяет тип исследуемого массива:        *)
                   (* Random – случайный массив, Ascend -         *)
                   (* отсортированный массив, Descend – обратно   *)
                   (* отсортированный массив.                     *)
{$Define ShellSeq} (* определяет последовательность шагов,        *)
                   (* используемую в сортировке методом Шелла:    *)
                   (* ShellSeq – последовательность Шелла,        *)
                   (* HibbardSeq – последовательность Хиббарда,   *)
                   (* SedgewickSeq – последовательность Седжвика, *)
                   (* PrattSeq – последовательность Пратта.       *)
{$IfDef Time}
  Uses
    Measure2;
{$EndIf}
Const
  Rows=10;
  Meas=100;
  Skip=100;
  Nmax=Rows*Skip;
  Iterations=
    {$IfDef Shell}
      1000;
      Smax=32
    {$Else}
      10000
    {$EndIf};
Type
  Data=String[11];
  Key=String[11];
  Item=
    Record
      Data: Data;
      Key: Key;
    End;
  Structure=
    Record
      Item: Array[1..Nmax] Of Item;
      Count: Integer;
    End;
  {$IfDef Shell}
      Steps=
        Record
          Item: Array[1..Smax] Of Integer;
          Count: Integer;
        End;
    Procedure FillSteps(Var s: Steps; n: Integer);
      Var
        i, Buf {$IfDef PrattSeq}, j {$EndIf}: Integer;
      Begin
        With s Do Begin
          {$IfDef ShellSeq}
            i:=1;
            Item[1]:=n Shr 1;
            Count:=1;
            While Item[i]>1 Do Begin
              Inc(i);
              Item[i]:=Item[i-1] Shr 1;
              Inc(Count);
            End;
          {$EndIf}
          {$IfDef HibbardSeq}
            i:=0;
            Count:=0;
            While i<n Shr 2 Do Begin
              i:=i Shl 1+1;
              Inc(Count);
            End;
            For i:=1 To Count Shr 1 Do Begin
              Buf:=Item[i];
              Item[i]:=Item[Count-i+1];
              Item[Count-i+1]:=Buf;
            End;
          {$EndIf}
          {$IfDef SedgewickSeq}
            i:=1;
            Item[1]:=1;
            While 3*Item[i]<=n Do Begin
              Inc(i);
              If i And 1<>0 Then
                Item[i]:=1 Shl (i+3)-6*Round(Exp((i+1)*0.5*Ln(2)))+1
              Else
                Item[i]:=9*(1 Shl i)-Round(Exp(i*0.5*Ln(2)))+1;
            End;
            Count:=i;
            For i:=1 To i Shr 1 Do Begin
              Buf:=Item[i];
              Item[i]:=Item[Count-i+1];
              Item[Count-i+1]:=Buf;
            End;
          {$EndIf}
          {$IfDef PrattSeq}
            i:=1;
            Count:=0;
            While i<=n Div 6 Do Begin
              j:=1;
              While i*j<n Shr 1 Do Begin
                Inc(Count);
                Item[Count]:=i*j;
                j:=j*3;
              End;
              i:=i Shl 1;
            End;
            For i:=1 To Count-1 Do
              For j:=i+1 To Count Do
                If Item[i]<Item[j] Then Begin
                  Buf:=Item[i];
                  Item[i]:=Item[j];
                  Item[j]:=Buf;
                End;
          {$EndIf}
        End;
      End;
  {$EndIf}
Camaro Chevelle вне форума Ответить с цитированием
Старый 05.11.2011, 23:37   #3
Camaro Chevelle
Форумчанин
 
Регистрация: 05.11.2011
Сообщений: 102
По умолчанию

Код:
Procedure FillStructure(Var Structure: Structure; n: Integer);
  Var
    i, j: Integer;
    d: Data;
    k: Key;
    {$IfNDef Random}
      Buf: Item;
    {$EndIf}
    ad: Array[0..SizeOf(Data)-1] Of Byte Absolute d;
    ak: Array[0..SizeOf(Key)-1] Of Byte Absolute k;
  Begin
    With Structure Do Begin
      Count:=0;
      For i:=1 To n Do Begin
        ad[0]:=1+Random(SizeOf(Data)-1);
        For j:=1 To ad[0] Do
          ad[j]:=Random(256);
        ak[0]:=1+Random(SizeOf(Key)-1);
        For j:=1 To ak[0] Do
          ak[j]:=Random(256);
        Item[i].Data:=d;
        Item[i].Key:=k;
        Inc(Count);
      End;
      {$IfNDef Random}
        For i:=1 To n-1 Do
          For j:=i+1 To n Do
            If Item[i].Key
              {$IfDef Ascend}
                >
              {$Else}
                <
              {$EndIf}
              Item[j].Key Then Begin
                Buf:=Item[i];
                Item[i]:=Item[j];
                Item[j]:=Buf;
            End;
      {$EndIf}
    End;
  End;
Procedure Sort
  (Var Structure: Structure
  {$IfDef Shell};
    Steps: Steps
  {$EndIf}
  {$IfNDef Time};
    Var Comps, Swaps: LongInt
  {$EndIf});
  Var
    i, j
    {$IfDef Shell},
      k
    {$EndIf}
    {$IfDef AdvBubble},
      Saved, Last
    {$EndIf}: LongInt;
    Buf: Item;
  Begin
    With Structure Do Begin
      {$IfDef AdvBubble}
        Last:=1;
        Repeat
          Saved:=Last;
          For j:=Count DownTo Last+1 Do Begin
            If Item[j].Key<Item[j-1].Key Then Begin
              Buf:=Item[j];
              Item[j]:=Item[j-1];
              Item[j-1]:=Buf;
              {$IfNDef Time}
                Inc(Swaps);
              {$EndIf}
              Last:=j;
            End;
            {$IfNDef Time}
              Inc(Comps);
            {$EndIf}
          End;
        Until Last=Saved;
      {$EndIf}
      {$IfDef Insert}
        For i:=2 To Count Do Begin
          Buf:=Item[i];
          j:=i-1;
          While (j>0) And (Buf.Key<Item[j].Key) Do Begin
            {$IfNDef Time}
              Inc(Comps, Ord(j>0));
            {$EndIf}
            Item[j+1]:=Item[j];
            Dec(j);
          End;
          Item[j+1]:=Buf;
          {$IfNDef Time}
            Inc(Comps, Ord(j>0));
            Inc(Swaps);
          {$EndIf}
        End;
      {$EndIf}
      {$IfDef Shell}
        For k:=1 To Steps.Count Do
          For i:=Steps.Item[k]+1 To Count Do Begin
            Buf:=Item[i];
            j:=i-Steps.Item[k];
            While (j>0) And
              (j<Count) And
              (Buf.Key<Item[j].Key) Do Begin
                {$IfNDef Time}
                  Inc(Comps);
                {$EndIf}
                Item[j+Steps.Item[k]]:=Item[j];
                Dec(j, Steps.Item[k]);
            End;
            Item[j+Steps.Item[k]]:=Buf;
            {$IfNDef Time}
              Inc(Comps, Ord((j>0) And (j<Count)));
              Inc(Swaps);
            {$EndIf}
          End;
      {$EndIf}
    End;
  End;
Camaro Chevelle вне форума Ответить с цитированием
Старый 05.11.2011, 23:37   #4
Camaro Chevelle
Форумчанин
 
Регистрация: 05.11.2011
Сообщений: 102
По умолчанию

и вот, собственно сама программа.
Код:
Var
  a, b: Structure;
  q, j {$IfDef Time}, i {$Else}, Cmp, Swp {$EndIf}: LongInt;
  {$IfDef Time}
    Time: Double;
  {$EndIf}
  {$IfDef Shell}
    s: Steps;
  {$EndIf}
Begin
  Randomize;
  For q:=1 To Rows Do Begin
    {$IfDef Shell}
      FillSteps(s, q*Skip);
    {$EndIf}
    {$IfDef Time}
      Time:=0;
    {$Else}
      Cmp:=0;
      Swp:=0;
    {$EndIf}
    For j:=1 To Meas Do Begin
      FillStructure(a, q*Skip);
      {$IfDef Time}
        StartTimer;
        For i:=1 To Iterations Do Begin
          b:=a;
          Sort(b {$IfDef Shell}, s {$EndIf});
        End;
        StopTimer;
        Time:=Time+GetTime;
        StartTimer;
        For i:=1 To Iterations Do
          b:=a;
        StopTimer;
        Time:=Time-GetTime;
      {$Else}
        Sort(a {$IfDef Shell}, s {$EndIf}, Cmp, Swp);
      {$EndIf}
    End;
    WriteLn(q*100, ' items - ',
      {$IfDef Time}
        Time/Iterations/Meas*1000000:0:2, ' mcs'
      {$Else}
        Cmp/Meas:0:2, ' comparisons, ', Swp/Meas:0:2, ' swaps'
      {$EndIf});
  End;
End.

Последний раз редактировалось Camaro Chevelle; 06.11.2011 в 04:20.
Camaro Chevelle вне форума Ответить с цитированием
Старый 06.11.2011, 11:41   #5
Camaro Chevelle
Форумчанин
 
Регистрация: 05.11.2011
Сообщений: 102
По умолчанию

Ребят, ну помогите! напишите хотя бы процедуру сортировки, остальное уж как-нибудь сам...
Camaro Chevelle вне форума Ответить с цитированием
Старый 06.11.2011, 21:59   #6
Camaro Chevelle
Форумчанин
 
Регистрация: 05.11.2011
Сообщений: 102
По умолчанию

Народ, выяснилось, что только процедуры сортировки на Фортране нужны, остальное не надо. Жду помощи
Camaro Chevelle вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сравнение алгоритмов сортировки массива Семен_Владимирович Общие вопросы C/C++ 2 15.02.2011 19:02
Исследование алгоритмов линейного и двоичного поиска (язык C) Best1501 Помощь студентам 0 07.12.2010 07:05
Освоение алгоритмов сортировки элементов двумерных массивов. николай28 Паскаль, Turbo Pascal, PascalABC.NET 1 31.05.2010 22:30
Исследование jQuery VeronicaDream Фриланс 5 02.04.2010 19:15