Здравствуйте...помогите пожалуйста разобраться с задачей...
Программно реализовать алгоритм сортировки простыми вставками. Каждая запись будет в качестве ключа содержать текстовое выражение, а в качестве информативной части некоторое число.
Тестовый набор записей перед сортировкой необходимо загрузить в память из файла. Файл с тестовым набором необходимо создать. Затем при необходимости изменить у него кодировку (в зависимости от того, в какой ОС Вы осуществляете программную реализацию). После этого для каждой записи берем в качестве ключа слово из исходного файла, а для информативной части его порядковый номер в исходном тексте. Для преобразования текстового файла в набор записей также необходимо выполнить программную реализацию, которая к тому же должна предусматривать создания определенного количества записей.
Nelson1992
16.09.2010 18:18
Я вот пытался что-то сделать...но не работает...
program sortnames; type ptrNameList = ^nameList; nameList = record name:String; next:ptrNameList; end; var firstElement,element,lastElement:ptrNameList; f,g:text; nameString:String; k:integer;
function firstElementGreaterThanSecond(element1,element2:ptrNameList):boolean; begin firstElementGreaterThanSecond := (element1^.name > element2^.name); end;
procedure switchElementsContent(element1,element2:ptrNameList); var temp:String; begin temp := element1^.name; element1^.name := element2^.name; element2^.name := temp; end;
procedure printList; var element:ptrNameList; begin element := firstElement; while (element<>nil) do begin writeln(element^.name); element := element^.next; end; writeln('конец списка'); end;
begin
{ Чтение списка }
firstElement := nil; Assign (f, 'c:\1.txt'); reset (f); while not eof(f) do begin readln(f,nameString); if (firstElement = nil) then begin new(element); firstElement := element; end else begin new(element^.next); element := element^.next; end; { end if } element^.name := nameString; element^.next := nil; end; { end while } close(f);
{ Сортировка методом пузырька }
element := firstElement;
{ Найдем последний элемент }
while (element<>nil) do element := element^.next; lastElement := element;
while (firstElement<>lastElement) do begin element := firstElement; while (element^.next<>lastElement) do begin if firstElementGreaterThanSecond(element,element^.next) then switchElementsContent(element,element^.next); element := element^.next; end; lastElement := element; end;
Reset(f); {открываем первый файл для чтения} Assign(g, 'c:\2.txt'); {устанавливаем связь второй файловой переменной с физическим файлом} Rewrite(g); {открываем второй файл для записи} While not eof(f) do Begin Readln(f,nameString);{считываем очередную строку из первого файла}
Writeln(g,nameString); {записываем во второй файл строки, удовлетворяющие условию}
end; close (f); close (G); end;
function kolslov(st: string): byte; const razdel = ['.', ',']; var k, d: integer; begin d := 0; repeat inc(d); if st[d] in razdel then begin delete(st, d, 1); insert(' ', st, d); end; until d > length(st); st := ' ' + st + ' ';//для корректной обработки абзацев while pos(' ', st) > 0 do delete(st, pos(' ', st), 1); d := pos(' ', st); k := -1;//количество слов на 1 меньше кол-ва пробелов while d > 0 do
kolslov := k end;
var t: text; slov: longint; filname, s: string; begin write('File = '); readln(filname); assign(t, filname); reset(t); while not eof(t) do begin readln(t, s);{читаем строку}
inc(slov, kolslov(s)); //3 или 5 пробелов также считаем признаком абзаца
end; end.
volvo
16.09.2010 18:55
Во-первых, то, что ты сюда вывалил, даже не компилируется, не то что не работает. А во-вторых, неплохо было бы прикрепить файл, который ты обрабатываешь...
Nelson1992
16.09.2010 19:13
Ну вот я и прошу мне помочь...потому,что не знаю как всё реализовать...и вот этот файл.
Текст сохраняется во втором файле но не отсортированный...
я возможно не правильно выразился...я не сам писал...я пытался сделать чтобы работало то что мне надо...но не могу...вот в чём проблема...
Rian
16.09.2010 22:22
чел такой пошаговый мануал еще поискать надо, там же каждая строка расписана
Nelson1992
16.09.2010 22:24
За ссылку спасибо...дело в том что я не там всё это нашёл...на другом сайте было...так,что щас буду читать...
Rian
16.09.2010 22:28
Цитата(Nelson1992 @ 16.09.2010 22:24)
За ссылку спасибо...дело в том что я не там всё это нашёл...на другом сайте было...так,что щас буду читать...
и еще по секрету ТОТ... код компилится сразу и даже работает))))
Nelson1992
16.09.2010 22:56
хм...вроде бы работает,..спасибо)
Rian
16.09.2010 23:02
Цитата(Nelson1992 @ 16.09.2010 22:56)
хм...что-то он не работает...и не выводит результат в текстовый файл...
в файл да не выводит... но зато на экран да.... alt+F5 жал?
Nelson1992
16.09.2010 23:11
ааа...всё...разобрался...работает...но оно сортирует после абзаца заново...можно как-то сделать чтобы весь текст полностью за один раз сортировало???
И ещё по заданию наверное мне надо не по строкам а по словам сортировать...
Rian
16.09.2010 23:15
загружать в массив по одному слову... делить строку
думаю сюда
readln(f,nameString); ... if (firstElement = nil) then добавить цикл рохода по словам
ну давай ему не всю строку а часть. как выделить? pos,copy,delete ищешь от пробела до пробела вырезаешь
Nelson1992
16.09.2010 23:19
Спасибо...буду пробовать...
-111-
28.09.2010 17:38
Скажите а как эту программу переделать так чтобы был не метод пузырька а метод вставками???
volvo
28.09.2010 18:16
Подумать, чем отличается метод "пузырька" от метода вставок, и реализовать не первый, а второй. Ты ж не думаешь, что ты - первый, кто интересуется, как отсортировать вставками список? Только список для этого лучше сделать не односвязный (только поле next), а двусвязный (поля prev и next)...
А вообще, проще не переделывать "эту программу", а написать заново.
Lapp
29.09.2010 4:50
Цитата(volvo @ 28.09.2010 19:16)
А вообще, проще не переделывать "эту программу", а написать заново.
Святые слова! Хотя, использование кусков кода из старой (если они того стоят) не возбраняется. Может, это наведет тебя на мысль об использовании процедур и юнитов..
Гость
29.09.2010 20:28
Вот есть програмка...она сортирует вставками...но в ней есть много лишнего...можете помочь?Мне надо убрать оттуда счётчик времени...мне не надо чтобы оно выводило сколько времени выполнялась программа,и убрать надо чтобы не выводило сколько раз встречалось слово...чтобы оно не считало это...и также оно считает после абзаца заново...а надо чтобы всё вместе...
program files_program; uses crt,dos; type string10=string[10]; link_type=^list_type; list_type=record value:string10; count:integer; link:link_type; end; longint_link=^longint; procedure files_names_query(var read_file,write_file,error:string); var f:text; begin error:=''; write('Считываемый файл: '); readln(read_file); assign(f,read_file); {$I-} reset(f); if (ioresult=0) then begin close(f); write('Файл для записи: '); readln(write_file); end else begin error:='Ошибка: файл не существует.'; end; {$I+} end; procedure put_into_list(s:string; var root:pointer); var element,prev_element,new_element:link_type; searched:boolean; begin if (root=nil) then begin new(element); root:=element; element^.value:=s; element^.count:=1; element^.link:=nil; end else begin searched:=FALSE; element:=root; prev_element:=nil; while ((element<>nil)and(not searched)) do begin if (element^.value=s) then begin element^.count:=element^.count+1; searched:=TRUE; end; if (prev_element<>nil) then begin if ((prev_element^.value<s)and(element^.value>s)) then begin new(new_element); new_element^.value:=s; new_element^.count:=1; new_element^.link:=prev_element^.link; prev_element^.link:=new_element; searched:=TRUE; end; end else begin if (element^.value>s) then begin new(new_element); new_element^.value:=s; new_element^.count:=1; new_element^.link:=element; root:=new_element; searched:=TRUE; end; end; prev_element:=element; element:=element^.link; end; if (not searched) then begin new(new_element); new_element^.value:=s; new_element^.count:=1; new_element^.link:=prev_element^.link; prev_element^.link:=new_element; end; end; end; procedure reading(read_file:string; var root:pointer; var seconds,seconds100:word); var simbol:char; f:text; s:string; hour,minutes:word; begin gettime(hour,minutes,seconds,seconds100); s:=''; assign(f,read_file); reset(f); while (not eof(f)) do begin while (not eoln(f)) do begin read(f,simbol); if (simbol<>' ') then begin s:=s+simbol; end else begin if (s<>'') then put_into_list(s,root); s:=''; end; end; if (s<>'') then put_into_list(s,root); readln(f,s); end; close(f); end; procedure writing(root:pointer; write_file:string; begin_seconds,begin_seconds100:word); var f:text; element:link_type; s,count,dseconds_string,dseconds100_string,time:string; hour,minutes,seconds,seconds100,dseconds,dseconds100:word; begin assign(f,write_file); rewrite(f); element:=root; while (element<>nil) do begin s:=element^.value; str(element^.count,count); s:=s+'-'+count; writeln(f,s); element:=element^.link; end; gettime(hour,minutes,seconds,seconds100); if (seconds<begin_seconds) then seconds:=seconds+60; if (seconds100<begin_seconds100) then seconds100:=seconds100+100; dseconds:=seconds-begin_seconds; dseconds100:=seconds100-begin_seconds100; str(dseconds,dseconds_string); str(dseconds100,dseconds100_string); time:=dseconds_string+'.'+dseconds100_string; writeln(f,time); close(f); end; var read_file,write_file,error:string; root:pointer; seconds,seconds100:word; begin root:=nil; if (paramstr(1)<>''){если есть параметры командной строки} then{то} begin read_file:=paramstr(1);{считываемый файл - первый параметр} write_file:=paramstr(2);{выходной файл - второй параметр} reading(read_file,root,seconds,seconds100);{считывание из файла и сортировка слов} writing(root,write_file,seconds,seconds100);{запись в файл} end else{если нет, то} begin files_names_query(read_file,write_file,error);{запрос имени файлов через пользовательский инерфейс} if (error='') then begin reading(read_file,root,seconds,seconds100);{считывание из файла и сортировка слов} writing(root,write_file,seconds,seconds100);{запись в файл} writeln('Готово!'); writeln('Нажмите Enter для продолжения.'); readln; end else begin writeln(error); writeln('Нажмите Enter для продолжения.'); readln; end; end; end.
Гость
29.09.2010 20:44
Вот я вроде бы счётчик времени убрал...но теперь остальное надо убрать...и ещё надо каждому слову присвоить свой порядковый номер который был в исходном файле.
uses crt,dos; type string10=string[10]; link_type=^list_type; list_type=record value:string10; count:integer; link:link_type; end; longint_link=^longint; procedure files_names_query(var read_file,write_file,error:string); var f:text; begin error:=''; write('Считываемый файл: '); readln(read_file); assign(f,read_file); {$I-} reset(f); if (ioresult=0) then begin close(f); write('Файл для записи: '); readln(write_file); end else begin error:='Ошибка: файл не существует.'; end; {$I+} end; procedure put_into_list(s:string; var root:pointer); var element,prev_element,new_element:link_type; searched:boolean; begin if (root=nil) then begin new(element); root:=element; element^.value:=s; element^.count:=1; element^.link:=nil; end else begin searched:=FALSE; element:=root; prev_element:=nil; while ((element<>nil)and(not searched)) do begin if (element^.value=s) then begin element^.count:=element^.count+1; searched:=TRUE; end; if (prev_element<>nil) then begin if ((prev_element^.value<s)and(element^.value>s)) then begin new(new_element); new_element^.value:=s; new_element^.count:=1; new_element^.link:=prev_element^.link; prev_element^.link:=new_element; searched:=TRUE; end; end else begin if (element^.value>s) then begin new(new_element); new_element^.value:=s; new_element^.count:=1; new_element^.link:=element; root:=new_element; searched:=TRUE; end; end; prev_element:=element; element:=element^.link; end; if (not searched) then begin new(new_element); new_element^.value:=s; new_element^.count:=1; new_element^.link:=prev_element^.link; prev_element^.link:=new_element; end; end; end; procedure reading(read_file:string; var root:pointer); var simbol:char; f:text; s:string; begin s:=''; assign(f,read_file); reset(f); while (not eof(f)) do begin while (not eoln(f)) do begin read(f,simbol); if (simbol<>' ') then begin s:=s+simbol; end else begin if (s<>'') then put_into_list(s,root); s:=''; end; end; if (s<>'') then put_into_list(s,root); readln(f,s); end; close(f); end; procedure writing(root:pointer; write_file:string); var f:text; element:link_type; s,count:string; begin assign(f,write_file); rewrite(f); element:=root; while (element<>nil) do begin s:=element^.value; str(element^.count,count); s:=s+'-'+count; writeln(f,s); element:=element^.link; end; close(f); end; var read_file,write_file,error:string; root:pointer; begin root:=nil; if (paramstr(1)<>''){если есть параметры командной строки} then{то} begin read_file:=paramstr(1);{считываемый файл - первый параметр} write_file:=paramstr(2);{выходной файл - второй параметр} reading(read_file,root);{считывание из файла и сортировка слов} writing(root,write_file);{запись в файл} end else{если нет, то} begin files_names_query(read_file,write_file,error);{запрос имени файлов через пользовательский инерфейс} if (error='') then begin reading(read_file,root);{считывание из файла и сортировка слов} writing(root,write_file);{запись в файл} writeln('Готово!'); writeln('Нажмите Enter для продолжения.'); readln; end else begin writeln(error); writeln('Нажмите Enter для продолжения.'); readln; end; end; end.
Lapp
30.09.2010 3:14
Цитата(Гость @ 29.09.2010 21:44)
Вот я вроде бы счётчик времени убрал...но теперь остальное надо убрать...и ещё надо каждому слову присвоить свой порядковый номер который был в исходном файле.
Господин хороший Гость, тебе уже как минимум дважды прозрачно намекнули, что помогать карячить и коверкать чужие проги тебе тут никто не будет. Хочешь научиться - пиши с нуля, мы поможем. Но если ты хочешь, чтоб ЧУЖУЮ прогу тебе КТО-ТО переделал, то - на фига это нам? чтоб ты спихнул задание и еще одним лоботрясом в полку программеров прибыло?? Ей Богу, я скорее готов тебе в этом навредить.. Так что, гуляй Вася, жуй опилки..
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.