IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Сортировка вставками, Программно реализовать алгоритм сортировки простыми вставками.
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


Здравствуйте...помогите пожалуйста разобраться с задачей...


Программно реализовать алгоритм сортировки простыми вставками. Каждая запись будет в качестве ключа содержать текстовое выражение, а в качестве информативной части некоторое число.

Тестовый набор записей перед сортировкой необходимо загрузить в память из файла. Файл с тестовым набором необходимо создать. Затем при необходимости изменить у него кодировку (в зависимости от того, в какой ОС Вы осуществляете программную реализацию). После этого для каждой записи берем в качестве ключа слово из исходного файла, а для информативной части его порядковый номер в исходном тексте. Для преобразования текстового файла в набор записей также необходимо выполнить программную реализацию, которая к тому же должна предусматривать создания определенного количества записей.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


Я вот пытался что-то сделать...но не работает...

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.


Сообщение отредактировано: Nelson1992 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Во-первых, то, что ты сюда вывалил, даже не компилируется, не то что не работает. А во-вторых, неплохо было бы прикрепить файл, который ты обрабатываешь...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


Ну вот я и прошу мне помочь...потому,что не знаю как всё реализовать...и вот этот файл.

Текст сохраняется во втором файле но не отсортированный...

Сообщение отредактировано: Nelson1992 -


Прикрепленные файлы
Прикрепленный файл  1.txt ( 13.28 килобайт ) Кол-во скачиваний: 148
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Знаток
****

Группа: Пользователи
Сообщений: 396
Пол: Мужской

Репутация: -  9  +


пытался сделать? no1.gif
http://delphid.dax.ru/www/exampl24.htm
т.е. это ты целую статью написал? good.gif


--------------------
Objective-C, Unity3d
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


я возможно не правильно выразился...я не сам писал...я пытался сделать чтобы работало то что мне надо...но не могу...вот в чём проблема... unsure.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Знаток
****

Группа: Пользователи
Сообщений: 396
Пол: Мужской

Репутация: -  9  +


чел такой пошаговый мануал еще поискать надо, там же каждая строка расписана


--------------------
Objective-C, Unity3d
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


За ссылку спасибо...дело в том что я не там всё это нашёл...на другом сайте было...так,что щас буду читать... good.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Знаток
****

Группа: Пользователи
Сообщений: 396
Пол: Мужской

Репутация: -  9  +


Цитата(Nelson1992 @ 16.09.2010 22:24) *

За ссылку спасибо...дело в том что я не там всё это нашёл...на другом сайте было...так,что щас буду читать... good.gif

и еще по секрету ТОТ... код компилится сразу и даже работает))))


--------------------
Objective-C, Unity3d
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


хм...вроде бы работает,..спасибо)

Сообщение отредактировано: Nelson1992 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Знаток
****

Группа: Пользователи
Сообщений: 396
Пол: Мужской

Репутация: -  9  +


Цитата(Nelson1992 @ 16.09.2010 22:56) *

хм...что-то он не работает...и не выводит результат в текстовый файл...

в файл да не выводит...
но зато на экран да.... alt+F5 жал?


--------------------
Objective-C, Unity3d
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


ааа...всё...разобрался...работает...но оно сортирует после абзаца заново...можно как-то сделать чтобы весь текст полностью за один раз сортировало???

И ещё по заданию наверное мне надо не по строкам а по словам сортировать...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Знаток
****

Группа: Пользователи
Сообщений: 396
Пол: Мужской

Репутация: -  9  +


загружать в массив по одному слову... делить строку

думаю сюда

readln(f,nameString);
...
if (firstElement = nil) then
добавить цикл рохода по словам

ну давай ему не всю строку а часть. как выделить? pos,copy,delete ищешь от пробела до пробела вырезаешь

Сообщение отредактировано: Rian -


--------------------
Objective-C, Unity3d
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Новичок
*

Группа: Пользователи
Сообщений: 15
Пол: Мужской

Репутация: -  0  +


Спасибо...буду пробовать...

Сообщение отредактировано: Nelson1992 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Гость






Скажите а как эту программу переделать так чтобы был не метод пузырька а метод вставками???
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Гость






Подумать, чем отличается метод "пузырька" от метода вставок, и реализовать не первый, а второй. Ты ж не думаешь, что ты - первый, кто интересуется, как отсортировать вставками список? Только список для этого лучше сделать не односвязный (только поле next), а двусвязный (поля prev и next)...

А вообще, проще не переделывать "эту программу", а написать заново.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(volvo @ 28.09.2010 19:16) *
А вообще, проще не переделывать "эту программу", а написать заново.
yes2.gif Святые слова! Хотя, использование кусков кода из старой (если они того стоят) не возбраняется. Может, это наведет тебя на мысль об использовании процедур и юнитов..


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Гость






Вот есть програмка...она сортирует вставками...но в ней есть много лишнего...можете помочь?Мне надо убрать оттуда счётчик времени...мне не надо чтобы оно выводило сколько времени выполнялась программа,и убрать надо чтобы не выводило сколько раз встречалось слово...чтобы оно не считало это...и также оно считает после абзаца заново...а надо чтобы всё вместе...


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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Гость






Вот я вроде бы счётчик времени убрал...но теперь остальное надо убрать...и ещё надо каждому слову присвоить свой порядковый номер который был в исходном файле.

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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #20


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(Гость @ 29.09.2010 21:44) *
Вот я вроде бы счётчик времени убрал...но теперь остальное надо убрать...и ещё надо каждому слову присвоить свой порядковый номер который был в исходном файле.
Господин хороший Гость, тебе уже как минимум дважды прозрачно намекнули, что помогать карячить и коверкать чужие проги тебе тут никто не будет. Хочешь научиться - пиши с нуля, мы поможем. Но если ты хочешь, чтоб ЧУЖУЮ прогу тебе КТО-ТО переделал, то - на фига это нам? чтоб ты спихнул задание и еще одним лоботрясом в полку программеров прибыло?? Ей Богу, я скорее готов тебе в этом навредить.. Так что, гуляй Вася, жуй опилки..


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 29.10.2020 11:59
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name