Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на языке Pascal

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 2.943 RSS
←   Октябрь 2009   →
 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


За последние 60 дней ни разу не выходила


Сайт рассылки: http://prog.rusfaq.ru/pascal
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

2.943 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на языке Pascal


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный платный хостинг на базе Windows 2008

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

_Ayl_
Статус: Студент
Рейтинг: 1364
∙ повысить рейтинг » 		Boriss
Статус: Академик
Рейтинг: 1047
∙ повысить рейтинг » 		Micren
Статус: Бакалавр
Рейтинг: 936
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И ПО / Программирование / Pascal

Номер выпуска:951
Дата выхода:17.10.2009, 21:30
Администратор рассылки:Калашников О.А., Руководитель
Подписчиков / экспертов:353 / 175
Вопросов / ответов:1 / 1

Вопрос № 173221: мм. вопрос следующий, точнее задание: Нужен код на паскале, с использованием указателей (списков) вместо массива:

Код:
   

   
   Вопрос № 173221:
   

   мм. вопрос следующий, точнее задание:
Нужен код на паскале, с использованием указателей (списков) вместо массива: 
Код:
{заполнение массива А случайными числами}
  writeln('Massiv A:');
  a[1]:=random(5);
  for i:=1 to (N-1) do
  begin
   repeat
   begin
    a[i+1]:=random(n+1);
   end;
   until
(a[i]<=a[i+1]);
  end;
  writeln;
                For i:=1 to n do
                write(a[i],' ');

   

   Отправлен: 12.10.2009, 21:27

   Вопрос задал: Hellphoenix, Посетитель 

   Всего ответов: 1

   Страница вопроса »
   

    Отвечает Micren, Бакалавр :

    Здравствуйте, Hellphoenix.
© Цитата: Hellphoenix
Нет условия, мне нужно понять принцип работы указателей на конкретном примере: заполнить случайными числами, и вывести результат.

Программа. Free Pascal. Создает 2 списка, сортирует
их и сливает в третий список.
Код:
program P_173221;

type
{* Тип данных с которым будем работать *}
  TData=Integer;

  PNode=^TNode;
{* Узел двунаправленного списка *}
  TNode=object
  public
  { Возвращает данные *}<
 br>    function GetData:TData;
  private
    Data:TData;
    Prev,Next:PNode;
  end;

  TPredicate=function(Item1:TData;Item2:TData):Boolean;

  {* Список *}
  TList=object
  public
    constructor Init;
    destructor Done;virtual;
    {* Очистка списка *}
    procedure Clear;
    {* Добавляет данные *}
    procedure Add(Data:TData);
    {* Удаляет узел *}
    procedure Remove(Node:PNode);
    {* Возвращает количество элементов *}
    function GetCount:Word;

   {* Указатель на 1й узел *}
    function First:PNode;
    {* На следующий узел *}
    function Next(Node:PNode):PNode;
    {* Указатель на последний узел *}
    function Last:PNode;
    {* На предыдущий узел *}
    function Prev(Node:PNode):PNode;
    {* Сортировка списка *}
    procedure Sort(Predicate:TPredicate);
  private
    Root:TNode;
    Count:Word;
  end;

  function TNode.GetData:TData;
  begin

     GetData:=Data;
  end;

  constructor TList.Init;
  begin
    Root.Prev:=@Root;
    Root.Next:=@Root;
    Count:=0;
  end;

  destructor TList.Done;
  begin
    Clear;
  end;

  procedure TList.Clear;
  begin
    while Count>0 do begin
      Remove(Root.Next);
    end;
  end;

  procedure TList.Add(Data:TData);
  var
    Node:PNode;
  begin
    New(Node);
    Node^.Data:=Data;
    Node^.Next:=@Root;
    Node^.Prev:=Root.Prev;

   Root.Prev^.Next:=Node;
    Root.Prev:=Node;
    Inc(Count);
  end;

  function TList.GetCount:Word;
  begin
    GetCount:=Count;
  end;

  procedure TList.Remove(Node: PNode);
  begin
    if Count>0 then begin
      Node^.Prev^.Next:=Node^.Next;
      Node^.Next^.Prev:=Node^.Prev;
      Dispose(Node);
      Dec(Count);
    end;
  end;

  function TList.First:PNode;
  begin
    if Count&g
 t;0 then First:=Root.Next
    else First:=Nil;
  end;

  function TList.Next(Node: PNode):PNode;
  begin
    if Node^.Next<>@Root then Next:=Node^.Next
    else Next:=Nil;
  end;

  function TList.Last:PNode;
  begin
    if Count>0 then Last:=Root.Prev
    else Last:=Nil;
  end;

  function TList.Prev(Node: PNode):PNode;
  begin
    if Node^.Prev<>@Root then Prev:=Node^.Prev
    else Prev:=Nil;
  end;

  procedure TList.Sort(Predicate:
TPredicate);
  var
    Node,LastNode,Tmp:PNode;
  begin
    if Count>1 then begin
      Node:=Root.Next;
      LastNode:=@Root;
      while Node<>LastNode do begin
        while Node^.Next<>LastNode do begin
          Tmp:=Node^.Next;
          if Predicate(Node^.Data,Tmp^.Data) then  Node:=Node^.Next
          else begin
            Node^.Prev^.Next:=Tmp;
            Tmp^.Prev:=Node^.Prev;
            Node^
 .Prev:=Tmp;
            Node^.Next:=Tmp^.Next;
            Tmp^.Next^.Prev:=Node;
            Tmp^.Next:=Node;
          end;<
br>        end;
        LastNode:=LastNode^.Prev;
        Node:=Root.Next;
      end;
    end;
  end;

  {* Заполняет список *}
  procedure CreateList(var List:TList;Count:Word);
  begin
    List.Clear;
    while Count>0 do begin
      List.Add(Random(100));
      Dec(Count);
    end;
  end;

  {* Выводит список *}
  procedure PrintList(var List:TList;Msg:String);
  var
    Node:PNode;
  begin
    WriteLn(Msg);
    Node:=List.First;

   while Node<>Nil do begin
      Write(Node^.GetData,' ');
      Node:=List.Next(Node);
    end;
    WriteLn;
  end;

  {* Предикат для сортировки *}
  function Less(Item1:TData;Item2:TData):Boolean;
  begin
    Less:=Item1<Item2;
  end;

  {* Сливает сортированные списки *}
  procedure MergeSortedLists(var SrcList1,SrcList2:TList;var DstList:TList);
  var
    Node1,Node2:PNode;
  begin
    if (@DstLis
 t<>@SrcList1) and (@DstList<>@SrcList2) then begin
      DstList.Clear;
      Node1:=SrcList1.First;
      Node2:=SrcList2.First;
      while (Node1<>Nil) and (Node2<>Nil) do begin
        if Node1^.GetData<Node2^.GetData then begin
          DstList.Add(Node1^.GetData);
          Node1:=SrcList1.Next(Node1);
        end else begin
          DstList.Add(Node2^.GetData);
          Node2:=SrcList2.Next(Node2);
        end;
      end;
      while
Node1<>Nil do begin
        DstList.Add(Node1^.GetData);
        Node1:=SrcList1.Next(Node1);
      end;
      while Node2<>Nil do begin
        DstList.Add(Node2^.GetData);
        Node2:=SrcList2.Next(Node2);
      end;
    end;
  end;

var
  List1,List2,List3:TList;

begin
  Randomize;
  List1.Init;
  List2.Init;
  List3.Init;
  CreateList(List1,20);
  PrintList(List1,'List1:');
  Creat
 eList(List2,10);
  PrintList(List2,'List2:');
  List1.Sort(@Less);
  PrintList(List1,'Sorted List1:');
  List2.Sort(@Less);
  PrintList(List2,'Sorted List2:');
  MergeSortedLists(List1,List2,List3);
  PrintList(List3,'Merged:');
  List3.Done;
  List2.Done;
  List1.Done;
  ReadLn;
end.

Пример вывода:
Код:
List1:
95 53 25 20 47 95 33 12 72 61 4 11 42 86 1 3 56 77 53 21
List2:
17 37 45 65 43 22 16 56 25 73
Sorted List1:
1 3 4 11 12 20 21 25 33 42 47 53 53 56 61 72 77 86 95 95
Sorted List2:
16 17 22 25 37 43 45 56 65 73
Merged:
1 3 4 11 12 16 17 20 21 22 25 25 33 37 42 43 45 47 53 53 56 56 61 65 72 73 77 86
 95 95
    
    

    Ответ отправил: Micren, Бакалавр 

    Ответ отправлен: 13.10.2009, 01:57
    

    

    
Как сказать этому эксперту "спасибо"?

    

    
  • Отправить SMS #thank 255356 
    на номер 1151 (Россия) | 
    Еще номера »
    
    • 
    
    
    
    
    
    
    
    
    
    
  • Отправить WebMoney:
     
    
    
    • 
    
    
    Вам помогли? Пожалуйста, поблагодарите эксперта за это!
    
    
    
 
    
 
    
 Оценить выпуск »
    
 Нам очень важно Ваше мнение об этом выпуске рассылки!
 
    

 
    
 
  
    Задать вопрос экспертам этой рассылки »
    
 
    
 
    Скажите "спасибо" эксперту, который помог Вам!
    

 
 Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    
 на короткий номер 1151 (Россия)
    
 Номер ответа и конкретный текст СМС указан внизу каждого ответа.
 
    
 Полный список номеров »
 
 
    
 
 * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи.
 (полный список тарифов)
    
 ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    
 *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.
     

 
    
 
 
    
 
    © 2001-2009, Портал RFpro.ru, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Автор: Калашников О.А. | Программирование: Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2009.6.9 от 25.09.2009
    В избранное