IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

> Окружность и точки
Akara
сообщение 27.11.2003 17:13
Сообщение #1


Гость






Вот такая вот задачка:

Есть множество точек М в трехмерном пространстве. Найти такую из них, что окружность  радиуса R с центром в этой точке содержит максимальное число точек из множества М.
Ну, и её нужно оформить в Делфи.
Спасибочки большое за внимание!
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
Shadow
сообщение 5.12.2003 18:25
Сообщение #2


Lonely_Raven
****

Группа: Пользователи
Сообщений: 640
Пол: Мужской

Репутация: -  1  +


:D
-=-=-=
Ню я вроде замоснтрячил
только вот лучше мне тебе скинуть
весь проект целиком
иначе неудобно будет

Где у тебя МЫЛО-то

-=-=-=-=

unit Star1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, Buttons, ExtCtrls;

type
 TForm1 = class(TForm)
   BitBtn1: TBitBtn;
   Memo1: TMemo;
   Label1: TLabel;
   GroupBox1: TGroupBox;
   Edit1: TEdit;
   e_X: TEdit;
   e_Y: TEdit;
   e_Z: TEdit;
   e_Name: TEdit;
   le_Radius: TLabeledEdit;
   Button1: TButton;
   Label2: TLabel;
   Label3: TLabel;
   Label4: TLabel;
   Label5: TLabel;
   e_max: TEdit;
   Label6: TLabel;
   Label7: TLabel;
   Image1: TImage;
   procedure BitBtn1Click(Sender: TObject);
   procedure Memo1KeyPress(Sender: TObject; var Key: Char);
   procedure le_RadiusKeyPress(Sender: TObject; var Key: Char);
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

Type
 StarS = record
 stX           :       Integer;
 stY           :       Integer;
 stZ           :       Integer;
 stName        :       String;
end;

Type
 St_M = record
 St_Col : Integer;
 St_Nam : String;
end;

var
 Form1          : TForm1;
 max_o          : String;
 StrRead        : String;
 Ps,ii          : Integer;
 StarCoo        : array [0..20,0..2] of Integer;
 StarName       : array [0..20] of String;
 StarStatic     : StarS;
 StarWrToMass   : StarS;
//---------------------------------
 Stars_Schet    : Integer;
 Star_M         : array [0..20] of St_M;
//---------------------------------
 //Label ex;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
Var
i,ir : Integer;
X_r  : Integer;
Y_r  : Integer;
Z_r  : Integer;
max  : Integer;
Label ex;

begin  {0}

if Form1.le_Radius.Text='' then
 begin
   Windows.Beep(4000,100);
   ShowMessage('Радиус не введен');
   goto ex;
 end;
 
{*****************************
*       Вводим точки         *
*    на компонент TMemo      *
******************************}
if Form1.Memo1.Lines.Capacity>20 then
  begin
    ShowMessage('Слишком много данных не более 20 строк');
    goto ex;
  end else if Form1.Memo1.Lines.Count=0 then
    begin
     ShowMessage('Нет строк');
     goto ex;
    end else begin {1}
//----------------------------------------------------
For i:=0 to Form1.Memo1.Lines.Capacity-1 do
 begin {2}
          StrRead:=Form1.Memo1.Lines[i];

          if length(StrRead)>15 then
            begin
               ShowMessage('Строка слишком большая не более 15 символов');
               goto ex;
            end else if length(StrRead)<8 then
              begin
                ShowMessage('Строка слишком маленькая не менее 9 символов');
                goto ex;
              end;

{Находим координату X}
          Ps:=pos('>',StrRead);

          if Ps=0 then
            begin
              ShowMessage('в строке нет управляющих символов');
              goto ex;
            end else if Ps>4 then
              begin
                ShowMessage('     Координата звезды  X   '+#13#10+
                            'не более 3 символов и знак >');
                goto ex;                            
              end;

          Ps:=Ps-1;
          StarWrToMass.stX:=StrToInt(copy(StrRead, 1, Ps));

          PS:=Ps+1;
          delete(StrRead,1,Ps);

 {КОНЕЦ}
 {Находим координату Y}
          Ps:=pos('>',StrRead);

          if Ps=0 then
            begin
              ShowMessage('в строке нет управляющих символов');
              goto ex;
            end else if Ps>4 then
              begin
                ShowMessage('     Координата звезды  Y   '+#13#10+
                            'не более 3 символов и знак >');
                goto ex;                            
              end;

          Ps:=Ps-1;
          StarWrToMass.stY:=StrToInt(copy(StrRead, 1, Ps));

          PS:=Ps+1;
          delete(StrRead,1,Ps);
 {КОНЕЦ}
 {Находим координату Y}
          Ps:=pos('>',StrRead);

          if Ps=0 then
            begin
              ShowMessage('в строке нет управляющих символов');
              goto ex;
            end else if Ps>4 then
              begin
                ShowMessage('     Координата звезды Z    '+#13#10+
                            'не более 3 символов и знак >');
                goto ex;                            
              end;
          Ps:=Ps-1;
          StarWrToMass.stZ:=StrToInt(copy(StrRead, 1, Ps));

          PS:=Ps+1;
          delete(StrRead,1,Ps);
 {КОНЕЦ}
 {Находим наконец ИМЯ звезды}
          Ps:=pos('>',StrRead);

          if Ps=0 then
            begin
              ShowMessage('в строке нет управляющих символов');
              goto ex;
            end else if Ps>3 then
              begin
                ShowMessage('  Имя звезды не боле  '+#13#10+
                            'двух символов и знак >');
                goto ex;                            
              end;

          Ps:=Ps-1;
          StarWrToMass.stName:=copy(StrRead, 1, Ps);
          PS:=Ps+1;
          delete(StrRead,1,Ps);
 {КОНЕЦ}
   
 {Пишем все это в массив}
        StarCoo[i,0]:=StarWrToMass.stX;
        StarCoo[i,1]:=StarWrToMass.stY;
        StarCoo[i,2]:=StarWrToMass.stZ;

        StarName[i]:=StarWrToMass.stName
     end;
   end;
{*************************************
*                                   *
*  Начинаем поиск звезды масимально *
*  включающим в свой радиус других  *
*  звезд                            *
*                                   *
*************************************}

 
For ir:=0 to Form1.Memo1.Lines.Capacity-1 do
 begin
   StarStatic.stX:=StarCoo[ir,0];
   StarStatic.stY:=StarCoo[ir,1];
   StarStatic.stZ:=StarCoo[ir,2];
   StarStatic.stName:=StarName[ir];
//---------------------------------
   Stars_Schet:=0; //на каждую звезду по св счетчику

  For i:=0 to Form1.Memo1.Lines.Capacity-1 do
    begin
     {******************************
      **что бы не провер саму себя**
      ******************************}

      if ir<>i then
      begin
        StarWrToMass.stX:=StarCoo[i,0];
        StarWrToMass.stY:=StarCoo[i,1];
        StarWrToMass.stZ:=StarCoo[i,2];
//----------------------------------------
       StarWrToMass.stName:=StarName[ii];

        X_r:=StarStatic.stX-StarWrToMass.stX;
        Y_r:=StarStatic.stY-StarWrToMass.stY;
        Z_r:=StarStatic.stZ-StarWrToMass.stZ;
       
        if X_r<0 then X_r:=X_r*(-1); //Корректировка результ
        if Y_r<0 then Y_r:=Y_r*(-1); //чтоб небыл отрицат
        if Z_r<0 then Z_r:=Z_r*(-1); //т.к. он тогда ... ну понятно

        Form1.e_X.Text:=IntToStr(X_r);
        Form1.e_Y.Text:=IntToStr(Y_r);
        Form1.e_Z.Text:=IntToStr(Z_r);
//         ShowMessage('Счет');

        if X_r<=StrToInt(Form1.le_Radius.Text) then
         if Y_r<=StrToInt(Form1.le_Radius.Text) then
          if Z_r<=StrToInt(Form1.le_Radius.Text) then
             begin
//                ShowMessage('Есть попадание по коор Х'+#10#13+
//                            'Есть попадание по коор Y'+#10#13+
//                            'Есть попадание по коор Z');

               Stars_Schet:=Stars_Schet+1;
             end;
             
{****************
 * Конец поиска *
 ****************}

      end;
  end;

// прячем в массиве : )

Star_M[ir].St_Col:=Stars_Schet;
Star_M[ir].St_Nam:=StarStatic.stName;

end;
{******************************
* А вот теперь ищем максимум *
********************************************************
* оно и будет максим звездой  * если ничего не напутал *
*******************************************************}
 max:=Star_M[0].St_Col;

 For i:=0 to Form1.Memo1.Lines.Capacity-1 do
    begin

     if Star_M[i].St_Col>max then

       begin

        max:=Star_M[i].St_Col;

//         max_o:=IntToStr(max)+'...'+Star_M[i].St_Nam;

       end;
    end;
//Вдруг несколько звездочек будут одинаковы тоже выведем
 For i:=0 to Form1.Memo1.Lines.Capacity-1 do
  begin

    if Star_M[i].St_Col=max then
      begin
        max_o:=max_o+(IntToStr(max)+'...'+Star_M[i].St_Nam+'.'+#32#32#32);
      end;
  end;
 ex:
end;
{************************
*  Пример ввода чисел  *
* 3>13>3>s1>           *
* 19>9>9>s2>           *
* 22>2>22>s3>          *
* 11>16>11>s4>         *
* 43>3>3>s5>           *
* 9>29>39>s6>          *
* 21>12>2>s7>          *
* 11>1>11>s8>          *
* 3>3>3>s9>            *
* 19>19>9>a1>          *
* 2>2>22>a2>           *
* 31>13>13>a3>         *
* 43>13>43>a4>         *
* 15>15>9>a5>          *
* 22>22>22>a6>         *
* 15>19>11>a7>         *
************************}

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
{****************************************
* Замонстрячим защиту от неправильного *
* ввода данных                         *
*                                      *
****************************************}

Case Key of
 'a'..'z' :;
 '0'..'9' :;
 'A'..'Z' :;
 Chr(13)  :;
 Chr(8)   :;
 '>'      :;
 else
   begin
     Key :=Chr(0); // символ не отображать
     ShowMessage('      Можно вводить     '+#10+#13+
                 'только с a-z A-Z 0-1 и >');
   end;

end;
end;

procedure TForm1.le_RadiusKeyPress(Sender: TObject; var Key: Char);
begin
Case Key of
  '0'..'9' :;
  else begin
     Key :=Chr(0); // символ не отображать
     ShowMessage('Только цифры 0-9');
       end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
 it    : Integer;
 fg    : String;
begin

{*************************************
* Для отладки что унас в массиве-то *
*                                   *
****************i*********************}
for it:=0 to Form1.Memo1.Lines.Capacity-1 do
 begin
  fg:=fg+#32#32+IntToStr(Star_M[it].St_Col)+'..'+Star_M[it].St_Nam;
 end;

 Form1.Edit1.Text:=fg;

 Form1.e_max.Text:=max_o;

//  ss:=StrToInt(Form1.le_Radius.Text);
//  Form1.e_X.Text:=IntToStr(StarCoo[ss,0]);
//  Form1.e_Y.Text:=IntToStr(StarCoo[ss,1]);
//  Form1.e_Z.Text:=IntToStr(StarCoo[ss,2]);


// form1.Edit1.Text:=IntToStr(Form1.Memo1.Lines.Capacity);
end;

end.




--------------------
Программа делает то что вы ей приказали а не то что бы ВАМ хотелось бы.
МЕРФИ
---------------------
RTFM - Read the fucking manual
---------------------
http://www.livejournal.com/users/lonley_raven/
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 21.06.2025 13:44
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"