Otoczka wypukła – zmiana struktury danych

1

Jakiś czas temu przetłumaczyłem kod programu do znajdowania otoczki wypukłej z C++ na Pascala

program MonotoneChain;
uses crt;
type TPoint = record
                x,y:Real;
              end;
     TFunc = function (a,b:TPoint):integer;
     TArray = array of TPoint;

function signedAreaOfParallelogram(O,A,B:TPoint):Real;
begin
  signedAreaOfParallelogram := (A.x - O.x)*(B.y - O.y) - (A.y - O.y)*(B.x - O.x);
end;

function monotoneChain(P:TArray;n:integer;var H:TArray):integer;
var k,i,t:integer;
begin
  if n > 3 then
  begin
    k := 0;
    for i := 0 to n - 1 do
    begin
      while (k >= 2)and(signedAreaOfParallelogram(H[k-2],H[k-1],P[i]) <= 0)do
        k := k - 1;
      H[k] := P[i];
      k := k + 1;
    end;
    t := k + 1;
    for i := n - 1 downto 1 do
    begin
      while(k >= t)and(signedAreaOfParallelogram(H[k-2],H[k-1],P[i-1]) <= 0)do
        k := k - 1;
      H[k] := P[i-1];
      k := k + 1;
    end;
    monotoneChain := k - 1;
  end
  else
      monotoneChain := n;
end;

function comparePoints(a,b:TPoint):integer;
var t:integer;
begin
  t := 1;
  if(a.x < b.x)or((a.x = b.x)and(a.y < b.y))then
        t := -1;
  if(a.x = b.x)and(a.y = b.y)then
        t := 0;
  comparePoints := t;
end;

procedure quicksort(var A:TArray;l,r:integer;cmp:TFunc);
var i,j:integer;
    x,w:TPoint;
begin
  i := l;
  j := r;
  x := A[(l+r)div 2];
  repeat
     while cmp(A[i],x) < 0 do i := i + 1;
     while cmp(x,A[j]) < 0 do j := j - 1;
     if i <= j then
     begin
       w := A[i];
       A[i] := A[j];
       A[j] := w;
       i := i + 1;
       j := j - 1;
     end
     until i > j;
     if l < j then quicksort(A,l,j,cmp);
     if i < r then quicksort(A,i,r,cmp)
end;

var esc:char;
    k,m,n:integer;
    P,H:TArray;
BEGIN
  clrscr;
  repeat
     writeln('How many points you want to read');
     readln(n);
     SetLength(P,n);
     SetLength(H,n);
     for k := 0 to n-1 do
     begin
       write('P[',k,']=');
       readln(P[k].x,P[k].y);
     end;
     writeln;
     quicksort(P,0,n-1,@comparePoints);
     m := monotoneChain(P,n,H);
     writeln('Array of sorted points');
     for k := 0 to n-1 do
        write('(',P[k].x:1:6,',',P[k].y:1:6,') ');
     writeln;
     writeln;
     writeln('Points on the hull');
     for k := 0 to m-1 do
        write('(',H[k].x:1:6,',',H[k].y:1:6,') ');
     writeln;
     writeln;
     esc := readkey;
  until esc = #27;
END.

Kod ten jest niestety zgodny tylko z Free Pascalem
więc ciekaw jestem jak go przepisać używając listy

0
nowy121105 napisał(a):

Kod ten jest niestety zgodny tylko z Free Pascalem

I wymaga drobnych korekt dla Delphi, jeśli ma działać z czystym Delphi bez dodatkowych bibliotek.

więc ciekaw jestem jak go przepisać używając listy

Używanie list nie jest do niczego potrzebne.
Te korekty dotyczą modułu crt, którego w Delphi nie ma.
Ale możesz skorzystać np. z tego:
https://sourceforge.net/projects/delphicrt/

0

Szarpnąłbym się na zastąpienie macierzy listami – kod będzie ”ładniejszy” i nie trzeba będzie implementować quick sorta (co jest bez sensu), co najwyżej samą metodę porównującą elementy.

Zresztą uzależnianie projektu od modułu Crt w tym przypadku jest kompletnie bez sensu, bo jedyne czego z tego modułu używasz to procedury ClrScr. A wywołanie tej procedury nie jest kluczowe dla działania kodu (czyli zbędne). Cały kod natomiast wygląda na bardzo stary, tak jakby był pisany 40 lat temu w TP. Poza tym pasowało by wybrać lepsze nazwy dla typów zmiennych, a sam kod sformatować.

0

Szarpnąłbym się na zastąpienie macierzy listami – kod będzie ”ładniejszy” i nie trzeba będzie implementować quick sorta (co jest bez sensu), co najwyżej samą metodę porównującą elementy.

Masz na myśli użycie gotowców z fcl-stl
Nie pisałem kodów obiektowo w Pascalu
Chętnie bym zobaczył przykład użycia tych gotowców z fcl-stl

Implementowanie quick sorta bez sensu ?
Jakimś algorytmem musimy jednak tę tablicę posortować
Wybrałem quick sorta bo jego kod jest dość krótki i można go zapisać za pomocą jednej procedury
a przypadek pesymistyczny nie występuje zbyt często
Poza tym chciałbym aby kod mógł być skompilowany także za pomocą innych kompilatorów niż fpc

Modułu Crt użyłem także do czytania klawiszy aby zapętlić główny blok programu
Gdybym dane czytał z pliku to pewnie z modułu Crt można by było zrezygnować

Cały kod natomiast wygląda na bardzo stary, tak jakby był pisany 40 lat temu w TP. Poza tym pasowało by wybrać lepsze nazwy dla typów i zmiennych i go sformatować.

W maju tego roku minie 20 lat jak zdałem maturę a Pascal był pierwszym językiem jakiego się uczyłem
więc jeszcze mniej niż 20 lat temu uczyli pisać kod w ten sposób
W Pascalu uczyłem się programowania strukturalnego , właśnie używając TP
Co do lepszych nazw dla typów i zmiennych to jest drobnostka , masz jakiś pomysł na nie ?

W TP nie ma tablic dynamicznych poza tym jest ograniczenie pamięciowe na tablice
więc na pewno w TP kod się nie skompiluje

Jeśli chodzi o obecne rozwiązanie to nie widziałem procedury zwalniającej pamięć na tablicę
Czyżby zastosowano tutaj garbage collectora

Chciałbym zamienić dynamiczną tablicę na listę dwukierunkową (być może cykliczną)
ale nie mam pomysłu jak to zrobić

1

Miałem chwilę wolnego bez dostępu do internetu i trochę z nudów udało mi się napisać coś takiego:

program Monotone_Chain;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Math,
  System.Generics.Defaults,
  System.Generics.Collections;

type
  Tpoint = record
    X : Double;
    Y : Double;
  end;

function signedAreaOfParallelogram(O, A, B : TPoint) : Boolean;
begin
  Result := ((A.x - O.x) * (B.y - O.y) - (A.y - O.y) * (B.x - O.x)) <= 0;
end;

function monotoneChain(fullList : TList<Tpoint>): TList<Tpoint>;
var
  elementID, index, maxID :integer;

begin
  Result := TList<Tpoint>.Create;
  for var pt : Tpoint in fullList do
    Result.Add(pt);

  if fulllist.Count > 3 then
  begin
    elementID := 0;
    for index := 0 to fulllist.Count - 1 do
    begin
      while (elementID >= 2) and signedAreaOfParallelogram(Result.Items[elementID - 2],
                                                           Result.Items[elementID - 1],
                                                           fulllist.Items[index]) do
        elementID := elementID - 1;

      Result.Items[elementID] := fulllist.Items[index];
      elementID := elementID + 1;
    end;

    maxID := elementID + 1;

    for index := fulllist.Count - 1 downto 1 do
    begin
      while(elementID >= maxID) and signedAreaOfParallelogram(Result.Items[elementID - 2],
                                                              Result.Items[elementID - 1],
                                                              fulllist.Items[index - 1]) do
        elementID := elementID - 1;

      Result.Items[elementID] := fulllist.Items[index - 1];
      elementID := elementID + 1;
    end;
    Result.Capacity := elementID - 1;
  end
  else
    Result.Capacity := fulllist.Count;
end;

var
  PointsList, HullList : TList<TPoint>;
  point : Tpoint;
  points_count : Integer;

begin
  PointsList := TList<TPoint>.Create;
  Write('How many points you want to read: ');
  Readln(points_count);

  for var i := 1 to points_count do
  begin
    Writeln('Coordinates for point ', i.ToString, ': ');
    Readln(point.X, point.Y);
    PointsList.Add(point);
    Writeln;
  end;

  PointsList.Sort(
    TComparer<Tpoint>.Construct(
      function(const Left, Right: Tpoint): Integer
      begin
        Result := CompareValue(Left.X, Right.X);
        if Result = 0 then
          Result := CompareValue(Left.Y, Right.Y);
      end
      )
  );

  Writeln('Array of sorted points');
  for point in PointsList do
    Writeln('(',point.X:1:6,',',point.Y:1:6,') ');

  Writeln;
  Writeln;
  HullList := monotoneChain(PointsList);
  Writeln('Points on the hull');
  for point in HullList do
    Writeln('(',point.X:1:6,',',point.Y:1:6,') ');

  PointsList.Free;
  HullList.Free;

  Readln;
end.

Z uwagi na punkt opisany przez wartości zmiennoprzecinkowe trzeba było dodać swój mechanizm porównywania przy sortowaniu. W przypadku punktu na wartościach całkowitoliczbowych (jak TPoint z System.Types) można [ale nie trzeba] zostawić samo PointsList.Sort;

0
nowy121105 napisał(a):

Masz na myśli użycie gotowców z fcl-stl
Nie pisałem kodów obiektowo w Pascalu
Chętnie bym zobaczył przykład użycia tych gotowców z fcl-stl

Mam na myśli po prostu generyczne listy zamiast macierzy – są wygodne w obsłudze i elastyczne, a ich wydajność jest silnie zbliżona do zwykłych tablic.

Implementowanie quick sorta bez sensu ?
Jakimś algorytmem musimy jednak tę tablicę posortować

Tak, posortować trzeba, ale nie musisz algorytmu sortowania implementować sam, bo w FCL masz już gotowe klasy, które taką funkcjonalność posiadają. Wszystko znajdziesz w module FGL – listy proste i dla obiektów, mapy itd.

Wybrałem quick sorta bo jego kod jest dość krótki i można go zapisać za pomocą jednej procedury

A powinieneś wybrać quick sorta, bo to ogólnie najlepszy algorytm sortowania. ;)

Poza tym chciałbym aby kod mógł być skompilowany także za pomocą innych kompilatorów niż fpc

Delphi też posiada generyki, nawet bogatsze niż Free Pascal, więc nie musisz się ograniczać.

Modułu Crt użyłem także do czytania klawiszy aby zapętlić główny blok programu

Do czytania klawiszy używasz ReadLn, a ten znajduje się w module System.

Gdybym dane czytał z pliku to pewnie z modułu Crt można by było zrezygnować

Już możesz z niego zrezygnować, a jeśli koniecznie potrzebujesz funkcji typu ClrScr to sobie skopiuj ich kod, tak abyś mógł z nich skorzystać w Delphi.

W maju tego roku minie 20 lat jak zdałem maturę a Pascal był pierwszym językiem jakiego się uczyłem
więc jeszcze mniej niż 20 lat temu uczyli pisać kod w ten sposób
W Pascalu uczyłem się programowania strukturalnego , właśnie używając TP

W maju tego roku minie 12 lat jak zdałem maturę a Pascal był pierwszym językiem jakiego się uczyłem (oczywiście w TP7) i jego wykorzystałem na maturze z informatyki. Ale to nie zmienia faktu, że do końca życia muszę pisać kod strukturalny i wszystko ręcznie implementować.

Pascal pod postacią wielu dialektów od tamtej pory rozwinął się tak bardzo, że o TP powinieneś jak najszybciej zapomnieć, bo nawet 20 lat temu był językiem przestarzałym.

Co do lepszych nazw dla typów i zmiennych to jest drobnostka , masz jakiś pomysł na nie ?

Pewnie – nie używaj jednoliterowych identyfikatorów, bo one niczego nie mówią o swoim przeznaczeniu. Wyjątkiem od tej reguły są np. zmienne, które odpowiadają tym ze wzorów matematycznych lub układów współrzędnych, pozostałe powinny mieć nazwy słowne.

W TP nie ma tablic dynamicznych poza tym jest ograniczenie pamięciowe na tablice
więc na pewno w TP kod się nie skompiluje

Zależy Ci także na kompatybilności z TP? Ale z jakiego powodu? Nikt normlany dziś już tego języka nie używa, więc poświęcanie czasu na jego wsparcie IMO nie jest dobrym pomysłem.

Jeśli chodzi o obecne rozwiązanie to nie widziałem procedury zwalniającej pamięć na tablicę
Czyżby zastosowano tutaj garbage collectora

Tablice są zarządzane, więc alokacją i zwalnianiem pamięci zajmuje się automat. Z garbage collectorem nie ma to wiele wspólnego, ale tak – ”samo się robi”, tak samo jak w przypadku ciągów znaków, rekordów czy starych obiektów.

Chciałbym zamienić dynamiczną tablicę na listę dwukierunkową (być może cykliczną)
ale nie mam pomysłu jak to zrobić

A zyskasz cokolwiek na tym? W razie czego gotowce napisane w Pascalu możesz znaleźć w sieci, a jeśli byś potrzebował inspiracji to w naszym kompendium wiedzy znajdują się dwa artykuły, z których możesz ją czerpać:

Co prawda w obu tych artykułach listy implementowane są obiektowo (w postaci hermetycznych klas), ale bez problemu możesz sobie skopiować kod z metod i opakować go w globalne procedury i funkcje.

0

Jakiś czas temu znalazłem kod algorytmu Jarvisa na jakiejś rosyjskiej stronie o programowaniu w Pascalu i tamten kod udało mi się przepisać z użyciem listy ale tutaj nie mam pomysłu

A zyskasz cokolwiek na tym?

Skompilują go także inne kompilatory niż fpc
np widziałem że strony takie jak ideone oferują kompilatory gpc i fpc

0
nowy121105 napisał(a):

Jakiś czas temu znalazłem kod algorytmu Jarvisa na jakiejś rosyjskiej stronie o programowaniu w Pascalu i tamten kod udało mi się przepisać z użyciem listy ale tutaj nie mam pomysłu

Założę się, że ta ruska implementacja takiej listy jest przyspawana do logiki programu (nie jest kontenerem uniwersalnym), w wyniku czego nie da się tej listy przenieść do innego projektu i dlatego nie masz na to wszystko pomysłu.

Niestety, ale to najpopularniejszy i ciągle powtarzany błąd związany z listami. Aż mi węgiel w piwnicy kiełkuje jak widzę, że ktoś poważny artykuł pisze lub uczy programowania (co gorsza na uczelniach) innych i takiego babola sadzi.

Skompilują go także inne kompilatory niż fpc

I co z tego. Potrzebujesz tej przenośności, czy masturbujesz ten kod w imię wyższej idei? ;)

np widziałem że strony takie jak ideone oferują kompilatory gpc i fpc

Tak, z reguły starsze wersje, ale oferują.

0

Założę się, że ta ruska implementacja takiej listy jest przyspawana do logiki programu (nie jest kontenerem uniwersalnym), w wyniku czego nie da się tej listy przenieść do innego projektu i dlatego nie masz na to wszystko pomysłu.

To nie dlatego

Jak zamieniałem tablicę na listę

Na tablicy najpierw było wyszukiwanie minimum i zamiana tego minimum z pierwszym elementem
Tutaj po wyszukaniu tego minimum usunąłem je z listy, zapamiętałem węzeł i wstawiłem go na początek listy

Indeks w implementacji tablicowej zamieniałem na wskaźnik w implementacji listowej
Inkrementację indeksu zamieniałem na odwołanie do następnika a dekrementację indeksu na odwołanie do popprzednika


// W implementacji tablicowej było 

const maxdim=100;
type TPoint = record
                       x,y:longint; 
                    end;
        TArray = array[1..maxdim]of TPoint;

var p:longint;
     
Inkrementacja bądź odwołanie się do następnika  p:=p+1 lub Inc(p), A[p+1]
Dekrementacja bądź odwołanie się do poprzednika  p:=p-1 lub Dec(p), A[p-1]


(* 
W implementacji listowej użyłem
Nazewnictwo za Robertem Lafore 
*)

type TPoint = record
                       x,y:longint; 
                    end;
        PLink=^TLink;
        TLink = record
                       next:PLink;
                       previous:PLink;
                       data:TPoint;
                   end;
         TList = record
                        first:PNode;
                        last:PNode;
                    end;

 // I teraz zamiast indeksu tworzyłem wskaźnik i iterowałem go

var p:PLink;

(*
Jeżeli w implementacji tablicowej było p+1 to 
w implementacji listowej dawałem 
*)
p^.next;

(*
Jeżeli w implementacji tablicowej było p-1 to 
w implementacji listowej dawałem 
*)
p^.previous;

(*
Jeżeli w implementacji tablicowej było A[p+1] to 
w implementacji listowej dawałem 
*)
p^.next^.data;

(*
Jeżeli w implementacji tablicowej było A[p - 1] to 
w implementacji listowej dawałem 
*)
p^.previous^.data;

//Oczywiście trzeba było też uważać aby nie dostać błędu general protection fault

W przypadku algorytmu Andrew's monotone chain (niektórzy nazywają go uproszczoną wersją algorytmu Grahama)
w pętlach są dodatkowe warunki i nie mam pomysłu jak zapisać ten algorytm z użyciem listy

Tę ruską stronę prowadzi nauczycielka i mimo iż użyła starych konstrukcji językowych
to wydaje mi się że sam algorytm dobrze opisała

Wydaję mi się bo nie znam rosyjskiego
(Język rosyjski wyrzucili z programu nauczania zanim zdałem do piątej klasy , a mać nie chciała mnie uczyć chociaż miała do tego uprawnienia)

0

@Clarc jesteś pewien że ten twój kod działa ?

Po pierwsze nie znalazłem we Free Pascalu modułów Generics
Ściągnąłem jakieś z githuba ale nie były one pisane przez ludzi z free pascala
i mogą nie być zgodne z tymi co masz

Np

Kompilowany projekt, OS: win32, CPU: i386, Obiekt docelowy: Monotone_Chain.exe: Kod wyjścia 1,Błędy: 1,
Monotone_Chain.pas(24,40) Fatal: Syntax error, ")" expected but "<" found

0
nowy121105 napisał(a):

Po pierwsze nie znalazłem we Free Pascalu modułów Generics

Już Ci pisałem, że listy i inne kontenery generyczne znajdują się w module FGL… A jak chcesz czegoś więcej to zawsze możesz skorzystać z biblioteki Generics.Collections autorstwa @hnb.

Zresztą ta biblioteka powinna być domyślną dla FPC i rozpowszechniana jako część biblioteki standardowej (dostarczana razem z Lazarusem), bo moduł FGL to jakaś nędzna podstawa kontenerów generycznych.

A jak chcesz odpalić skompilować kod @Clarca za pomocą FPC to użyj trybu {MODE DELPHI}.

0

jesteś pewien że ten twój kod działa ?

Jestem pewien bo kod był kompilowany i testowany na danych.
Tak jak wspomniał @furious programming kod jest napisany w Delphi a nie czystym Pascalu. Dodatkowo przez niektóre struktury (inline variables) będzie mógł być skompilowany w niezmienionej postaci przez Delphi 10.3 wzwyż. Dla starszych wersji będzie trzeba dodać deklaracje zmiennych w pętlach.

0
Clarc napisał(a):

Dodatkowo przez niektóre struktury (inline variables) […]

Nie tylko – metod anonimowych FPC póki co też nie wspiera. A powinien i jedno i drugie… :/

0
unit DoublyLinkedList;
interface
const NULL = NIL;
type TPoint = record
				x,y:longint;
			  end;
	 PLink = ^TLink;
	 TLink = record
				point:TPoint;
				next:PLink;
				prev:PLink;
			 end;
	TList = record
				first:PLink;
				last:PLink;
			end;
	TFunc = function(A,B:TPoint):integer;

procedure ListInit(var L:TList);
function  ListFind(L:TList;key:TPoint):PLink;
function  ListIsEmpty(L:TList):boolean;
procedure ListInsertFirst(var L:TList;dd:TPoint);
procedure ListInsertLast(var L:TList;dd:TPoint);
procedure ListDeleteFirst(var L:TList);
procedure ListDeleteLast(var L:TList);
procedure ListInsert(var L:TList;dd:TPoint);
function ListInsertAfter(var L:TList;key,dd:TPoint):boolean;
procedure ListDeleteKey(var L:TList;key:TPoint);
procedure ListDisplayForward(L:TList);
procedure ListDisplayBackward(L:TList);
procedure BSTsort(var L:TList);

implementation
function equals(p1,p2:TPoint):boolean;
begin
  equals:=(p1.x = p2.x) and (p1.y = p2.y);
end;
function compare(A,B:TPoint):integer;
var t:integer;
begin
  t := 1;
  if(A.x < B.x)or((A.x = B.x)and(A.y < B.y))then
        t := -1;
  if(A.x = B.x)and(A.y = B.y)then
        t := 0;
  compare := t;
end;
procedure BSTinsert(var root:PLink;x:PLink);
begin
        if root = NULL then
        begin
		root := x;
                x^.prev := NULL;
                x^.next := NULL;
        end
	else if compare(root^.point,x^.point) = 0 then
		BSTinsert(root^.prev,x)
	else if compare(root^.point,x^.point) < 0 then
                BSTinsert(root^.next,x)
	else
                BSTinsert(root^.prev,x);
end;
procedure BSTtoDLL(root:PLink;var L:TList);
begin
  if root <> NULL then
  begin
	BSTtoDLL(root^.prev,L);
	if ListIsEmpty(L) then
		L.first := root
	else
		L.last^.next := root;
	root^.prev := L.last;
	L.last := root;
	BSTtoDLL(root^.next,L);
  end;
end;
procedure BSTsort(var L:TList);
var root,temp:PLink;
begin
  while not ListIsEmpty(L)do
  begin
	temp := L.first;
	if L.first^.next = NULL then
		L.last := NULL
	else
		L.first^.next^.prev := NULL;
	L.first := L.first^.next;
        BSTinsert(root,temp);
  end;
  BSTtoDLL(root,L);
end;
procedure ListInit(var L:TList);
begin
  L.first := NULL;
  L.last := NULL;
end;
function  ListFind(L:TList;key:TPoint):PLink;
var p:PLink;
begin
  p := L.first;
  while(p <> NULL)and(not equals(key,p^.point))do
	p := p^.next;
  ListFind := p;
end;
function  ListIsEmpty(L:TList):boolean;
begin
  ListIsEmpty := L.first = NULL;
end;
procedure ListInsertFirst(var L:TList;dd:TPoint);
var newLink:PLink;
begin
  new(newLink);
  newLink^.point.x := dd.x;
  newLink^.point.y := dd.y;
  newLink^.next := NULL;
  newLink^.prev := NULL;
  if ListIsEmpty(L) then
	 L.last := newLink
  else
	L.first^.prev := newLink;
  newLink^.next := L.first;
  L.first := newLink;	
end;
procedure ListInsertLast(var L:TList;dd:TPoint);
var newLink:PLink;
begin
  new(newLink);
  newLink^.point.x := dd.x;
  newLink^.point.y := dd.y;
  newLink^.next := NULL;
  newLink^.prev := NULL;
  if ListIsEmpty(L)	then
	 L.first := newLink
  else
  begin
	L.last^.next := newLink;
	newLink^.prev := L.last;
  end;
  L.last := newLink;
end;
procedure ListDeleteFirst(var L:TList);
var temp:PLink;
begin
  if not ListIsEmpty(L) then
  begin
	temp := L.first;
	if L.first^.next = NULL then
		L.last := NULL
	else
		L.first^.next^.prev := NULL;
	L.first := L.first^.next;
	dispose(temp);
  end;	
end;
procedure ListDeleteLast(var L:TList);
var temp:PLink;
begin
  if not ListIsEmpty(L) then
  begin
	temp := L.last;
	if L.first^.next = NULL then
		L.first := NULL
	else
		L.last^.prev^.next := NULL;
	L.last := L.last^.prev;
	dispose(temp);
  end;
end;
procedure ListInsert(var L:TList;dd:TPoint);
var newLink,current:PLink;
begin
  new(newLink);
  newLink^.point.x := dd.x;
  newLink^.point.y := dd.y;
  newLink^.next := NULL;
  newLink^.prev := NULL;
  current := L.first;
  while(current <> NULL)and(compare(newLink^.point,current^.point) > 0)do
     current := current^.next;
  if current = NULL then
  begin
	if ListIsEmpty(L)then
		L.first := newLink
	else
	begin
		L.last^.next := newLink;
		newLink^.prev := L.last;
	end;
	L.last := newLink;
  end
  else if current^.prev = NULL then
  begin
    L.first := newLink;
    newLink^.next := current;
    current^.prev := newLink;
    newLink^.prev := NULL;
    current := newLink;
  end
  else
  begin
     current^.prev^.next := newLink;
     newLink^.next := current;
     newLink^.prev := current^.prev;
     current^.prev := newLink;
  end;
end;
function ListInsertAfter(var L:TList;key,dd:TPoint):boolean;
var newLink,current:PLink;
	found:boolean;
begin
  current := ListFind(L,key);
  found := current <> NULL;
  if found then
  begin
	new(newLink);
	newLink^.point.x := dd.x;
	newLink^.point.y := dd.y;
	newLink^.next := NULL;
	newLink^.prev := NULL;
	if current^.next = NULL then
	begin
	  newLink^.next := NULL;
	  L.last := newLink;	
	end
	else
	begin
	  newLink^.next := current^.next;
	  current^.next^.prev := newLink;	
	end;
	newLink^.prev := current;
	current^.next := newLink;
  end;
  ListInsertAfter:= found; 	
end;
procedure ListDeleteKey(var L:TList;key:TPoint);
var current:PLink;
begin
  current := ListFind(L,key);
  if current <> NULL then
  begin
	if current^.prev = NULL then
		L.first := current^.next
	else
		current^.prev^.next := current^.next;
	if current^.next = NULL then
		L.last := current^.prev
	else
		current^.next^.prev := current^.prev;
	dispose(current);
  end;
end;
procedure ListDisplayForward(L:TList);
var current :PLink;
begin
  write('List (first-->last): ');
  current := L.first;
  while current <> NIL do
  begin
	write('(',current^.point.x,',',current^.point.y,') -> ');
	current := current^.next;
  end;
  writeln('NULL');	
end;
procedure ListDisplayBackward(L:TList);
var current :PLink;
begin
  write('List (last-->first): ');
  current := L.last;
  while current <> NIL do
  begin
	write('(',current^.point.x,',',current^.point.y,') -> ');
	current := current^.prev;
  end;
  writeln('NULL');	
end;

begin

end.



program MonotoneChain;

uses crt,doublylinkedlist;

function equals(a,b:TPoint):boolean;
begin
  equals := (a.x = b.x) and (a.y = b.y)
end;

function vect(a1,a2,b1,b2:TPoint):longint;
begin
  vect := (a2.x - a1.x) * (b2.y - b1.y) - (b2.x - b1.x) * (a2.y - a1.y)
end;

function dist2(a1,a2:TPoint):longint;
begin
  dist2 := sqr(a2.x - a1.x) + sqr(a2.y-a1.y)
end;

procedure Solve(var A,B:TList);
var k,t:longint;
    pt:PLink;
begin
  ListInit(B);
  if not ListIsEmpty(A)then
  begin
    k := 0;
    pt := A.first;
    while pt <> NULL do
    begin
      while(k >= 2)and(vect(B.last^.prev^.point,B.last^.point,B.last^.prev^.point,pt^.point) <= 0)do
      begin
        ListDeleteLast(B);
        k := k - 1;
      end;
      ListInsertLast(B,pt^.point);
      k := k + 1;
      pt := pt^.next;
    end;
    t := k + 1;
    pt := A.last;
    while pt <> NULL do
    begin
      while(k >= t)and(vect(B.last^.prev^.point,B.last^.point,B.last^.prev^.point,pt^.point) <= 0)do
      begin
        ListDeleteLast(B);
        k := k - 1;
      end;
      ListInsertLast(B,pt^.point);
      k := k + 1;
      pt := pt^.prev;
    end;
    ListDeleteLast(B);
  end;
end;



procedure main;
var A,B:TList;
    input:text;
    p:TPoint;
    path:string;
begin
  ListInit(A);
  writeln('Podaj sciezke do pliku z danymi do wczytania');
  readln(path);
  path := 'F:\fpc\3.0.4\bin\i386-win32\monotonechain\' + path;
  assign(input,path);
  {$I-}
  reset(input);
  {$I+}
  if IOResult <> 0 then
     writeln('Pliku nie udalo sie wczytac')
  else
  begin
  while not eof(input) do
  begin
    while not eoln(input) do
    begin
      read(input,p.x,p.y);
      ListInsertLast(A,p);
    end;
    readln(input);
    writeln('List A');
    ListDisplayForward(A);
    ListDisplayBackward(A);
    BSTsort(A);
    Solve(A,B);
    writeln('List A');
    ListDisplayForward(A);
    ListDisplayBackward(A);
    writeln('List B');
    ListDisplayForward(B);
    ListDisplayBackward(B);
    while not ListIsEmpty(A) do
       ListDeleteFirst(A);
   while not ListIsEmpty(B) do
       ListDeleteFirst(B);
  end;
  close(input);
  end;
  readkey;
end;


BEGIN
  main;
END.



Teraz jeżeli w procedurze znajdującej otoczkę wywołam procedurę sortującą punkty
to otrzymam błąd general protection fault znany także jako segmentation fault
Ciekawy jestem dlaczego i jak go poprawić

Co do algorytmu to użycie licznika ogranicza liczbę punktów

0

@nowy121105: na pewno nie chcesz skorzystać z listy generycznej?

0

Nie bardzo wiem co się dzieje bo procedura sortująca wywołana w głównym bloku kodu lub jak tutaj w procedurze main działa poprawnie
ale wywołana w procedurze znajdującej otoczkę powoduje błąd general protection fault
Próbowałem prześledzić kod krok po kroku aby sprawdzić która linia kodu powoduje błąd
Segmentation fault pojawiał się chyba podczas dodawania węzła listy do drzewa BST
no ale dlaczego gdy procedura jest wywołana w głównym bloku kodu to wszystko wydaje się być ok

0
nowy121105 napisał(a):

ale wywołana w procedurze znajdującej otoczkę powoduje błąd general protection fault

Problem leży w Twojej implementacji listy – w pewnym przypadku operuje na nilu i musisz sobie sprawdzić w którym konkretnie momencie to się dzieje.

Próbowałem prześledzić kod krok po kroku aby sprawdzić która linia kodu powoduje błąd

Próbuj dalej. Skoro dostajesz wyjątek to na pewno kod jest błędny.

no ale dlaczego gdy procedura jest wywołana w głównym bloku kodu to wszystko wydaje się być ok

Tego Ci nie powiem. Wywal tę listę, weź generyczną i jej każ zarządzać elementami oraz je sortować.

Zresztą użycie listy dwukierunkowej nie da Ci żadnej przewagi nad typowymi, tablicowymi buforami, ze względu na czasochłonny dostęp do węzłów. IMO takie podejście nie ma sensu, przez co tracisz tylko czas, zamiast skupić się na rzeczy najważniejszej, czyli na algorytmie wyszukującym otoczkę.

AFAIR wcześniej podałeś, że kodu obiektowego nigdy nie pisałeś – no kurde czas najwyższy zacząć taki produkować.

0

Chyba wiem jak poprawić to sortowanie drzewem BST
Kiedyś na innym forum jeden koleś dał sortowanie stogowe i też mu ono nie działało
bo zabrakło mu jednej linijki kodu
Wydaje mi się że tutaj też wystarczy dopisać jedną linijkę kodu aby sortowanie drzewem BST działało poprawnie
choć nie wiem dlaczego teraz występuje segmentation fault i to tylko w procedurze znajdującej otoczkę

Użycie listy w porównaniu do tablic daje tę przewagę że można jej używać nie tylko z kompilatorem fpc
a jeśli chodzi o dostęp do węzłów to tutaj punkty należące do otoczki są przechowywane na stosie a złożoność funkcji realizujących stos to O(1)
Jeśli chodzi o listę przechowującą wszystkie punkty to wstawianie i usuwanie można zrealizować w czasie O(1)
a jeśli chodzi o złożoność całego algorytmu to tak jak w przypadku tablic zależy on od wybranego algorytmu sortującego
(Sortowanie przez scalanie daje złożoność O(nlog(n)) , Sortowanie przez podział może zwolnić do O(n^2)
a jeśli chodzi o sortowanie drzewem BST to złożoność jest zbliżona do sortowania przez podział
z tym że można zmniejszyć prawdopodobieństwo wystąpienia przypadku pesymistycznego używając zrównoważonego drzewa BST)
Poza tym Diks i Rytter sugerują użycie dwukierunkowej listy cyklicznej jako struktury danych

A jakiś pomysł na usunięcie liczników ?
Nie podoba mi się ich użycie bo wprowadzają pewne ograniczenia
W matematyce zbiór liczb całkowitych jest przeliczalny tutaj natomiast jest on skończony
i może się zdarzyć że liczba węzłów wyjdzie poza zakres typu całkowitego
a wtedy liczniki nie będą zliczać poprawnie

0
nowy121105 napisał(a):

Kiedyś na innym forum jeden koleś dał sortowanie stogowe i też mu ono nie działało
bo zabrakło mu jednej linijki kodu

Wolisz wierzyć w jakieś mity, czy znaleźć konkretną przyczynę istnienia problemu?

Użycie listy w porównaniu do tablic daje tę przewagę że można jej używać nie tylko z kompilatorem fpc

Znasz jakiś kompilator, który nie wspiera tablic? Bo ja nie. Listy generyczne też nie są domeną Free Pascala, bo istnieją też w Delphi i wszystkich innych współczesnych i wysokopoziomowych językach.

a jeśli chodzi o dostęp do węzłów to tutaj punkty należące do otoczki są przechowywane na stosie a złożoność funkcji realizujących stos to O(1)

„złożoność funkcji realizujących stos” – nie wiem jak to interpretować.

Jeśli chodzi o listę przechowującą wszystkie punkty to wstawianie i usuwanie można zrealizować w czasie O(1)

Można, jeśli zanim wstawisz lub usuniesz węzeł, jego referencja będzie znana, czyli nie trzeba będzie iterować w celu jej odnalezienia. Czyli w przypadku list jest to niemożliwe, jeśli dana operacja nie dotyczy węzła pierwszego, ostatniego lub aktualnego (jeśli przechowujesz referencję węzła ostatnio aktualizowanego).

Nie da się napisać listy, która w każdym aspekcie będzie co najmniej tak samo wydajna jak tablice.


Jeśli koniecznie chcesz pisać kod proceduralnie i samemu implementować listy i sortowanie, to najpierw upewnij się, że one faktycznie działa poprawnie dla każdego przypadku, zanim zajmiesz się algorytmem szukania otoczki.

0

Zapomniałem jednej instrukcji w procedurze sortującej i dlatego nie działała poprawnie
W module DoublyLinkedList między liniami 79 oraz 80
brakuje instrukcji root := NULL
Po jej dopisaniu sortowanie wydaje się działać

np konstrukcja array of type_name jest wspierana tylko przez Free Pascala

Stos masz gdy napiszesz funkcje wstawiające i usuwające węzeł tylko z jednego końca struktury
(na liście może to być głowa albo ogon na tablicy tylko ogon inaczej implementacja tablicowa staje się nieefektywna)
Dodatkowo do stosu można dopisać funkcję sprawdzającą czy stos jest pusty oraz zwracającą dane na szczycie stosu bez usuwania węzła
Wszystkie te funkcje działają w czasie O(1)
W przypadku otoczki lista jest równie wydajna jak tablica a nie trzeba z góry rezerwować pamięci na węzły

Jeżeli chodzi o algorytm to masz jakiś pomysł na usunięcie liczników ?

0
nowy121105 napisał(a):

W module DoublyLinkedList między liniami 79 oraz 80
brakuje instrukcji root := NULL
Po jej dopisaniu sortowanie wydaje się działać

Nie użyłbym kodu, który „wydaje się działać” – albo działa prawidłowo i jest to udowodnione testami (obojętne jakimi, byle pokrywały wszystkie przypadki), albo nie korzystam z niego.

Sam używam specjalnej, własnej implementacji listy dwukierunkowej w bibliotece TreeStructInfo, ale różnica polega na tym, że ona zawsze działa prawidłowo – przetestowałem każdy możliwy scenariusz i sprawuje się świetnie. W przeciwnym razie biblioteka mogłaby się krzaczyć, a dane być utracone, co jest niedopuszczalne.

np konstrukcja array of type_name jest wspierana tylko przez Free Pascala

Nie – macierze dynamiczne wspierane są przez wszystkie kompilatory Pascala, które obecnie są w użyciu. Turbo Pascal 7 nie jest w powszechnym użyciu, więc nikogo nie obchodzi kompatybilność kodu z tym tworem. Nikt o zdrowych zmysłach nie będzie poświęcał czasu na pisanie kodu z nim zgodnego, bo to się w ogóle nie opłaca.

Albo idzie się z duchem czasu, albo jest się w czarnej dupie i traci się czas na implementację czegoś, co już dawno zostało zaimplementowane, przetestowane i sprawdzone w praktyce w tysiącach projektów, przez twórców biblioteki standardowej przede wszystkim.

Stos masz gdy napiszesz funkcje wstawiające i usuwające węzeł tylko z jednego końca struktury
(na liście może to być głowa albo ogon na tablicy tylko ogon inaczej implementacja tablicowa staje się nieefektywna)

Wiem czym jest i jak działa stos – jedynie nie zrozumiałem kontekstu, w którym używasz słowa stos, skoro używasz listy kierunkowej i BST.

Dodatkowo do stosu można dopisać funkcję sprawdzającą czy stos jest pusty oraz zwracającą dane na szczycie stosu bez usuwania węzła

To jest w standardzie – Push wrzuca na stos, Pop zdejmuje, a Peek odczytuje wierzchołek, bez zdejmowania.

W przypadku otoczki lista jest równie wydajna jak tablica a nie trzeba z góry rezerwować pamięci na węzły

Masz 2KB pamięci, że martwisz się o tak znikomy narzut? Po to rezerwuje się pamięć z zapasem, aby operacje na danym kontenerze mogły być wykonywane bez relokacji pamięci i jest to jak najbardziej sensowny zabieg. Tak robią wszystkie standardowe kontenery i nikt nie widzi w tym problemu (bo widzieć nie powinien).

Jeżeli chodzi o algorytm to masz jakiś pomysł na usunięcie liczników ?

Nie. Z tego co widzę, ich istnienie jest konieczne. Zresztą nawet nie będę próbował optymalizować tego kodu, bo nie za bardzo mam czas i ochotę na zabawę z antykami.

Szukanie otoczki przy użyciu współczesnego dialektu, takiego jak Free Pascal czy nowe Delphi i z użyciem obiektowych kontenerów, to 50 linijek kodu. Kodu, który będzie kompatybilny nawet ze starymi kompilatorami tych języków, bo generyki są w powszechnym użyciu od nastu lat.

1 użytkowników online, w tym zalogowanych: 0, gości: 1