Теория графов., Раскраска карты минимальным кол_вом цветов Опции

[-StrangerFX-]

Программа раскрашивания карты минимальным количеством цветов.

Исходные данные:

- Список регионов с указанием соседей каждого региона.

Выходные данные:

- Список регионов с приписанными им цветами.
- Общее число использованных цветов.

Требованния к фунуциональности:

- Эфективность решения.
- Наглядный вывод результата(раскраска карты).
- Опционально редактор карт(с возможностью рисовать мышью).

Вопрос следуюший, как сделать редактор карт с возможностью рисования мышью и удомным для пользователя меню.

[strangerfx]

Провел поиск багов и получил следующее: (Показать/Скрыть)

{$D+}
uses crt;
type gh=array[1..20] of string;
	 map=record
		   land:string;
		   col:byte;
		   sos:gh;
		   color:byte;
		 end;
	 mapptr=^mappt;
	 mappt=record
			 dat:map;
			 next:mapptr;
		   end;

var fmap:file of map;
	first:mapptr;
	mp:map;
	q,n:integer;
	mas:array[1..50] of pointer;

procedure upcase(var s:string);
var g:char;
	i,h:integer;
begin
  h:=length(s);
  for i:=1 to h do begin
   g:=s[i];
   if g<>' ' then case ord(g) of
		   97..122: s[i]:=chr(ord(g)-32);
		   160..175: s[i]:=chr(ord(g)-32);
		   224..239: s[i]:=chr(ord(g)-80);
		  end;
		end;
end;

procedure Create_file;
var i,j:integer;
	mp:map;
begin
  clrscr;
  write('Введите количество стран в регионе -> ');
  readln(n);
  for j:=1 to n do
	begin
	  write('Введите страну №',j,' -> ');
	  readln(mp.land);
	  upcase(mp.land);
	  write('Введите количество соседей -> ');
	  readln(mp.col);
	  for i:=1 to mp.col do
		begin
		  write('Введите соседа №',i,' ');
		  readln(mp.sos[i]);
		  upcase(mp.sos[i]);
		end;
	  mp.color:=0;
	  clrscr;
	  reset(fmap);
	  i:=filesize(fmap);
	  seek(fmap,i);
	  write(fmap,mp);
	  close(fmap);
	end;
end;

procedure Create_list(var first:mapptr);
var tec,tec1,pred:mapptr;
begin
  reset(fmap);
  first:=nil;
  while not eof(fmap) do
	begin
	  new(tec);
	  read(fmap,tec^.dat);
	  tec^.next:=nil;
	  if first=nil
		then
		  first:=tec
		else
		  begin
			tec1:=first;
			pred:=nil;
			while (tec1<>nil) and
			(tec^.dat.col>tec1^.dat.col) do
			  begin
				pred:=tec1;
				tec1:=tec1^.next;
			  end;
			if tec1=first
			  then
				begin
				  tec^.next:=first;
				  first:=tec;
				end
			  else
				begin
				  tec^.next:=pred^.next;
				  pred^.next:=tec;
				end;
		  end;
	end;
end;

procedure Move_list(first:mapptr);
var i:integer;
	tec:mapptr;
begin
  clrscr;
  fillchar(mas,sizeof(mas),0);
  tec:=first;
  i:=0;
  while tec<>nil do
	begin
	  with tec^.dat do
		begin
		  inc(i);
		  mas[i]:=tec;
		end;
	  tec:=tec^.next;
	end;
  q:=i;
  readln;
end;

procedure rasshet;
var tec:mapptr;
	x,i,j,k,b:integer;
	g:byte;
	mas_s:array[1..20] of string;
begin
  tec:=mas[q];
  g:=1;
  with tec^.dat do
	begin
	  tec^.dat.color:=g;
	  x:=1;
	  mas_s[x]:=tec^.dat.land;
	end;
  while x<>q do
	begin
	  writeln('x= ',x,' q= ',q);
	  readln;
	  for i:=1 to q-1 do
		begin
		  tec:=mas[i];
		  with tec^.dat do
			begin
			  if tec^.dat.color=0
				then
				  begin
					b:=0;
					writeln(land);
					for j:=1 to x do
					  begin
						for k:=1 to tec^.dat.col do
						  begin
							writeln('mas_s[j] = ',mas_s[j],' tec^.dat.sos[k] = ',tec^.dat.sos[k]);
							if mas_s[j]=tec^.dat.sos[k]
							  then
								inc(b);
						  end;
					  end;
					writeln('b= ',b);
					if (b=0) and (tec^.dat.color=0)
					  then
						begin
						  tec^.dat.color:=g;
						  writeln(tec^.dat.land,' ',tec^.dat.color);
						  readln;
						  inc(x);
						  mas_s[x]:=tec^.dat.land;
						end;
				  end;
			end;
		end;
	  inc(g);
	  for i:=1 to 20 do mas_s[i]:='';
	end;
end;

procedure Mov_list(first:mapptr);
var tec:mapptr;
begin
  clrscr;
  tec:=first;
  while tec<>nil do
	begin
	  with tec^.dat do
		begin
		  writeln(land,' ',col,' ',color);
		end;
	  tec:=tec^.next;
	end;
  readln;
end;

begin
  assign(fmap,'map.dat');
  {create_file;}
  create_list(first);
  move_list(first);
  rasshet;
  mov_list(first);
end.

.
Теперь все работает . Осталось только все в графическом
виде представить.

[Lapp]

Теперь все работает . Осталось только все в графическом
виде представить.

Немного странная манера: попросить о помощи, а потом даже не замечать постов с той самой помощью.
И если уж постишь свою прогу (кстати, без единого комментария), то по крайней мере прилагай файл данных, как просил тебя volvo, или хотя бы опиши его формат. Или ты считаешь мы должны просто распечатать, повестить твое бессмертное творение на стену и восхищаться?..

[strangerfx]

Немного странная манера: попросить о помощи, а потом даже не замечать постов с той самой помощью.
И если уж постишь свою прогу (кстати, без единого комментария), то по крайней мере прилагай файл данных, как просил тебя volvo, или хотя бы опиши его формат. Или ты считаешь мы должны просто распечатать, повестить твое бессмертное творение на стену и восхищаться?..

1. За помощь спасибо(кстати я ее всегда замечаю), но рекурентное решение задачи неподходит по условию написания работы (обязательно использование списков и/или деревьев).
2. Я бы приложил фаил если бы знал как это сделать.
3. Коментариев к проге неписал по причине нехватки времени, и распечатывать ее совершенно необязательно!.
4. Вопрос: где можно скачать TPU фаил для работы с мышью?

[Lapp]

> 1. За помощь спасибо(кстати я ее всегда замечаю),
Я не зрение твое имел в виду. Замечать - значит "реагировать". Игнорировать в разговоре = не замечать. Или я неправильно трактую русский язык? Спасибо, вытянуте клещами, звучит странновато.. но ничего, принимаю.

> но рекурентное решение задачи неподходит по условию написания
> работы (обязательно использование списков и/или деревьев).
Неплохо было бы это упомянуть с самого начала..

> 2. Я бы приложил фаил если бы знал как это сделать.
Кнопочки "Browse" и "Добавить файл" настолько малозаметны?.. Ну, в таком случае можно было бы спросить..

> 3. Коментариев к проге неписал по причине нехватки времени,
Комментарии - твой личный вопрос, но только пока ты не показываешь прогу другим. Простая вежливость требует писать их, если ты передаешь программу, особенно с целью поиска ошибок. Не верю, что на написание нескольких слов уходит много времени. В качестве примера можешь посмотреть мой код (выше).

> и распечатывать ее совершенно необязательно!.
Но что тогда с ней делать? Никакого вопроса с ней задано не было..

> 4. Вопрос: где можно скачать TPU фаил для работы с мышью?
Это отдельный вопрос, отдельная тема..