Не работает процедура сортировки. Помогите!

[Alenka_kiss]

Ура! Вот в таком варианте рисует! Но теперь не выдает, как были точки отсортированы. Только картинку показывает. Можно сделать, чтобы было и то и другое?

uses graph, crt; 

const N = 10; 

type tPoint = record 
    x, y: real; 
    n: integer; 
end; (* record *) 

type tPoints = array [1..N] of tPoint; 

procedure dec2pol (var p: tPoint); 
    var t: tPoint; 
begin (* dec2pol *) 
    t. n := p. n; 
    if p. x = 0 then begin 
        if p. y < 0 then 
            t. x := 270 
        else begin 
            if p. y = 0 then 
                t. x := 0 
            else 
                t. x := 90; 
        end; (* if *) 
    end else 
        t. x := 180 * arctan (p. y / abs (p. x)) / Pi; 
    if p. x < 0 then 
        t. x := 180 - t. x 
    else if p. y < 0 then 
        t. x := 360 + t. x; 
    t. y := sqrt (sqr (p. x) + sqr (p. y)); 
    p := t; 
end; (* dec2pol *) 

var points: tPoints; 
    t, p1, p2: tPoint; 
    i, j: integer; 
    grDriver, grMode: integer; 

begin (* main program *) 
    for i := 1 to N do begin 
        points [i]. n := i; 
        read (points [i]. x, points [i]. y); 
    end; (* for *) 
    for i := 1 to N - 1 do begin 
        p1 := points [i]; 
        dec2pol (p1); 
        for j := i + 1 to N do begin 
            p2 := points [j]; 
            dec2pol (p2); 
            if p2. x < p1. x then begin 
                t := points [j]; 
                points [j] := points [i]; 
                points [i] := t; 
            end; (* if *) 
        end; (* for *) 
    end; (* for *) 
    for i := 1 to N - 1 do begin 
        p1 := points [i]; 
        dec2pol (p1); 
        for j := i + 1 to N do begin 
            p2 := points [j]; 
            dec2pol (p2); 
            if (p2. x = p1. x) and (p2. y < p2. y) then begin 
                t := points [j]; 
                points [j] := points [i]; 
      points [i] := t;

            end; (* if *) 
        end; (* for *) 
    end; (* for *) 
    grDriver := 9; 
   grMode :=2; 
InitGraph (grDriver, grMode, ' ');

    if GraphResult = grOk then begin 
        ClearDevice; 
        MoveTo (trunc (points [1]. x), trunc (points [1]. y)); 
        for i := 2 to N do 
            LineTo (trunc (points [i]. x), trunc (points [i]. y)); 
while not KeyPressed do ;
    end else 
        writeln ('graph initialization fault'); 
end. (* main program *)

[Sanyok]

Можно. Перед вызовом InitGraph надо вывести на экран значения точек в массиве points(примерно так же, как выводиля список в вашей старой программе процедурой OutSpisok, с той разницей, что points - это не список, а массив записей ). После этого надо тормознуть программу (например, вписать readln) - что бы пользователь мог на эти значения полюбоваться

Скажем, что бы получить доступ к координате Х i-той точки в этом массиве надо написать:

points[i].x

[Alenka_kiss]

чего-то с выводом точек не получилось ничего.

[Cube]

Alenka_kiss писал(а):

чего-то с выводом точек не получилось ничего.

Если нужно вывести значения точек после вывода графика, то добавьте после "writeln ('graph initialization fault');"

CloseGraph;
for i := 1 to N do
    writeln (points [i]. n, ': ', points [i]. x, ', ', points [i]. y);

а если до вывода графика, то перед "grDriver :=..."

for i := 1 to N do
    writeln (points [i]. n, ': ', points [i]. x, ', ', points [i]. y);
while not KeyPressed do ;

[Alenka_kiss]

У меня почему-то ломанная не получается замкнутой. и есть сложности при переключении режимов - текстового и графического. Ну из графического в текстовый еще как-то переключается, а из наоборот - текстового в графический - никак не хочет (когда сначала точки, а потом - рисунок). И как мне замкнуть ломанную?

[Sanyok]

Вообще-то она и не должна замкнутой получатся

[Alenka_kiss]

по условию задачи - написано - соединить замкнутой ломанной линией.
Вот что в итоге всеобщими стараниями получилось. Токо я не знаю, у меня одной работает или работает вообще?

program Project62;

uses
  graph,
  crt;

const K = 10;

type tPoint = record
    x, y: real;
    n: integer;
end; (* record *)

type tPoints = array [1..K] of tPoint;

procedure dec2pol (var p: tPoint);
    var t: tPoint;
begin (* dec2pol *)
    t. n := p. n;
    if p. x = 0 then begin
        if p. y < 0 then
            t. x := 270
        else begin
            if p. y = 0 then
                t. x := 0
            else
                t. x := 90;
        end; (* if *)
    end else
        t. x := 180 * arctan (p. y / abs (p. x)) / Pi;
    if p. x < 0 then
        t. x := 180 - t. x
    else if p. y < 0 then
        t. x := 360 + t. x;
    t. y := sqrt (sqr (p. x) + sqr (p. y));
    p := t;
end; (* dec2pol *)

var points: tPoints;
    t, p1, p2: tPoint;
    i, j, N: integer;
    grDriver, grMode: integer;

begin (* main program *)
    Write('Vvedite kolichestvo tochek: ');
    ReadLn(N);
    WriteLn('Vvedite koordinaty tochek. -320<x<320 -240<y<240');
    for i := 1 to N do begin
        points [i]. n := i;
        Write('Tochka ', i, ':');
        read (points [i]. x, points [i]. y);
    end; (* for *)
    for i := 1 to N - 1 do begin
        p1 := points [i];
        dec2pol (p1);
        for j := i + 1 to N do begin
            p2 := points [j];
            dec2pol (p2);
            if p2. x < p1. x then begin
                t := points [j];
                points [j] := points [i];
                points [i] := t;
            end; (* if *)
        end; (* for *)
    end; (* for *)
    for i := 1 to N - 1 do begin
        p1 := points [i];
        dec2pol (p1);
        for j := i + 1 to N do begin
            p2 := points [j];
            dec2pol (p2);
            if (p2. x = p1. x) and (p2. y < p2. y) then begin
                t := points [j];
                points [j] := points [i];
                points [i] := t;
            end; (* if *)
        end; (* for *)
    end; (* for *)

    write('Poryadok obhoda tochek: ');
    for i := 1 to N do
        Write(points [i]. n : 3);
    ReadLn;
    WriteLn;
    Write ('Zamknutaja lomannaja - nagmi <Enter>');
    ReadLn;

    grDriver := 9;
    grMode := 2;
    InitGraph (grDriver, grMode, 'C:\BP\BGI');

    if GraphResult = grOk then begin
        ClearDevice;
        MoveTo (320, 0);
        LineTo (320, 480);
        MoveTo (0, 240);
        LineTo (640, 240);
        MoveTo (320 + trunc (points [1]. x), 240 - trunc (points [1]. y));
        for i := 2 to N do
            LineTo (320 + trunc (points [i]. x), 240 - trunc (points [i]. y));
        LineTo (320 + trunc (points [1]. x), 240 - trunc (points [1]. y));
    while not KeyPressed do ;
    end else
        Writeln ('graph initialization fault');
end. (* main program *)

[Someone]

Alenka_kiss писал(а):

по условию задачи - написано - соединить замкнутой ломанной линией.
Вот что в итоге всеобщими стараниями получилось. Токо я не знаю, у меня одной работает или работает вообще?

Так даже не просто несамопересекающейся, а ещё и замкнутой? Тогда дело ещё хуже, чем я писал. Контрпример к алгоритму: (30;-50), (20;-20), (50;20), (30;50).

Из положения можно выйти так: находим точку с наименьшим значением координаты $x$ (пусть это $(x_0,y_0)$); эту точку используем в качестве полюса, то есть, угол, соответствующий точке $(x_k,y_k)$, определяем по формуле

$$\varphi_k=\begin{cases}\arctg\frac{y_k-y_0}{x_k-x_0}\text{, если }x_k>x_0\text{,}\\-\frac{\pi}{2}\text{, если }x_k=x_0\text{ и }y_k<y_0\text{,}\\ \frac{\pi}{2}\text{, если }x_k=x_0\text{ и }y_k>y_0\text{.}\end{cases}$$

Обход начинаем и заканчиваем в точке $(x_0,y_0)$. Точки обходим в порядке возрастания угла $\varphi_k$, а точки с одинаковыми значениями угла обходим либо в порядке возрастания квадрата радиуса $r_k^2=(x_k-x_0)^2+(y_k-y_0)^2$, либо в порядке убывания (это безразлично во всех случаях, за исключением случая наименьшего угла, когда точки нужно обходить в порядке возрастания $r_k^2$, и случая наибольшего угла, когда обходить нужно, наоборот, в порядке убывания $r_k^2$).

[Sanyok]

To Alenka_kiss:
Ваша прога, конечно, у меня бы не заработала (у меня BP установлен на диск D). Я в Вашей программе переделал следующее:
1) вот это:

InitGraph (grDriver, grMode, 'C:\BP\BGI');

заменил на это:

InitGraph (grDriver, grMode, '');

И закинул в текущую директорию драйвер egavga.bgi. Ничего страшного, драйвер - тоже часть проги, и если файлов 2 штуки мы уже могем заявить, что это "программный комплекс"

2) вот это (на вводе точек):

for i := 1 to N do begin 
    points [i]. n := i; 
    Write('Tochka ', i, ':'); 
    read (points [i]. x, points [i]. y); 
end; 

я поменял на это:

for i := 1 to N do begin 
    points [i]. n := i; 
    Write('Tochka ', i, ':'); 
    readLN (points [i]. x, points [i]. y); 
end; 

Помните, у Вас не получалось с порядком вывода точек? Все из-за этого злосчастного LN. Просто read символ переноса строки (клавишу Enter) похоже, оставляет в буфере клавиатуры, а следующая после нее процедура ввода readln этот символ глотает (как будто Enter не раньше нажали, а сейчас) и прога топала себе дальше...
После того, как тут вписали LN, следующий Ваш фрагмент:

ReadLn; 
    WriteLn; 
    Write ('Zamknutaja lomannaja - nagmi <Enter>'); 
    ReadLn; 

можно заменить таким:

Write ('Zamknutaja lomannaja - nagmi <Enter>'); 
    ReadLn; 

Ну, и в самом конце, перед словом end надо бы вызов CloseGraph вставить.

И еще - в проге похоже, не совсем правильная сортировка, поскольку у меня пару раз ломаная получилась самопересекающейся.

[Cube]

Sanyok писал(а):

...
...в проге похоже, не совсем правильная сортировка, поскольку у меня пару раз ломаная получилась самопересекающейся.

Сортировка-то правильная. Указание к задаче неправильное или неправильно понято.

[Someone]

Cube писал(а):

Sanyok писал(а):

...
...в проге похоже, не совсем правильная сортировка, поскольку у меня пару раз ломаная получилась самопересекающейся.

Сортировка-то правильная. Указание к задаче неправильное или неправильно понято.

Указание точно неправильное. Оно не обеспечивает не только замкнутую линию без самопересечений, но даже и незамкнутую. Пример: (40;10), (10;10), (20;30), (-10;-60).

[Cube]

Someone писал(а):

...
Указание точно неправильное. Оно не обеспечивает не только замкнутую линию без самопересечений, но даже и незамкнутую. Пример: (40;10), (10;10), (20;30), (-10;-60).

Должно быть, это из-за того, что при пересчёте декартовых координат в полярные значения угла пересчитываются в отрезок (0;360). Если пересчитывать в (-180;180), то этот набор не будет иметь самопересечений при незамкнутом контуре (но будет при замкнутом).

[незваный гость]

Данная проблема не имеет прямого отношения к выбору диапазона углов. При соответсвующем повороте мы всегда будем иметь головную боль. И я думаю, что и при незамкнутой ломаной тоже. (В Вашем же случае надо просто повернуть на 180 градусов.)

На первый взгляд (весьма бездоказательный), от самопересечений можно уйти, если центр полярной системы координат находиться внутри охватывающего (выпуклого) многоугольника системы точек. В качестве такового можно взять "центр масс" точек, а проще говоря, среднее арифметическое их декартовых координат. Созблазна же взять случайным образом одну из исходных точек в качестве центра следует избегать -- достаточно модифицировать пример Someone, добавив к нему точку (0, 0). В то же время центр масс любых трех (не лежащих на прямой), по видимому, всех устроит. Предположение о середине любого отрезка тоже выглядит правдоподобнным.

По данному вопросу я бы проверил свою любиму книжку -- "Вычислительная геометрия" -- да сейчас не могу.

[Cube]

Sanyok писал(а):

...
...в проге похоже, не совсем правильная сортировка, поскольку у меня пару раз ломаная получилась самопересекающейся.

Неправильная сортировка
Она была правильной, пока я не решил, что переводить декартовы координаты в полярные необязательно до сортировки, можно и во время неё...
Исправляюсь:

program Project62;

uses
  graph,
  crt;

const K = 10;

type tPoint = record
    x, y: real;
    n: integer;
end; (* record *)

type tPoints = array [1..K] of tPoint;

procedure dec2pol (var p: tPoint);
    var t: tPoint;
begin (* dec2pol *)
    t. n := p. n;
    if p. x = 0 then begin
        if p. y = 0 then
            t. x := 0
        else
            t. x := 90;
    end else
        t. x := 180 * arctan (p. y / p. x) / Pi;
    t. y := sqrt (sqr (p. x) + sqr (p. y));
    p := t;
end; (* dec2pol *)

procedure swap (var x, y: tPoint);
    var t: tPoint;
begin (* swap *)
    t := x;
    x := y;
    y := t;
end; (* swap *)

procedure transit (p1: tPoint; var p2: tPoint);
begin (* transit *)
    p2. x := p2. x - p1. x;
    p2. y := p2. y - p1. y;
end; (* transit *)

var points: tPoints;
    t, p1, p2: tPoint;
    i, j, N: integer;
    grDriver, grMode: integer;
    minXY: tPoint;

begin (* main program *)
    minXY. x := 0;
    minXY. y := 0;
    Write('Vvedite kolichestvo tochek: ');
    ReadLn(N);
    WriteLn('Vvedite koordinaty tochek. -320<x<320 -240<y<240');
    for i := 1 to N do begin
        points [i]. n := i;
        Write('Tochka ', i, ':');
        read (points [i]. x, points [i]. y);
    end; (* for *)
    minXY := points [1];
    for i := 2 to N do begin
        if (points [i]. x < minXY. x) then
            minXY. x := points [i]. x;
        if (points [i]. y < minXY. y) then
            minXY. y := points [i]. y;
    end;
    for i := 1 to N - 1 do begin
        p1 := points [i];
        transit (minXY, p1);
        dec2pol (p1);
        for j := i + 1 to N do begin
            p2 := points [j];
            transit (minXY, p2);
            dec2pol (p2);
            if p2. x < p1. x then begin
                swap (points [i], points [j]);
                swap (p1, p2);
            end; (* if *)
        end; (* for *)
    end; (* for *)
    for i := 1 to N - 1 do begin
        p1 := points [i];
        transit (minXY, p1);
        dec2pol (p1);
        for j := i + 1 to N do begin
            p2 := points [j];
            transit (minXY, p2);
            dec2pol (p2);
            if (p2. x = p1. x) and (p2. y < p2. y) then begin
                swap (points [i], points [j]);
                swap (p1, p2);
            end; (* if *)
        end; (* for *)
    end; (* for *)

    write('Poryadok obhoda tochek: ');
    for i := 1 to N do
        Write(points [i]. n : 3);
    ReadLn;
    WriteLn;
    Write ('Zamknutaja lomannaja - nagmi <Enter>');
    ReadLn;

    grDriver := 9;
    grMode := 2;
    InitGraph (grDriver, grMode, 'С:\BP\BGI');

    if GraphResult = grOk then begin
        ClearDevice;
        MoveTo (320, 0);
        LineTo (320, 480);
        MoveTo (0, 240);
        LineTo (640, 240);
        MoveTo (320 + trunc (points [1]. x), 240 - trunc (points [1]. y));
        for i := 2 to N do
            LineTo (320 + trunc (points [i]. x), 240 - trunc (points [i]. y));
        LineTo (320 + trunc (points [1]. x), 240 - trunc (points [1]. y));
    while not KeyPressed do ;
    end else
        Writeln ('graph initialization fault');
end. (* main program *)

[Sanyok]

Забавно, что решение данной задачи не единственно (когда точек больше 4-х штук).
Вот для примера Someone с добавленной точкой (0, 0):
1) (0,0) (-10, -60) (40, 10) (20, 30) (10, 10) (0, 0)
2) (10,10) (-10, -60) (40, 10) (20, 30) (0, 0) (10, 10)
Есть еще решения, но их лень писать...