Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2005.10.30;
Скачать: [xml.tar.bz2];

Вниз

Пятничные задачки. Сogito ergo sum.   Найти похожие ветки 

 
default ©   (2005-10-07 15:14) [40]

GuAV ©   (07.10.05 12:59) [29]
по-моему нифига не линеен
расскажи алгоритм на словах


 
default ©   (2005-10-07 15:15) [41]

Прынц   (07.10.05 15:03) [39]
"Покой нам только снится"(c)


 
MBo ©   (2005-10-07 15:31) [42]

>default ©   (07.10.05 14:30) [38]
>MBo ©   (07.10.05 14:17) [37]
>да, неплохо бы словами объяснил

у GuAV примерно так, если не ошибаюсь:
Запоминаем очередной (n-й) элемент, смещаем по очереди n+Shift*i -ые (по модулю) элементы на Shift влево, пока не упремся в n-Shift.

>кстати, у Вас в ответе какой алгоритм?
Ну конкретного и единственного ответа здесь нет.


 
default ©   (2005-10-07 15:36) [43]

MBo ©   (07.10.05 15:31) [42]
так линейности вроде не получается?


 
GuAV ©   (2005-10-07 15:51) [44]


>GuAV ©   (07.10.05 12:59) [29]
> расскажи алгоритм на словах

Внутренний repeat:

Запоминаем первый элемент и заменяем его элементом  удалённым на shift от первого, его в свою очередь удалённым от него на shift и т.д., при нахождении индекса каждого элемента осуществляем wrap по длине строки с помощью mod; этот цикл прекращается когда доходим обратно до первого элемента, при этом для последнего берется ранее запомненое значение первого.

Внешний repeat:

Вышеописанный цикл пройдёт только элементы с индексами (N*НОД)+1, где N-целое число, НОД - наибольший общий делитель shift и length. Поэтому ведется учёт количества перемещенных символов Replaced, и если при завершении внутреннего Repeat цикла оно меньше длины, то внутренний цикл повторяется уже начиная со второго символа, затем третьего и т.д., пока не будут перемещены все символы.


 
GuAV ©   (2005-10-07 16:00) [45]

Линейность - это

> за время O(N)

, что означает число операций при удлинении строки в N раз увеличивается в N раз ?

Тогда это у меня соблюдается.


 
default ©   (2005-10-07 16:05) [46]

GuAV ©   (07.10.05 16:00) [45]
да, всё нормально
"Линейность - это

> за время O(N)

, что означает число операций при удлинении строки в N раз увеличивается в N раз ?
"
и это тоже, хотя настоящий смысл O(N) более общий


 
MBo ©   (2005-10-07 16:10) [47]

>default ©   (07.10.05 15:36) [43]
>так линейности вроде не получается?

получается.
Это, можно сказать, усовершенствованный с точки зрения памяти аналог простого алгоритма с потреблением памяти O(N), когда мы в доп. память записываем сдвигаемый кусок A (выбрав меньший), сдвигаем оставшийся B, копируем на своб. место А.


 
default ©   (2005-10-07 17:07) [48]

MBo ©   (07.10.05 16:10) [47]
самый лучший алгоритм который я знаю - это с обращением
пусть исходная строка ab, a-часть строки длиной сдвига, b-остаток
R-переставляет наоборот строку
тогда
R(R(a)R(b)) есть решение задачи


 
oldman ©   (2005-10-07 17:40) [49]


> 3. Вася Пупкин получил два предложения о работе.
> ..........
> Куда ему лучше податься?


Устроиться на об работы!!!

:)))


 
MBo ©   (2005-10-07 17:43) [50]

>default ©   (07.10.05 17:07) [48]
Да, я знаю. По моим тестам процедура с обращением строки раза в полтора-два быстрее, а уж про изящество и так понятно.


 
default ©   (2005-10-07 18:04) [51]

MBo ©   (07.10.05 17:43) [50]
да у GuAV мудрёно
тем более надо доказывать его корректность
типа нет зацикливаний до момента встречи с сохранённым элементом и некоторое другое...
ещё рекурсивная версия есть


 
GuAV ©   (2005-10-07 23:11) [52]

1.
unit avHanoi;

interface

uses SysUtils, Classes;

type
 TStick = 1..3;

 TOnMove = procedure(Sender: TObject; Src, Dest: TStick) of object;

 THanoiTowers = class(TObject)
 private
   FBlocks: array of TStick;
   FOnChange: TNotifyEvent;
   FOnMove: TOnMove;
   function GetIsBlockOnStick(Stick: TStick; Block: Integer): Boolean;
   procedure SetBlockCount(const Value: Integer);
   function GetBlockOnStick(Block: Integer): TStick;
   procedure SetBlockOnStick(Block: Integer; const Value: TStick);
   function GetBlockCount: Integer;
 protected
   procedure Changed;
   procedure Moved(Src, Dest: TStick);
 public
   property BlockCount: Integer read GetBlockCount write SetBlockCount;
   property IsBlockOnStick[Stick: TStick; Block: Integer]: Boolean read GetIsBlockOnStick;
   property BlockOnStick[Block: Integer]: TStick read GetBlockOnStick write SetBlockOnStick;
   procedure Move(Src, Dest: TStick);
   property OnChange: TNotifyEvent read FOnChange write FOnChange;
   property OnMove: TOnMove read FOnMove write FOnMove;
 end;

type
 THanoiSolver = class(TObject)
 private
   FTowers: THanoiTowers;
   procedure SetTowers(const Value: THanoiTowers);
   procedure GetBlockToStick(Block: Integer; Stick: TStick);
 public
   property Towers: THanoiTowers read FTowers write SetTowers;
   procedure Solve;
 end;

implementation

{ THanoiTowers }

function THanoiTowers.GetIsBlockOnStick(Stick: TStick; Block: Integer): Boolean;
begin
 Result := BlockOnStick[Block] = Stick;
end;

procedure THanoiTowers.SetBlockCount(const Value: Integer);
begin
 SetLength(FBlocks, Value);
 Changed;
end;

function THanoiTowers.GetBlockCount: Integer;
begin
 Result := Length(FBlocks);
end;

procedure THanoiTowers.Changed;
begin
 if Assigned(FOnChange) then
   FOnChange(Self);
end;

function THanoiTowers.GetBlockOnStick(Block: Integer): TStick;
begin
 Result := FBlocks[Block - 1] + 1;
end;

procedure THanoiTowers.SetBlockOnStick(Block: Integer; const Value: TStick);
begin
 FBlocks[Block - 1] := Value - 1;
end;

procedure THanoiTowers.Move(Src, Dest: TStick);
var I, J: Integer;
begin
 I := 1;
 while BlockOnStick[I] <> Src do
 begin
   Inc(I);
   if I > BlockCount then
     raise Exception.Create("Invalid move: stick is empty");
 end;
 for J := I downto 1 do
   if IsBlockOnStick[Dest, J] then
     raise Exception.Create("Invalid move: stick has a smaller (or this) block");
 BlockOnStick[I] := Dest;
 Moved(Src, Dest);
 Changed;
end;

procedure THanoiTowers.Moved(Src, Dest: TStick);
begin
 if Assigned(FOnMove) then
   FOnMove(Self, Src, Dest);
end;

function GetRemainingStick(S1, S2: TStick): TStick;
begin
 if (S1 <> 1) and (S2 <> 1) then
   Result := 1
 else if (S1 <> 2) and (S2 <> 2) then
   Result := 2
 else if (S1 <> 3) and (S2 <> 3) then
   Result := 3
 else
   raise Exception.Create("out of sticks");
end;

{ THanoiSolver }

procedure THanoiSolver.GetBlockToStick(Block: Integer; Stick: TStick);
var I: Integer; Src: TStick;
begin
 Src := FTowers.BlockOnStick[Block];
 if Stick = Src then
   Exit; // already there
 for I := Block - 1 downto 1 do
 begin
   GetBlockToStick(I, GetRemainingStick(Src, Stick));
 end;
 FTowers.Move(Src, Stick)
end;

procedure THanoiSolver.SetTowers(const Value: THanoiTowers);
begin
 FTowers := Value;
end;

procedure THanoiSolver.Solve;
var I: Integer;
begin
 for I := FTowers.BlockCount downto 1 do
   GetBlockToStick(I, 3);
end;

end.


 
GuAV ©   (2005-10-07 23:12) [53]

Форма тестового проекта
.pas
unit avHMain;

interface

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

type
 TForm1 = class(TForm)
   PaintBox1: TPaintBox;
   Panel1: TPanel;
   btnSetCount: TButton;
   Panel2: TPanel;
   Memo1: TMemo;
   Edit1: TEdit;
   Bevel1: TBevel;
   Edit2: TEdit;
   Edit3: TEdit;
   Label1: TLabel;
   btnPlay: TButton;
   Bevel2: TBevel;
   btnSolve: TButton;
   chkRecord: TCheckBox;
   Bevel3: TBevel;
   btnClr: TButton;
   Bevel4: TBevel;
   btnRandomize: TButton;
   procedure PaintBox1Paint(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure btnSetCountClick(Sender: TObject);
   procedure btnPlayClick(Sender: TObject);
   procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure PaintBox1Click(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure btnClrClick(Sender: TObject);
   procedure chkRecordClick(Sender: TObject);
   procedure btnSolveClick(Sender: TObject);
   procedure btnRandomizeClick(Sender: TObject);
 private
   FHanoi: THanoiTowers;
   FClickedRow: TStick;
   FClickedBlock: Integer;
   { Private declarations }
 public
   property Hanoi: THanoiTowers read FHanoi;
   procedure TryMove;
   procedure HanoiMove(Sender: TObject; Src, Dest: TStick);
   procedure HanoiChange(Sender: TObject);
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
 BlockHeight,
 BlockDeltaHalfWidth,
 BlockHalfWidth,
 BlockPos,
 StickPos,
 I: Integer;
 S: TStick;

begin
 with  Hanoi, PaintBox1, Canvas do
 begin
   BlockHeight := Height div BlockCount;
   BlockDeltaHalfWidth := (Width div 6) div BlockCount;
   with Brush do
   begin
     Color := clWindow;
   end;
   for S := Low(S) to High(S) do
   begin
     StickPos := MulDiv(Width, S * 2 - 1, 6);
     BlockPos := Height;
     for I := BlockCount downto 1 do
       if IsBlockOnStick[S, I] then
     begin
       BlockHalfWidth := BlockDeltaHalfWidth * (I + 0);
       Rectangle(
           StickPos - BlockHalfWidth,
           BlockPos - BlockHeight,
           StickPos + BlockHalfWidth,
           BlockPos
         );
       Dec(BlockPos, BlockHeight);
     end;
     MoveTo(StickPos, 0);
     LineTo(StickPos, PaintBox1.Height);
   end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FHanoi := THanoiTowers.Create;
 Hanoi.OnChange := HanoiChange;
 Hanoi.BlockCount := 4;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 FHanoi.Free;
end;

procedure TForm1.btnSetCountClick(Sender: TObject);
begin
 Hanoi.BlockCount := StrToInt(Edit1.Text);
end;

procedure NextNum(var I, J: Integer; const S: string);
var Len: Integer;
begin
 J := 0;
 Len := Length(S);
 while I <= Len do
   if (S[I] in ["0".."9"]) then
     Break
   else
     Inc(I);
 while I + J <= Len do
   if not (S[I + J] in ["0".."9"]) then
     Break
   else
     Inc(J);
end;

procedure TForm1.btnPlayClick(Sender: TObject);
var
 S: string;
 I, J: Integer;
begin
 TryMove;
 S := Memo1.Text;
 I := 1;
 NextNum(I, J, S);
 Edit2.Text := Copy(S, I, J);
 I := I + J;
 NextNum(I, J, S);
 Edit3.Text := Copy(S, I, J);
 I := I + J;
 Memo1.Text := Copy(S, I, MaxInt);
end;

function MulDiv(Number, Numerator, Denominator: Integer): Integer;
begin
 Result := Number * Numerator div Denominator;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
var
 I, ClickedCol: Integer;
begin
 with Hanoi do
 begin
   with PaintBox1 do
   begin
     FClickedRow := MulDiv(X, 3, Width) + 1;
     ClickedCol :=  MulDiv(Height - Y - 1, BlockCount, Height) + 1;
   end;
   FClickedBlock := 0;
   for I := BlockCount downto 1 do
     if IsBlockOnStick[FClickedRow, I] then
     begin
       Dec(ClickedCol);
       if ClickedCol = 0 then
       begin
         FClickedBlock := I;
         Break;
       end;
     end;
 end;
end;

procedure TForm1.PaintBox1Click(Sender: TObject);
begin
 if FClickedRow = 0 then Exit;
 if FClickedBlock <> 0 then
 begin
   Edit2.Text := IntToStr(FClickedRow);
 end
 else
 begin
   Edit3.Text := IntToStr(FClickedRow);
   TryMove;
 end;
end;

procedure TForm1.TryMove;
var I, J: Integer;
begin
 if TryStrToInt(Edit2.Text, I) then
   if TryStrToInt(Edit3.Text, J) then
     Hanoi.Move(I, J);
end;

procedure TForm1.HanoiChange(Sender: TObject);
begin
 PaintBox1.Invalidate;
end;

procedure TForm1.btnClrClick(Sender: TObject);
begin
 Memo1.Lines.Clear;
end;

procedure TForm1.HanoiMove(Sender: TObject; Src, Dest: TStick);
begin
 Memo1.Text := Memo1.Text + Format(" %d-%d", [Src, Dest]);
end;

procedure TForm1.chkRecordClick(Sender: TObject);
begin
 if chkRecord.Checked then
   Hanoi.OnMove := HanoiMove
 else
   Hanoi.OnMove := nil;
end;

procedure TForm1.btnSolveClick(Sender: TObject);
begin
 with THanoiSolver.Create do
 try
   Towers := Self.Hanoi;
   Solve;
 finally
   Free;
 end;
end;

procedure TForm1.btnRandomizeClick(Sender: TObject);
var I: Integer;
begin
 Hanoi.BlockCount := Random(4) + 3;
 for I := 1 to Hanoi.BlockCount do
   Hanoi.BlockOnStick[I] := Random(3) + 1;
end;

end.


 
GuAV ©   (2005-10-07 23:12) [54]

.dfm
object Form1: TForm1
 Left = 202
 Top = 107
 Width = 637
 Height = 353
 Caption = "Form1"
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = "MS Sans Serif"
 Font.Style = []
 OldCreateOrder = False
 OnCreate = FormCreate
 OnDestroy = FormDestroy
 PixelsPerInch = 96
 TextHeight = 13
 object Panel1: TPanel
   Left = 0
   Top = 0
   Width = 629
   Height = 161
   Align = alTop
   BevelInner = bvRaised
   BevelOuter = bvLowered
   TabOrder = 0
   object Bevel1: TBevel
     Left = 2
     Top = 2
     Width = 103
     Height = 39
     Shape = bsRightLine
   end
   object Label1: TLabel
     Left = 144
     Top = 16
     Width = 9
     Height = 13
     Caption = "to"
   end
   object Bevel2: TBevel
     Left = 138
     Top = 2
     Width = 103
     Height = 39
     Shape = bsRightLine
   end
   object Bevel3: TBevel
     Left = 280
     Top = 2
     Width = 65
     Height = 39
     Shape = bsRightLine
   end
   object Bevel4: TBevel
     Left = 360
     Top = 2
     Width = 65
     Height = 39
     Shape = bsRightLine
   end
   object btnSetCount: TButton
     Left = 40
     Top = 8
     Width = 57
     Height = 25
     Caption = "set count"
     TabOrder = 0
     OnClick = btnSetCountClick
   end
   object Memo1: TMemo
     Left = 8
     Top = 40
     Width = 609
     Height = 113
     TabOrder = 1
   end
   object Edit1: TEdit
     Left = 8
     Top = 8
     Width = 25
     Height = 21
     TabOrder = 2
     Text = "3"
   end
   object Edit2: TEdit
     Left = 112
     Top = 8
     Width = 25
     Height = 21
     TabOrder = 3
   end
   object Edit3: TEdit
     Left = 160
     Top = 8
     Width = 25
     Height = 21
     TabOrder = 4
   end
   object btnPlay: TButton
     Left = 192
     Top = 8
     Width = 41
     Height = 25
     Caption = "play"
     TabOrder = 5
     OnClick = btnPlayClick
   end
   object btnSolve: TButton
     Left = 432
     Top = 8
     Width = 57
     Height = 25
     Caption = "Solve !"
     TabOrder = 6
     OnClick = btnSolveClick
   end
   object chkRecord: TCheckBox
     Left = 280
     Top = 16
     Width = 57
     Height = 17
     Caption = "Record"
     TabOrder = 7
     OnClick = chkRecordClick
   end
   object btnClr: TButton
     Left = 248
     Top = 8
     Width = 25
     Height = 25
     Caption = "Clr"
     TabOrder = 8
     OnClick = btnClrClick
   end
   object btnRandomize: TButton
     Left = 352
     Top = 8
     Width = 65
     Height = 25
     Caption = "Randomize"
     TabOrder = 9
     OnClick = btnRandomizeClick
   end
 end
 object Panel2: TPanel
   Left = 0
   Top = 161
   Width = 629
   Height = 165
   Align = alClient
   BevelInner = bvRaised
   BevelOuter = bvLowered
   TabOrder = 1
   object PaintBox1: TPaintBox
     Left = 2
     Top = 2
     Width = 625
     Height = 161
     Align = alClient
     OnClick = PaintBox1Click
     OnMouseDown = PaintBox1MouseDown
     OnPaint = PaintBox1Paint
   end
 end
end


 
GuAV ©   (2005-10-08 00:05) [55]

На словах:

Переместить все диски на правый стержень от наибольшего к наименьшему

Переместить диск на стержень - убедится, что он ещё не на целевом стержне; затем переместить все диски меньше этого на стержень, не являющийся ни целевым, ни исходным для перемещаемого диска, от большего к меньшему; после чего переложить диск на стержень.


 
SergP.   (2005-10-08 04:32) [56]


> 3. Вася Пупкин получил два предложения о работе.
> Фирма "Рога и Копыта" предлагает ему 18000$ в год с увеличением
> каждый год
> на 2000$, а ООО "ЗюЗюЗю" предлагает тот же стартап с увеличением
> каждые полгода
> на 500$. Куда ему лучше податься?


С увеличением на 500 каждые полгода чего?
Годовой зарплаты или полугодовой ?



Страницы: 1 2 вся ветка

Форум: "Потрепаться";
Текущий архив: 2005.10.30;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.6 MB
Время: 0.038 c
1-1128537033
Aleksey
2005-10-05 22:30
2005.10.30
Динамическая работа с frame ами


8-1118165933
Charly22
2005-06-07 21:38
2005.10.30
Как быстро очистить Canvas?


1-1128684224
Viktop
2005-10-07 15:23
2005.10.30
Управление курсором


2-1128425114
Ugrael
2005-10-04 15:25
2005.10.30
форматы дат


14-1128934702
Igorek
2005-10-10 12:58
2005.10.30
Как писать хорошие книги по программированию





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский