Гетерогенный списки

[Sparky]

Добрый вечер. Необходима реализация гетерогенных списков.
Вот что я написала:

program get_spisok;
uses
  SysUtils;

{===============================================================================
                    описание типов и данных
===============================================================================}
  type ob_spisok=^Tob_spisok;    //абстрактный тип
  Tob_spisok=object
    constructor init;
    procedure output;virtual;
  end;

  int = ^Tint;  //целые
  Tint = object(Tob_spisok)
    inf:integer;
    procedure insert(cel:integer);
    procedure output;virtual;
  end;

  float = ^Tfloat;  //вещественное
  Tfloat = object(Tob_spisok)
    inf:real;
    procedure insert(vesh:real);
    procedure output;virtual;
  end;

  simbol = ^Tsimbol;  //символ
  Tsimbol = object(Tob_spisok)
    inf:char;
    procedure insert(sim:char);
    procedure output;virtual;
  end;

{===============================================================================
          конструкторы и процедуры
===============================================================================}
Constructor Tob_spisok.init;
begin

end;

procedure Tob_spisok.output;
begin

end;




//целые
procedure Tint.insert(cel:integer);
begin
  inf:=cel;
end;

procedure Tint.output;
begin
  write(inf,' ');
end;

//вещественные
procedure Tfloat.insert(vesh: Real);
begin
  inf:=vesh;
end;

procedure Tfloat.output;
begin
  write(inf:2:2,' ');
end;

//символы
procedure TSimbol.insert(sim: Char);
begin
  inf:=sim;
end;

procedure Tsimbol.output;
begin
  write(inf,' ');
end;

{===============================================================================
        описание данных
===============================================================================}
type spisok = ^Tspisok;
  Tspisok = record
    inf:ob_spisok;
    next:spisok;
    prior:spisok;
  end;
var
  head:spisok;  //голова списка
  x:real; //значение инф поля
  str:string;
  i:integer;
  temp_el:spisok;
  flag_yes:Boolean;

{===============================================================================

===============================================================================}
function countElement(start:spisok):integer;
var
  temp:integer;
begin
  temp:=0;
  while(start<>nil) do
  begin
    inc(temp);
    start:=start^.next;
  end;
  countElement:=temp;
end;

procedure remote(var start:spisok); //удаление всего списка
var
  temp:spisok;
begin
  while(start<>nil) do
  begin
    temp:=start;
    start:=start^.next;
    Dispose(temp);
  end;
end;

function GetById(i:integer):spisok;
var
  p:spisok;
  j:integer;
begin
  p:=head;
  j:=1;
  while ((p<>nil) and (j<>i)) do
  begin
    p:=p^.next;
    inc(j);
  end;
  if p=nil then GetById:=nil
  else if j=i then GetById:=p;
end;

function GetNextByValue(P:spisok):spisok;   //получение значения следующего за текущим
begin
  if (p^.next<>nil) then GetNextByValue:=p^.next
  else GetNextByValue:=nil;
end;

procedure print(head:spisok); //печать списка
var
  temp:spisok;
begin
  temp:=head;
  while(temp<>nil) do
  begin
    temp^.inf^.output;
    temp:=temp^.next;
  end;
end;

[Sparky]

procedure insert(var head:spisok); //процедура вставки
var
  int1:int;  //целое
  float1:float;  //вещественное
  simbol1:simbol; //символ
  new_element,temp:spisok;
  s:Variant;
  c:char;
  x:real;
  temp_str:string;
begin
  while (str<>'') do
  begin
   // read(x);
    if (head=nil) then  //если голова пустая вставлять туда
    begin
      new(head);
      if ((str[1]>='a') and (str[1]<='z')) then
      begin
        new(simbol1,init);
        simbol1^.insert(str[1]);
        head^.inf:=simbol1;
        head^.next:=nil;
        head^.prior:=nil;
        delete(str,1,2);
      end
      else
      begin
        i:=1;
        while((i<=Length(str)) and(str[i]<>' ')) do
          inc(i);
        temp_str:=copy(str,1,i-1);
        delete(str,1,i);
        x:=StrToFloat(temp_str);
        if frac(x)<>0 then //если вещественное
        begin
          new(float1,init);
          float1^.insert(x);
          head^.inf:=float1;
          head^.next:=nil;
          head^.prior:=nil;
        end
        else   //иначе целое
        begin
          new(int1,init);
          int1^.insert(trunc(x));
          head^.inf:=int1;
          head^.next:=nil;
          head^.prior:=nil;
        end;
      end;
    end
    else   //список не пустой
    begin
      new(temp);
      temp:=head;
      while(temp^.next<>nil) do
        temp:=temp^.next;
      new(new_element);

      if ((str[1]>='a') and (str[1]<='z')) then
      begin
        new(simbol1,init);
        simbol1^.insert(str[1]);
        new_element^.inf:=simbol1;
        new_element^.next:=nil;
        new_element^.prior:=temp;
        delete(str,1,2);
      end

      else
      begin
        i:=1;
        while((i<=Length(str)) and(str[i]<>' ')) do
          inc(i);
        temp_str:=copy(str,1,i-1);
        delete(str,1,i);
        x:=StrToFloat(temp_str);
        if frac(x)<>0 then  //если вещественное
        begin
          new(float1,init);
          float1^.insert(x);
          new_element^.inf:=float1;
          new_element^.next:=nil;
          new_element^.prior:=temp;
        end
        else //иначе целое
        begin
          new(int1,init);
          int1^.insert(trunc(x));
          new_element^.inf:=int1;
          new_element^.next:=nil;
          new_element^.prior:=temp;
        end;
      end;
      temp^.next:=new_element;
    end;
  end;
end;

procedure Swap(i,j:integer);  //процедура обмена элементов
var
  p,q,t:spisok;
begin
  if (head<>nil) then
  begin
    p:=GetById(i);
    q:=GetById(j);
    if ((p<>nil) and (q<>nil)) then
    begin
      new(t);
      t^.inf:=p^.inf;
      p^.inf:=q^.inf;
      q^.inf:=t^.inf;
    end
  end
  else;
 end;

function exist(p:spisok):boolean;  //проверка входит ли элементов
var
  start:spisok;
  flag:boolean;
begin
  flag:=false;
  start:=head;
  while ((start<>nil) and (flag=false)) do
  begin
    if start=p then flag:=true
    else start:=start^.next;
  end;
end;

function GetByValue(x:Variant):spisok; //получение указателя по значению
var
  p:spisok;
begin
  p:=head;
  if x then
while ((p<>nil) and (p^.inf<>x)) do
  begin
    p:=p^.next;
  end;
  if p=nil then GetByValue:=nil
  else if p^.inf=x then GetByValue:=p;
end;

{===============================================================================
            главная программа
===============================================================================}
begin
//считать начальные данные из списка
  assign(input,'input.txt');
  reset(input);
  assign(output,'output.txt');
  rewrite(output);
  read(str);
  insert(head);
  print(head);
end.

[Sparky]

Помогите пожалуйста дописать сюда еще 3 функции, не могу понять как, огромная просьба помочь кодом
вот сами функции реализовывала для однородных списков
1.получение указателя по значению

function ListCont.GetByValue(x:integer):PList; //получение указателя по значению(инофрмационное поле)
var
  p:PList;
begin
  p:=first;
  while ((p<>nil) and (p^.inf<>x)) do
  begin
    p:=p^.next;
  end;
  if p=nil then GetByValue:=nil
  else if p^.inf=x then GetByValue:=p;
end;

2. сортировка пузырьком

procedure ListCont.BubbleSort;   //пузырьковая сортировка
var
  p,q:PList;
  i,j,n:integer;
begin
  n:=countElement(first);
  for i:=2 to n do
  begin
    for j:=n downto i do
    begin
      p:=GetById(j-1);
      q:=GetById(j);
      if p^.inf<q^.inf then
      begin
        swap(j,j-1);
      end;
    end;
  end;
    
end;

3. быстрая сортировка

procedure ListCont.QuickSort(l:integer;r:integer);   //быстрая сортировка
var
  i,j:integer;
  X:Plist;
begin
   i:=l;
   j:=r;
   x:=GetByid((l+r) div 2);
   repeat
      while (GetById(i)^.inf<x^.inf) do inc(i);
      while (GetById(j)^.inf>x^.inf) do dec(j);
      if (i<=j) then
      begin
        Swap(i,j);
        inc(i);
        dec(j);
      end;
   until (i>j);
   if j>l then QuickSort(l,j);
   if r>i then QuickSort(i,r);
end;

Огромная просьба помочь, очень бы хотела увидеть саму реализацию, заранее спасибо

[eoln]

Если уж замелькал в коде тип variant, то гетерогенный список можно использовать как однородный заменив все вводимые типы на variant. Для паскаля можно сделать что-то похожее. В примере предлагается 5 раз ввести произвольные данные типа (целые, вещественные или символ). Функции сортировки, обмена и т.п. в данном случае не будут отличаться от обычных. Может поможет.

{$N+}
type
  PEl=^TEl;
  Tel=object//тип для гетерогенного элемента
    PAdres: Pointer;//адрес элемента
    id: byte;//его тип (1-символ 2-целое 3-вещественное)
    next: PEl;
    procedure AddVariant(x: pointer);
    procedure ReadVariant;
  end;

procedure TEl.ReadVariant;
begin
  case id of//форматированный вывод согласно его типу
    1: writeln('''', char(PAdres^), '''');
    2: writeln(integer(PAdres^));
    3: writeln(single(PAdres^):0:5)
  end
end;

procedure TEl.AddVariant(x: pointer);
var
  p: pointer;
  i: single;
  j: integer;
begin
  val(string(x^), i, j);//распознаём тип введённого элемента
  if j <> 0 then begin
    id := 1;
    getmem(p, sizeof(char));
    move(string(x^)[1], p^, sizeof(char))
  end else
  if round(i) = i then begin
    j := round(i);
    id := 2;
    getmem(p, sizeof(integer));
    move(j, p^, sizeof(integer))
  end else
  begin
    id := 3;
    getmem(p, sizeof(single));
    move(i, p^, sizeof(single))
  end;
  PAdres := p
end;

var
  i: integer;
  st: string;
  first, current, last, El: PEl;
begin
  last := new(PEl);
  first := last;

  for i := 1 to 5 do begin
    write('input char, integer or single = ');
    readln(st);//вводим произвольный тип
    last^.AddVariant(@st);//и сохраняем его
    last^.next := new(PEl);
    last := last^.next
  end;

  current := first;
  while current <> last do begin
    current^.ReadVariant;
    current := current^.next
  end;
  readln
end.

[Sparky]

а можно без variant??? как-то, он тут так эксперементировала. Можно как-то под мои определения приспособить эти процедуры, помогите плиз

[Stilet]

Sparky

Жестокий какой у тя код...
Не будет сложно прикрепить архив с этими модулями, и файл с исходными данными?

[Sparky]

если выложу проект delphi 2007 нормально будет? Все выложила, огроманя просьба помочь, заранее спасибо

[Stilet]

Дашуля, знаешь помоему ты не с той стороны зашла в тему...
Вот скажи зачем ты с указателями связалась?
Ведь можно сделать класс, в котором будет список TObjectList. В него ты будешь добавлять вновь созданные экземпляры классов, отвечающих за обработку переменной определенного типа:

Вот смотри я бы так делал:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,contnrs;
type
 TInt=class
  private
   data:integer;
    function GetItem: integer;
  Public
   Property item:integer read GetItem;
 end;
 TReal=class
  private
   data:double;
    function GetItem: Double;
  public
   Property item:Double read GetItem;
 end;
 TSpisok=class
  private
   AList:TObjectList;
  public
   Procedure InsertInt(Value:integer);
   procedure InsertReal(Value:double);
   procedure printAll;
   constructor Create;
   destructor Free;
 end;
{ TSpisok }
procedure TSpisok.printAll;
var i:integer;
begin
 for i:=0 to AList.Count-1 do begin
  if alist[i] is TInt then write('Int=',TInt(Alist[i]).item);
  if alist[i] is TReal then write('Real=',TReal(Alist[i]).item);
  writeln;
 end;
end;

constructor TSpisok.Create;
begin
 AList:=TObjectList.Create;
end;

destructor TSpisok.Free;
begin
 FreeAndNil(AList);
end;

procedure TSpisok.InsertInt;
var n:TInt;
begin
 n:=TInt.Create; n.data:=Value; AList.Add(n);
end;

procedure TSpisok.InsertReal;
var n:TReal;
begin
 n:=TReal.Create; n.data:=Value;AList.Add(n);
end;


var r:TSpisok;

{ TInt }

function TInt.GetItem: integer;
begin
 Result:=data;
end;

{ TReal }

function TReal.GetItem: Double;
begin
 Result:=data;
end;

begin
 r:=TSpisok.Create;
 r.InsertInt(1);
 r.InsertInt(10);
 r.InsertReal(2);
 r.printAll;
  { TODO -oUser -cConsole Main : Insert code here }
 r.Free;
 Readln;

end.

[Sparky]

тоесть придется все снова переделывать(, а с "той стороны с которой я зашла" никак не привязать эти процедуры, остальоне же работает

[Stilet]

никак не привязать эти процедуры

Ну... как тебе сказать, слишком уж сложно у тебя получается.
Как минимум поубирай ^. Нечего на обьект ссылаться через указатель, тем паче там нечего разименовывать.

Вся твоя бедешенька в том что ты работаешь с двойным указателем - указателем на обьект. Спрашивается - зачем?
Ведь в Делфи предусмотренны классы для составления списков.
Используй их - безопасно и быстро получится.

Да тут еще такоей прикол - нужно в списке проверять какого типа класс, а у твоих "процедур" это не предусмотренно, так что фактически они не годятня никак. Посмотри как у меня:

if alist[i] is TInt then write('Int=',TInt(Alist[i]).item);
if alist[i] is TReal then write('Real=',TReal(Alist[i]).item);

Ф проверяю какого типа элемент в списке.