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


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

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

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

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 - 16.09.2010 22:18

Во-первых, то, что ты сюда вывалил, даже не компилируется, не то что не работает. А во-вторых, неплохо было бы прикрепить файл, который ты обрабатываешь...

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

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

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

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

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

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

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

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

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

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

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

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

И ещё по заданию наверное мне надо не по строкам а по словам сортировать...

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

думаю сюда

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

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

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

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

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

Скажите а как эту программу переделать так чтобы был не метод пузырька а метод вставками???

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

А вообще, проще не переделывать "эту программу", а написать заново.

Святые слова! Хотя, использование кусков кода из старой (если они того стоят) не возбраняется. Может, это наведет тебя на мысль об использовании процедур и юнитов..

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

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.

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

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.

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