Создание школьного расписания

Не такая она уже и простая, молодой человек, как вам кажется. Тут еще нужна
дополнительная инфа - сколько раз в неделю бывает та же Алгебра? На сколько
дней в неделю все это расчитано?
И может оказаться, что не уложимся в подсчетах. Тем более, программа - штука
бескомпромисная.
Получить правила : mailto:comp.soft.prog.prog-rules@subscribe.ru
Формат "дайджест" : mailto:comp.soft.prog.prog-digest@subscribe.ru
Формат "каждое письмо" : mailto:comp.soft.prog.prog-normal@subscribe.ru
Формат "читать с веба" : mailto:comp.soft.prog.prog-webonly@subscribe.ru

-*Информационный канал Subscribe.Ru
Написать в лист: mailto:comp.soft.prog.prog-list@subscribe.ru
Отписаться: mailto:comp.soft.prog.prog--unsub@subscribe.ru

http://subscribe.ru/ mailto:ask@subscribe.ru

Я считаю, что если ты пишешь программу на городской конкурс, то её надо
писать самому, а не привлекать людей со стороны. Нет, мелочи какие-нибудь
можно спросить . . . Как ты считаешь, алгоритм лёгкий, ТАК САМ НАПИШИ ЕГО!
Причем как я понимаю, именно сортировка является центром программы!
Может её ещё за тебя всю программу написать и с ней на городском конкурсе
выступить.

Но в принципе, задача интересная, и я попытался решить её:
Решал её я на Паскале, методом перебора.
Гарантия, что всё ОК будет 100%, а вот время выполнение не очень.
Program sort;
uses crt;
const
colP=6; {Количество придметов всего}
colDay=6;{количестов дней всего}
colLes=3;{Количество уроков в день}
type lesson= record
name:string;
bal:integer;
end;
var
i,j:integer;
mLes:array [0..colp] of Lesson;
WorkRasp,TempRasp:array[1..Colday,1..colLes] of integer;
zanit:array[1..colp] of boolean;
MAX:integer;
function MognoDalee:boolean;
var
i,j:integer;
MAxI,MinI:integer;
summa:INteger;
begin
MAxi:=0;
MinI:=$FFF;
for i:= 1 to colDay do
begin
summa:=0;
for j:= 1 to colLes do
begin
inc(summa,Mles[temprasp[i,j]].bal);
if Mles[temprasp[i,j]].bal=0 then
summa:=0;
end;
if summa<>0 then
begin
if summa> MaxI then Maxi:=summa;
if summa < MinI then MinI:=summa;
end;
end;
maxi:=MaxI-MinI;
if maxi>Max then MognoDalee:=false else MognoDalee:=true;
end;
function VSE:boolean;
var
result:boolean;
i:integer;
begin
result:=true;
for i:= 1 to colp do
if not zanit[i] then result:=false;
Vse:=result;
end;
procedure anal;
var
i,j:integer;
Summa,MaxI,MinI:integer;
begin
FillcHar(zanit,sizeof(zanit),0);
Maxi:=0; MinI:=$FFF;
for i:= 1 to colDay do
begin
summa:=0;
for j:= 1 to colLes do
begin
inc(summa,Mles[temprasp[i,j]].bal);
zanit[temprasp[i,j]]:=true;
end;
if summa> MaxI then Maxi:=summa;
if summa < MinI then MinI:=summa;
end;
MaxI:=MaxI-MinI;

if (MaxI<Max) and (vse) then
begin
MOve(TempRasp,WorkRasp,sizeof(TempRasp));
max:=MaxI;
end;
end;
procedure Ser(d,l:byte);
Var
les:byte;
begin
les:=0;
if MognoDalee then
repeat
inc(les);
tempRasp[d,l]:=les;
if (d=colday) and (l=colLes) then
anal else
begin
if l < colles then ser(d,l+1);
if l =colles then ser(d+1,1);
end;
until les=ColP;
end;
begin
mles[0].bal:=0;
mLes[1].name:='Ruski';
mLes[1].bal:=10;
Mles[2].name:='Phizik';
Mles[2].bal:=11;
Mles[3].name:='Matimatik';
Mles[3].bal:=12;
Mles[4].name:='Histori';
Mles[4].bal:=13;
Mles[5].name:='Fiz-ra';
Mles[5].bal:=5;
Mles[6].name:='Trud';
Mles[6].bal:=4;
Max:=$FFF;
ser(1,1);
clrscr;
for i:= 1 to colDay do
begin
gotoXY(i*10,1);
writeln('Day # ',i,' : ');
for j:= 1 to colLes do
begin
gotoxy(i*10,j+2);
write(Mles[workRasp[i,j]].name);
end;
end;
writeln;
writeln('Разность между самы загр и разгруж днями: ', max);
readln;
end.
В программе стоят данные в разделе Const, таки с которыми реально дождаться
результата.
А тебе нужен РАБОЧИЙ алгоритм, так что тебе придётся его переделать или
доработать.
По моемому, повысит время выполнения можно улучшав функцию MognoDalee;
Или как-нибудь код отредактировать.
Я писал на скорую руку, так что стиль не КРИТИКУЙТЕ.

P.S Программу я тестировал не очень доброкачественно, могут быт и ошибки.
Получить правила : mailto:comp.soft.prog.prog-rules@subscribe.ru
Формат "дайджест" : mailto:comp.soft.prog.prog-digest@subscribe.ru
Формат "каждое письмо" : mailto:comp.soft.prog.prog-normal@subscribe.ru
Формат "читать с веба" : mailto:comp.soft.prog.prog-webonly@subscribe.ru

-*Информационный канал Subscribe.Ru
Написать в лист: mailto:comp.soft.prog.prog-list@subscribe.ru
Отписаться: mailto:comp.soft.prog.prog--unsub@subscribe.ru

http://subscribe.ru/ mailto:ask@subscribe.ru

Hello Денис,

Saturday, January 17, 2004, 2:47:23 PM, you wrote:

Достаточно давно мне приходилось писать алгоритм выбора отимального
решения задачи из очень большой массы возможных вариантов(правда это
была некая расчетная функция и необходимо было найти наиболее точно те
исходные параметры при которых функция будет наиболее близка к
идеальной) Вычислительная техника тех времен была порядка на 3-4 менее
производительна поэтому простой пребор занял у нас около 2-х суток,
что естественно никого не устраивало.Поэтому применялись всякие методы
для упрощения поиска.
Задача составления оптимального расписания мне представляется
аналогичной задачей, только поле перебора вапиантов значительно меньше
( в месяце ну 25-26 учебных дней да и предметов не более я думаю 30)
современная ВТ на полный лобовой перебор потратит ну несколько секунд
так-что мой совет самый простой алгоритм лобового перебора и
запоминания варианта давшего лучший результат

Владимир

Здарова, Денис!

17 января 2004 г., суббота, 14:47:23, ты намылил:

Денису я уже выслал. Решил кинуть в лист на всеобщее порицание ;)
Поиздевайтесь на здоровье.
Малышев Георгий>Я писал на скорую руку, так что стиль не КРИТИКУЙТЕ.
А меня критикуйте сколько влезет 8')

Кстати вопрос модератору:
В лист можно кидать мыло с прикрепленным архивом? Если нет
посоветуйте маленькую прогу для создания UUE.

==Project1.dpr==
program Project1;

uses
Forms,
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
==End Project1.dpr==

==Unit1.dfm==
object Form1: TForm1
Left = 200
Top = 113
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object LesMemo: TMemo
Left = 0
Top = 0
Width = 100
Height = 160
Lines.Strings = (
'Русский'
'Английский'
'Математика'
'Физика'
'История'
'Химия'
'Физкультура'
'Биология'
'Литература'
'География')
TabOrder = 0
end
object LesFactorMemo: TMemo
Left = 101
Top = 0
Width = 30
Height = 160
Lines.Strings = (
'8'
'12'
'15'
'14'
'7'
'10'
'1'
'6'
'11'
'8')
TabOrder = 1
end
object Button1: TButton
Left = 190
Top = 36
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 2
OnClick = Button1Click
end
object LesAmountMemo: TMemo
Left = 132
Top = 0
Width = 30
Height = 160
Lines.Strings = (
'3'
'4'
'6'
'5'
'1'
'4'
'2'
'2'
'2'
'2')
TabOrder = 3
end
object DayAmountEdit: TEdit
Left = 180
Top = 0
Width = 121
Height = 21
TabOrder = 4
Text = '6'
end
object MaxFactorEdit: TEdit
Left = 330
Top = 0
Width = 121
Height = 21
TabOrder = 5
Text = '70'
end
end
==End Unit1.dfm==

==Unit1.pas==
unit Unit1;

interface

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

const max=20;
type
TForm1 = class(TForm)
LesMemo: TMemo;
LesFactorMemo: TMemo;
Button1: TButton;
LesAmountMemo: TMemo;
DayAmountEdit: TEdit;
MaxFactorEdit: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
Lessons: array [1..max] of String;
LessonsFactor: array [1..max] of Integer;
LessonsAmount, Tmp: array [1..max] of Integer;
TimeTable: array [1..60] of String;
TimeTableMemo: array [1..6] of TMemo;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

{$O-}
procedure TForm1.Button1Click(Sender: TObject);
var i, j: Integer;
DayAmount: Integer;
MaxLesPerDay: Integer;
LesPerWeek: Integer;
Done: Boolean;
MaxFactor: Integer;
LesAmount: Integer;
Factor: Integer;
Index: Integer;
Count: Integer;
FTmp: Integer;
label Hole;
begin
MaxFactor := StrToInt(MaxFactorEdit.Text);
LesPerWeek := 0;
DayAmount := StrToInt(DayAmountEdit.Text);
LesAmount := LesMemo.Lines.Count;
for i := 0 to LesAmount - 1 do
begin
Lessons[i+1] := LesMemo.Lines[i];
LessonsFactor[i+1] := StrToInt(LesFactorMemo.Lines[i]);
LessonsAmount[i+1] := StrToInt(LesAmountMemo.Lines[i]);
LesPerWeek := LesPerWeek + LessonsAmount[i+1];
// MaxFactor := MaxFactor + LesFactor[i+1];
end;
MaxLesPerDay := LesPerWeek div DayAmount + 1;
for i := 1 to DayAmount do
begin
TimeTableMemo[i] := TMemo.Create(Form1);
TimeTableMemo[i].Parent := Form1;
TimeTableMemo[i].Top := 200;
TimeTableMemo[i].Width := 100;
TimeTableMemo[i].Height := 160;
TimeTableMemo[i].Left := (i-1) * 100 + i - 1;
end;
Done := True;

repeat
Tmp := LessonsAmount;
for i := 1 to LesAmount do
Tmp[i] := Tmp[i] * LessonsFactor[i];
Tmp[max] := 0;
for i := 1 to DayAmount do
begin
Factor := 0;
TimeTable[i] := IntToStr(i) + '-й день' + #13#10 + '=====';
Count := 0;
for j := 1 to LesAmount do
begin
FTmp := Tmp[j];
Factor := Factor + Tmp[j];
while FTmp>0 do
begin
FTmp := FTmp - LessonsFactor[j];
inc(Count);
end;
end;
if (Count < MaxLesPerDay) or (Factor<MaxFactor) then
begin
for j := 1 to LesAmount do
while Tmp[j]>0 do
begin
Tmp[j] := Tmp[j] - LessonsFactor[j];
TimeTable[i] := TimeTable[i] + #13#10 + Lessons[j];
end;
GoTo Hole;
end;
j:=0;
Factor := 0;
while (j < Random(2) - 1 + MaxLesPerDay)
and (Factor <= MaxFactor) do
begin
inc(j);
Index := max;
while Tmp[Index]<=0 do
Index := random(LesAmount) + 1;
Factor := Factor + LessonsFactor[Index];
Tmp[Index] := Tmp[Index] - LessonsFactor[Index];
TimeTable[i] := TimeTable[i] + #13#10 + Lessons[Index];
end;
Hole:
TimeTableMemo[i].Lines.Add(TimeTable[i]);
Application.ProcessMessages;
end;
Done := False;
until not Done;
end;
{$O+}

procedure TForm1.FormDestroy(Sender: TObject);
var i: integer;
begin
for i := 1 to StrToInt(DayAmountEdit.Text) do
TimetableMemo[i].Free;
end;

end.
==End Unit1.pas==

--
Хочешь яркого и быстрого - сожги коробок спичек.

Здравствуйте !

Нет, к сожалению, субскрайб режет аттачи.
Сейчас, вроде листы "прозрачные" - как письмо приходит роботу,
так и отправляется в лист. Можно попробовать отправить письмо в
HTML. На самом деле то, что робот режет аттачи - благо.
Представьте - 20 чел. - приаттачили по метру чего нибудь, и
одновременно кинули в лист. Сколько времени через модем
это будет забираться ?

--
С уважением, Вахтуров Виктор.
Информационный сайт для программистов http://SoftMaker.com.ru
Получить правила : mailto:comp.soft.prog.prog-rules@subscribe.ru
Формат "дайджест" : mailto:comp.soft.prog.prog-digest@subscribe.ru
Формат "каждое письмо" : mailto:comp.soft.prog.prog-normal@subscribe.ru
Формат "читать с веба" : mailto:comp.soft.prog.prog-webonly@subscribe.ru

-*Информационный канал Subscribe.Ru
Написать в лист: mailto:comp.soft.prog.prog-list@subscribe.ru
Отписаться: mailto:comp.soft.prog.prog--unsub@subscribe.ru

http://subscribe.ru/ mailto:ask@subscribe.ru

Здарова, Victor V. Vakchturov!

23 января 2004 г., пятница, 00:50:15, ты намылил:

Да мне только для того чтобы исходниками размер письма не увеличивать,
т.е. так размер письма 10-15 kb а с архивом 6-7.

PS: Вопрос про UUE в силе.

--
Никогда больше не буду говорить афоризмами. Да, кстати, запишите мою последнюю
фразу

Здравствуйте, Victor.

Вы писали 22 января 2004 г., 21:50:15:

Если хочешь, могу кинуть на ящик. uucode и uudecode. В зипе 25
килобайт.

Приветствую!

Посмотри в сторону "линейного программирования".

--
С уважением, Иван
Получить правила : mailto:comp.soft.prog.prog-rules@subscribe.ru
Формат "дайджест" : mailto:comp.soft.prog.prog-digest@subscribe.ru
Формат "каждое письмо" : mailto:comp.soft.prog.prog-normal@subscribe.ru
Формат "читать с веба" : mailto:comp.soft.prog.prog-webonly@subscribe.ru

-*Информационный канал Subscribe.Ru
Написать в лист: mailto:comp.soft.prog.prog-list@subscribe.ru
Отписаться: mailto:comp.soft.prog.prog--unsub@subscribe.ru

http://subscribe.ru/ mailto:ask@subscribe.ru

Здравствуйте !

"Задача легкая" - это комбинатОрная задача. Как сказать... легкая.
Собственно, комбинаторика и посвящена таким штукам.

http://www.google.com.ru/search?q=%D0%B7%D0%B0%D0%B4%D0%B0%D1%87%D0%B0+%D1%8
1%D0%BE%D1%81%D1%82%D0%B0%D0%B2%D0%BB%D0%B5%D0%BD%D0%B8%D1%8F+%D1%80%D0%B0%D
1%81%D0%BF%D0%B8%D1%81%D0%B0%D0%BD%D0%B8%D1%8F&ie=UTF-8&oe=UTF-8&hl=ru&lr=

http://www.mnogosmenka.ru/drugoe/rektor.htm
http://kainsk.tomsk.ru/g2003/soft26/raspis.htm
http://ito.edu.ru/2003/IV/IV-0-2387.html

Ссылки выше. Это так - для раздумий :-)

--
С уважением, Вахтуров Виктор.
Информационный сайт для программистов http://SoftMaker.com.ru
Получить правила : mailto:comp.soft.prog.prog-rules@subscribe.ru
Формат "дайджест" : mailto:comp.soft.prog.prog-digest@subscribe.ru
Формат "каждое письмо" : mailto:comp.soft.prog.prog-normal@subscribe.ru
Формат "читать с веба" : mailto:comp.soft.prog.prog-webonly@subscribe.ru

-*Информационный канал Subscribe.Ru
Написать в лист: mailto:comp.soft.prog.prog-list@subscribe.ru
Отписаться: mailto:comp.soft.prog.prog--unsub@subscribe.ru

http://subscribe.ru/ mailto:ask@subscribe.ru