Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.10.30;
Скачать: CL | DM;

Вниз

Пятничные задачки. С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;
Скачать: CL | DM;

Наверх




Память: 0.61 MB
Время: 0.044 c
14-1129093537
Ega23
2005-10-12 09:05
2005.10.30
С днем рождения! 12 октября


2-1128958528
Bobby Digital
2005-10-10 19:35
2005.10.30
функция Random


14-1128501536
DelphiN!
2005-10-05 12:38
2005.10.30
Сколько часов в день вы уделяете непосредственно программированию


14-1128679524
КаПиБаРа
2005-10-07 14:05
2005.10.30
Какие мысли вас посещают, когда


14-1128886489
Bogdan1024
2005-10-09 23:34
2005.10.30
КМП будет или нет?