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

Вниз

помогите накодить штуку(   Найти похожие ветки 

 
Григорий   (2011-06-01 21:36) [0]

Составить программную реализацию следующей игры: вдоль доски расположены лунки и в каждой .лунке лежит шар черного или белого цвета. Одним ходом разрешается менять местами два любых шара. Добиться того, чтобы сначала шли белые шары, а за ними - черные. Количество лунок вводится с клавиатуры, расположение шаров задается с помощью датчика случайных чисел.


 
Юрий Зотов ©   (2011-06-01 21:40) [1]

Пузырьковая сортировка?


 
Григорий   (2011-06-01 21:52) [2]

да


 
Юрий Зотов ©   (2011-06-01 22:27) [3]

Запустите программу, посмотрите ее в работе и подправьте, как нужно. Подсказка: всем белым шарам присваиваем число 1, а всем черным - число 2. Еще подсказка: хоть код и готовый, но Вам все равно придется разобраться  в нем до мельчайших деталей, иначе работу Вы не сдадите.

unit Unit1;

interface

uses
 Windows, SysUtils, Classes, Controls, Forms, ExtCtrls, StdCtrls;

type
 TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
 private
   procedure ButtonClick(Sender: TObject);
   procedure VisualSwap(L, R: integer);
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

const
 Len = 10;
 Size = 50;

var
 Arr: array[1..Len] of integer;
 Panels: array[1..Len] of TPanel;

procedure TForm1.FormCreate(Sender: TObject);
var
 i: integer;
begin
 BorderStyle := bsDialog;
 SetBounds(Left, Top, 600, 200);
 Position := poScreenCenter;
 with TButton.Create(Self) do
 begin
   Caption := "Start";
   Left := Self.Width - Width - 16;
   Top := Self.Height - Height - 32;
   OnClick := ButtonClick;
   Parent := Self
 end;
 Randomize;
 for i := 1 to Len do
 begin
   Arr[i] := 1 + Random(100);
   Panels[i] := TPanel.Create(Self);
   Panels[i].Caption := IntToStr(Arr[i]);
   Panels[i].SetBounds(Size * (i - 1), 0, Size, Size);
   Panels[i].Parent := Self
 end
end;

procedure TForm1.ButtonClick(Sender: TObject);
var
 i, j, A: integer;
begin
 TButton(Sender).Enabled := False;
 for i := Len downto 1 do
   for j := 1 to Len - 1 do
     if Arr[j] > Arr[j + 1] then
     begin
       A := Arr[j];
       Arr[j] := Arr[j + 1];
       Arr[j + 1] := A;
       VisualSwap(j, j + 1)
     end
end;

procedure TForm1.VisualSwap(L, R: integer);

 procedure Delay;
 var
   T: cardinal;
 begin
   T := GetTickCount + 1;
   while GetTickCount < T do
     Application.ProcessMessages
 end;

 procedure MoveDown(Panel: TPanel);
 var
   i: integer;
 begin
   for i := Panel.Top + 1 to  Panel.Top + Size + 10 do
   begin
     Panel.Top := i;
     Delay
   end
 end;

 procedure MoveUp(Panel: TPanel);
 var
   i: integer;
 begin
   for i := Panel.Top - 1 downto Panel.Top - Size - 10  do
   begin
     Panel.Top := i;
     Delay
   end
 end;

 procedure MoveLeft(Panel: TPanel);
 var
   i: integer;
 begin
   for i := Panel.Left - 1 downto Panel.Left - Size do
   begin
     Panel.Left := i;
     Delay
   end
 end;

 procedure MoveRight(Panel: TPanel);
 var
   i: integer;
 begin
   for i := Panel.Left + 1 to Panel.Left + Size  do
   begin
     Panel.Left := i;
     Delay
   end
 end;

var
 P: TPanel;
begin
 MoveDown(Panels[R]);
 MoveRight(Panels[L]);
 MoveLeft(Panels[R]);
 MoveUp(Panels[R]);
 P := Panels[R];
 Panels[R] := Panels[L];
 Panels[L] := P
end;
end.


 
Rouse_ ©   (2011-06-02 00:06) [4]

Чет, Юрч, быстро ты сдался :)
Меня сегодня по асе около четырех часов пытали как лабу написать, в итоге таки почти все разжевал и человек практически целиком задачу сам написал, с небольшими штрихами с моей стороны :)
ЗЫ: ох чую ща самая она - пора вопросов, подошла со стороны студентов :)


 
Юрий Зотов ©   (2011-06-02 00:14) [5]

> Rouse_ ©   (02.06.11 00:06) [4]
Готовая была. Пусть разбирается.


 
Германн ©   (2011-06-02 01:13) [6]


> Rouse_ ©   (02.06.11 00:06) [4]
>
> ЗЫ: ох чую ща самая она - пора вопросов, подошла со стороны
> студентов :)

Она самая.
Зато дочка уже принесла домой пять или шесть "конфетных вознаграждений" за сделанные ею курсовые по информатике, поскольку VBA приемлемо освоила она одна из всей группы. Похоже теперь уже мне придется к ней обращаться за помощью, если что. :)


 
Anatoly Podgoretsky ©   (2011-06-02 07:27) [7]

> Rouse_  (02.06.2011 00:06:04)  [4]

Да, стараются все поделить.


 
Ega23 ©   (2011-06-02 08:23) [8]


> Чет, Юрч, быстро ты сдался :)


Да не сдался он, эту работу не примут, если ТС код объяснить не сможет. А он не сможет, если не сядет и не разберётся досконально.


 
Григорий   (2011-06-02 09:18) [9]

спасибо :)


 
TUser ©   (2011-06-02 11:31) [10]


> Ega23 ©   (02.06.11 08:23) [8]

зависит от препода, увы


 
Очень злой   (2011-06-02 11:36) [11]


> Пузырьковая сортировка?


Зачем? Можно же одним проходом...

A: array of boolean;
// белые = true, черные = false;
...
   Lo := Low(A);
   Hi := High(A);
   repeat
     while A[Lo] do Inc(Lo);
     while not A[Hi] do Dec(Hi);
     if Lo <= Hi then
     begin
       Меняем местами A[Lo] и A[Hi];
       Inc(Lo);
       Dec(Hi);
     end;
   until Lo > Hi;
...


 
Ega23 ©   (2011-06-02 11:41) [12]


> зависит от препода, увы


Ну во времена моеучёбы такое фиг бы прокатило. Сдача программы происходила следующим образом:
1. Принёс исходник.
2. Скомпилил на месте.
3. Преподаватель потыркался в плане дураказащиты (если написано: "Введите целое число", то вводилась абракадабра).
4. Преподаватель проверил работоспособность программы.
5. Преподаватель смотрел код.
6. Если возникали какие-то вопросы или подозрения - просил код объяснить.

Иногда, для работ посложнее (курсовых, например) допускалось принести ноутбук и на нём продемонстрировать. Но это касалось уже всяких дополнительных примочек, например СУЬЛ используется какая-нибудь, которой в комп.классе тупо нет, или у меня на D5 всё написано, а в классе D4 стоит.


 
Юрий Зотов ©   (2011-06-02 11:44) [13]


> Очень злой   (02.06.11 11:36) [11]
> Зачем? Можно же одним проходом...

Цикл repeat, внутри которого 2 цикла while - это один проход?


 
Юрий Зотов ©   (2011-06-02 11:51) [14]


> Ega23 ©   (02.06.11 11:41) [12]

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


 
Очень злой   (2011-06-02 11:52) [15]


> Цикл repeat, внутри которого 2 цикла while - это один проход?


Ну переменная - то одна... Вернее две, одна от начала, другая с конца пока не встретятся.. так что в принциппе-то проход можно сказать один...


 
oldman ©   (2011-06-02 12:08) [16]


> Очень злой   (02.06.11 11:52) [15]
> > Цикл repeat, внутри которого 2 цикла while - это один
> проход?
> Ну переменная - то одна...


for i=1 to 10 do ... ;
for i=28 to 44 do ... ;
for i=1 to 76 do ... ;
for i=5 to 17 do ... ;

но переменная-то одна...


 
Юрий Зотов ©   (2011-06-02 12:16) [17]


> Очень злой   (02.06.11 11:52) [15]
> в принципе-то проход можно сказать один...

Так можно было бы сказать, если бы не было repeat. А поскольку repeat все же есть, то этот один проход повторяется - поэтому все равно получаем вложенный цикл. Причем, поскольку этот вложенный цикл реализован не одним, а двумя while, то теряем на лишних накладных расходах.

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


 
Очень злой   (2011-06-02 12:20) [18]


> oldman ©   (02.06.11 12:08) [16]


Хорошо, цикл while A[Lo] do Inc(Lo);

меняем на

if A[Lo] then
   begin
       inc(Lo);
       continue;
   end;


аналогично поступаем и со вторым циклом. и получаем единственный цикл...
Но не думаю что это рационально...

А вообще это одна итерация из алгоритма быстрой сортировки... ибо так как шары только белые и черные, следовательно одной итерации достаточно...


 
Anatoly Podgoretsky ©   (2011-06-02 12:47) [19]

> TUser  (02.06.2011 11:31:10)  [10]

Если накодит штуку баксов, то хватит любому предподавателю.


 
Anatoly Podgoretsky ©   (2011-06-02 12:48) [20]

> Юрий Зотов  (02.06.2011 11:44:13)  [13]

Если поделить на три, то один


 
Юрий Зотов ©   (2011-06-02 12:50) [21]

> одной итерации достаточно

В принципе, да. Алгоритм простой - идем по циклу и, если встретили белый шар, то делаем ему remove и insert в начало массива, а если черный - то remove и insert в конец. Но:

1. Эти remove и insert, возможно, тоже потребуют циклов для переупорядочивания шаров.

2. В условии сказано, что шары можно менять местами, но не сказано, что их можно перемещать.


 
Anatoly Podgoretsky ©   (2011-06-02 12:52) [22]

> oldman  (02.06.2011 12:08:16)  [16]

Вот вообще без проходов

procedure I;
  for i=1 to 10 do ... ;
  for i=28 to 44 do ... ;
  for i=1 to 76 do ... ;
  for i=5 to 17 do ... ;
end;


I;


 
Очень злой   (2011-06-02 13:15) [23]


> Юрий Зотов ©   (02.06.11 12:50) [21]
>
> > одной итерации достаточно
>
> В принципе, да. Алгоритм простой - идем по циклу и, если
> встретили белый шар, то делаем ему remove и insert в начало
> массива, а если черный - то remove и insert в конец. Но:
>
>
> 1. Эти remove и insert, возможно, тоже потребуют циклов
> для переупорядочивания шаров.
>
> 2. В условии сказано, что шары можно менять местами, но
> не сказано, что их можно перемещать.


Хм...
Первый идет от начала пока не встретит черный шар
Второй идет от конца пока не встретит белый шар
Если первый еще не встретился со вторым то меняем эти 2 шара местами и идем дальше пока не встретимся.
ничего не перемещается. просто меняются местами...

Пример:
123456789
000110110

Первый идет от 1 до 4. (ибо на 4- черный шар)
второй от 9 до 9, т.е. стоит (на  9 белый шар.)
меняем местами 4 и 9

123456789
000010111

Далее первый идет  с 4 до 5 (на 5 черный шар)
Второй идет от 9 до 6 (на 6 белый шар)
Меняем местами 5 и 6

123456789
000001111

Первый идет дальше и второй тоже... Встретились друг с другом - конец...


 
Юрий Зотов ©   (2011-06-02 13:35) [24]

> Очень злой   (02.06.11 13:15) [23]

Ваш алгоритм был понятен, разъяснения лишние. Но есть ключевые слова: "и идем дальше пока не встретимся".

Это и есть тот самый repeat, который уже был разобран в [17]. Как ни крути - все равно цикл в цикле получается. Плюс потери на накладные расходы в двух внутренних циклах вместо одного.


 
Inovet ©   (2011-06-02 14:05) [25]

Да, непонятен смысл прохода с двух концов.


 
oldman ©   (2011-06-02 14:27) [26]


> Очень злой   (02.06.11 13:15) [23]


А не проще (для, например, черного цвета):

I=1

Идем с позиции I, пока не встретим шар белого цвета. Запоминаем позицию N.
Идем дальше, пока не встретим шар черного цвета L на позиции М.
(Если не встретили - конец сортировки)
Меняем шар L с шаром M-1, пока L не достигнет N
I=N+1
Возвращаемся к началу прохода


 
Очень злой   (2011-06-02 14:34) [27]


> Да, непонятен смысл прохода с двух концов.


1. так достигается минимальное количество обменов шариков.
2. если не учитывать сам процесс обмена, то каждый элемент массива шариков проверяется только один раз.
3. Сложность алгоритма - N, а у этого:

>  for i := Len downto 1 do
>    for j := 1 to Len - 1 do
>      if Arr[j] > Arr[j + 1] then
>      begin
>        A := Arr[j];
>        Arr[j] := Arr[j + 1];
>        Arr[j + 1] := A;
>        VisualSwap(j, j + 1)
>      end


N^2
Да и внутренние циклы - просто "прокручивают" переменные, облегчая работу внешненго цикла. Посему теоретически это все-таки один проход, несмотря на вложенные циклы...


 
oldman ©   (2011-06-02 14:45) [28]


> Очень злой   (02.06.11 14:34) [27]
> > Да, непонятен смысл прохода с двух концов.
> 1. так достигается минимальное количество обменов шариков.


В условии задачи нет "за минимальное время/количество перестановок"
:)))


 
Очень злой   (2011-06-02 14:57) [29]


> В условии задачи нет "за минимальное время/количество перестановок"
> :)))


А. Ну да... Как-то не подумал над этим...
Ну если важна "зрелищность" программы, т.е. запустить и показать как она будет долго мучаться переставляя шары и наконец-то их переставит, причем большее количество перестановок произведет лучший эффект на преподавателя, то тогда есть алгоритм сортировки помедленнее пузырькового... о котором нам когда-то в школе рассказывали... )


 
Inovet ©   (2011-06-02 14:59) [30]

> [27] Очень злой   (02.06.11 14:34)
> 3. Сложность алгоритма - N

Так и с одного конца тоже получается ведь.


 
Юрий Зотов ©   (2011-06-02 15:17) [31]

> Очень злой
Вот нормальный пузырек:

for i := 1 to Len - 1 do
 for j := 1 to Len - i do
   if Arr[j] > Arr[j + 1] then
   begin
     A := Arr[j];
     Arr[j] := Arr[j + 1];
     Arr[j + 1] := A;
   end;

И оптимальнее этого Вы пузырек не напишете. А если хотите поговорить о КОНКРЕТНОЙ задаче, где только черное и белое, то давайте именно о НЕЙ и поговорим. И для начала прочитаем ее условие - требуется сделать ИГРУ. В которой никакая оптимизация и вовсе не нужна, потому что визуальные перестановки сожрут в миллион раз больше времени, чем сама сортировка.

PS
Странно, но когда новичку требовалась помощь, Вас в ветке почему-то не было. А когда она уже не требовалась, Вы появились.


 
KilkennyCat ©   (2011-06-02 15:29) [32]

любят задачки про шары....


 
Inovet ©   (2011-06-02 15:33) [33]

> [0] Григорий   (01.06.11 21:36)
> Одним ходом разрешается менять местами два любых шара.

> [1] Юрий Зотов ©   (01.06.11 21:40)
> Пузырьковая сортировка?

> [2] Григорий   (01.06.11 21:52)
> да

По условию получается необязательно пузырьковая.


 
Inovet ©   (2011-06-02 15:35) [34]

> [32] KilkennyCat ©   (02.06.11 15:29)
> любят задачки про шары....

Карманный биллиард даёт о себе знать.


 
Очень злой   (2011-06-02 15:45) [35]


> PS
> Странно, но когда новичку требовалась помощь, Вас в ветке
> почему-то не было. А когда она уже не требовалась, Вы появились.
>


Просто я на форум зашел поздно.

Да и извиняюсь конечно, но просто не обратил внимания не этот пост:

> Григорий   (01.06.11 21:52) [2]
>
> да


 
Dennis I. Komarov ©   (2011-06-02 16:43) [36]

Давайте усложним:
Допустим кол-во шаров <=32

на вход подается случайное целое (32 bit) - есть первоначальное положение шаров: 0 - белый, 1 - другой
1. выполнить [0] с помощью логических операций (or and xor shl и т.п)
2. выполнить данную сортировку за минимальное кол-во перемещений

З.Ы. Задача (хотя и не пятница) для новечков


 
Очень злой   (2011-06-02 17:02) [37]


> 1. выполнить [0] с помощью логических операций (or and xor
> shl и т.п)

Все зависит от того что тут важно: процесс или сам результат...
В [0] был важен процесс, т.е. обмен местами двух шаров...
А если результат - то получается что нужно на выходе получить число, у которого столько же единиц, сколько и у исходного значения, только все единицы сдвинуты к одному (навенрое правому) краю.


> З.Ы. Задача (хотя и не пятница) для новечков


Эх. Когдато МВо каждую пятницу задачки выкладывал... Интерестно было...
А сейчас что-то уже давно нет задачек... :(


 
Dennis I. Komarov ©   (2011-06-02 17:08) [38]


> А если результат - то получается что нужно на выходе получить
> число,

Не совсем. Данная задача направлена на изучение логических операций, т.е. смысл составить алгоритм и закодировать его. Ценность в самой программе, т.е. уменее ее написать нежели результат.

Для полноты задания: на выходе получить последовательность чисел, каждое из которых указывает операцию перемещения, соответствующие биты которого "1" остальные "0"


 
Юрий Зотов ©   (2011-06-02 17:43) [39]

> Dennis I. Komarov ©   (02.06.11 16:43) [36]

1. Сосчитать N - количество нулевых бит в 32-битном целом (проще и быстрее всего сделать это по заранее составленной таблице).
2. Ответ: $FFFFFFFF shr N


 
Dennis I. Komarov ©   (2011-06-02 18:05) [40]


> Юрий Зотов ©   (02.06.11 17:43) [39]

да это понятно, но из [0]:

> Одним ходом разрешается менять местами два любых шара.

да и [38] дописал...



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

Форум: "Начинающим";
Текущий архив: 2011.09.18;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.57 MB
Время: 0.004 c
3-1263481831
Vasilii
2010-01-14 18:10
2011.09.18
Драйвер Firebird


3-1262952948
Xmen
2010-01-08 15:15
2011.09.18
Ошибка ORA-12571


2-1307083946
TKN
2011-06-03 10:52
2011.09.18
Стереть информацию с дискеты (флеш-диска)


15-1306479827
xayam
2011-05-27 11:03
2011.09.18
Страны, города, языки и т.д.


8-1187098476
leonidus
2007-08-14 17:34
2011.09.18
Где найти компонент отображающий Thumbnail ?





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский