На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...

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


Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
Страницы: (2) [1] 2  все  ( Перейти к последнему сообщению )  
> Исправить немного код / Delphi XE
    Суть кода в том что:
    Он ищет повторяющиеся слова и сохраняет их в файл и напротив каждого слова пишет сколько слово встречается раз в тексте.

    К примеру в тексте:
    Humpty Dumpty sat on the wall;
    Humpty Dumpty had a great fall.
    All the King's horses and the King's men
    Couldn't put Humpty Dumpty in his place again.

    После обработки выводит результат:
    Humpty 3 // то есть слово Humpty встречается три раза
    Dumpty 3 // то есть слово Dumpty встречается три раза
    the 3 // то есть слово the встречается три раза
    King's 2 // то есть слово King's встречается два раза
    sat 1 // то есть слово sat встречается один раз

    И вот вопрос, Если текст такого плана(то есть два слова и между ними двоеточие):
    Humpty:Dumpty
    Humpty:Dumpty
    All:the
    Couldn't:put

    Как сделать так что бы искались повторяющиеся слова после первого двоеточия : то есть до первого двоеточия текст не учитывался.

    То есть на выходе:
    Dumpty 2 //то есть слово Dumpty встречается два раза

    ExpandedWrap disabled
      program Project2;
       
      {$APPTYPE CONSOLE}
       
      uses
        Windows, SysUtils, Classes;
      Var
        i,ii,il : Integer;
        F : Text;  //Файловая переменная для входного файла
        TxtWord : String;
        CurPos : Integer;
        Ss,Ss1 : String;      //Переменная для хранения считанной строки
       
        StrList1,StrList2 : TStringList;
       
      //Функция нахождения очередного слова в строке
      Function FollWord(Var aStr:String;Var BegPos:Integer):String;
      Var
        i : Integer;
      Begin
        Result:='';
        If BegPos>Length(aStr) Then Exit; //Уже обработана
       
        //Пропускаем все не буквы
        //На случай если не буквы в начале строки
        For i:=BegPos To Length(aStr)+1 Do
        If ((aStr[i] In ['A'..'Z','a'..'z','''']) Or (i=(Length(aStr)+1))) Then
        //Если буква или конец строки
        Begin
          BegPos:=i;
          Break;
        End;
       
        For i:=BegPos To Length(aStr)+1 Do
        If ((Not (aStr[i] In ['A'..'Z','a'..'z',''''])) Or (i=(Length(aStr)+1))) Then
        //Если не буква или конец строки
        Begin
          Result:=Copy(aStr,BegPos,i-BegPos);
          BegPos:=i;
          Break;
        End;
       
        //Пропускаем все не буквы
        If BegPos<(Length(aStr)+1) Then
        For i:=BegPos To Length(aStr)+1 Do
        If ((aStr[i] In ['A'..'Z','a'..'z','''']) Or (i=(Length(aStr)+1))) Then
        //Если буква или конец строки
        Begin
          BegPos:=i;
          Break;
        End;
      End; {FollWord}
       
      begin
        //Если после переключения русские буквы показываются неверно,
        //следует открыть системное меню консольного окна - щелчком мыши в левом
        //верхнем углу окна консоли и выбрать:
        //Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".
        SetConsoleCP(1251);
        SetConsoleOutPutCP(1251); //Инициализируем для выдачи руссого текста на экране
       
        AssignFile(F,'input.txt');   //Подключаем входной файл
        Reset(F); //Открываем входной файл
       
        StrList1:=TStringList.Create;
        StrList1.Sorted:=True;
        StrList1.Duplicates:=dupAccept;
       
        Ss:='';
        CurPos:=1; //Текущая позиция в строке
        {Цикл обработки}
        Repeat
          IF CurPos>Length(Ss) Then
          If (Not Eof(F)) Then
          Begin
            Readln(F,Ss); //Читаем строку из файла
            CurPos:=1;
          End;
          IF CurPos>Length(Ss) Then Continue; //если пустая строка - читать следующую
       
          TxtWord:=FollWord(Ss,CurPos); //Выделяем слово
          If Length(TxtWord)=0 Then Continue;
          StrList1.Add(TxtWord); //Добавляем слово в список
       
        Until (Eof(F) And (CurPos>Length(Ss))); {Конец цикла по концу файла}
                                                {и если строка полностью обработана}
        //Закрываем файл
        CloseFile(F);
       
        //Подсчёт количества каждого из слов
        //И сортировка по количеству вхождений
        StrList2:=TStringList.Create;
        StrList2.Sorted:=True;
        StrList2.Duplicates:=dupAccept;
        il:=0; Ss:='';
        For ii:=0 To StrList1.Count-1 Do
        If Length(Ss)<>0 Then
        Begin
          If Ss<>AnsiLowerCase(StrList1.Strings[ii]) Then
          Begin
            Ss1:=IntToStr(il);
            If Length(Ss1)<6 Then
            //Выравнивание количества на 6 знаков (для сортировки по кол-ву знаков)
            Ss1:=StringOfChar('0',6-Length(Ss1))+Ss1;
       
            StrList2.Add(Ss1+'='+Ss);
            Ss:=AnsiLowerCase(StrList1.Strings[ii]);
            il:=0;
          End;
          Inc(il);
        End Else
        Begin
          Ss:=AnsiLowerCase(StrList1.Strings[ii]);
          il:=1;
        End;
        StrList1.Free;
       
        //Выдача результатов в файл
        AssignFile(F,'output.txt'); //Подключаем выходной файл
        Rewrite(F);                 //Создаём выходной файл
        i:=StrList2.Count-1-5+1;
        For ii:=StrList2.Count-1 DownTo i Do
        Begin
          Ss:=StrList2.Strings[ii];
          i:=Pos('=',Ss);
          Ss1:=Copy(Ss,1,i-1); //Количество
          While Ss1[1]='0' Do Delete(Ss1,1,1); //Убираем ведущие ноли
          Ss:=Copy(Ss,i+1,Length(Ss)-i);
       
          WriteLn(F,Ss+' '+Ss1);
          WriteLn(Ss+' '+Ss1); //На экран
        End;
        StrList2.Free;
        //Закрываем файл
        CloseFile(F);
       
        WriteLn;
        WriteLn('Результаты подсчёта количества строк находятся в файле: OutPut.txt');
        WriteLn;
        WriteLn('Нажмите Enter для завершения программы.');
        Readln; //Ждём нажатия пользователем Enter
      end.
    Сообщение отредактировано: Kirilis2018 -
      т.е. возможен вариант такой?
      Humpty:Humpty Dumpty sat on the wall;
      Humpty:Humpty Dumpty had a great fall.
      Humpty:All the King's horses and the King's men
      Humpty:Couldn't put Humpty Dumpty in his place again.

      На входе текстовый файл строк?
        Цитата ^D^ima @
        т.е. возможен вариант такой?

        Да, такой как Вы выше указали.

        Или такой:
        Humpty:Dumpty
        Humpty:Dumpty
        All:the
        Couldn't:put

        И после обработки:
        Dumpty 2 //то есть слово Dumpty встречается два раза
        Сообщение отредактировано: Kirilis2018 -
          Цитата Kirilis2018 @
          Humpty:Dumpty

          там точно пробела нет?
          Humpty: Dumpty
            Цитата ^D^ima @
            там точно пробела нет?

            В этом варианте
            Humpty:Dumpty

            Точно пробелов нет, все слитно написано.
              Kirilis2018
              Твоя задача решается довольно легко без таких простынок кода(+\- каие-то блоки можно решить по другому. Например отказавшись от джинериков и используя 2-х мерный массив и перебором всех записей в нем).
              ExpandedWrap disabled
                Var
                 I:Integer;
                 SLInS,S:String;
                 SLIn,SLOut:TStringList;
                 Dictionary : TDictionary<String,Integer>;
                begin
                  Dictionary:= TDictionary<String,Integer>.Create;
                 
                  SLOut:=TStringList.Create;
                 
                  SLIn:=TStringList.Create;
                  SLIn.LoadFromFile('c:\123.txt');
                  SLIn.Delimiter:=' ';
                  SLIn.DelimitedText:=SLIn.Text;
                 
                    For I:=0 to slIn.Count-1 do
                      Begin
                        SLInS:=slIn.Strings[I];
                          if Pos(':',SLInS)<>0 Then delete(SLInS,1,Pos(':',SLInS));
                 
                          If Dictionary.ContainsKey(SLInS)=true then
                              Dictionary[SLInS]:=Dictionary[SLInS]+1
                          Else Dictionary.Add(SLInS,1);
                      End;
                 
                 
                  for S in Dictionary.Keys do
                  if Dictionary[S]>1 then SLOut.Add(S+' '+IntToStr(Dictionary[S]));
                 
                  SLOut.SaveToFile('c:\321.txt');
                 
                  Dictionary.Free;
                  SLIn.Free;
                  SLOut.Free;
                 
                end;


              In
              ExpandedWrap disabled
                Humpty:Humpty Dumpty sat on the wall;
                Humpty1:Humpty Dumpty had a great fall.
                Humpty2:All the King's horses and the King's men
                Humpty3:Couldn't put Humpty Dumpty in his place again.


              Out:
              ExpandedWrap disabled
                Dumpty 3
                the 3
                King's 2
                Humpty 3


              In:
              ExpandedWrap disabled
                Humpty:Dumpty
                Humpty:Dumpty
                All:the
                Couldn't:put


              Out:
              ExpandedWrap disabled
                Dumpty 2
                Цитата ^D^ima @
                Твоя задача решается довольно легко без таких простынок кода(+\- каие-то блоки можно решить по другому. Например отказавшись от джинериков и используя 2-х мерный массив и перебором всех записей в нем).

                Благодарю, работает.
                А вот как сделать что бы слова сортировались от большего до меньшего. И ограничить список результатов.
                К примеру ввожу число 15 и программа выводит только 15 результатов от большего до меньшего.

                На выходе:
                test 1255
                Pro 1000
                slovo 550
                  ExpandedWrap disabled
                    Var
                     I,First:Integer;
                     SLInS,S:String;
                     SLIn,SLOut:TStringList;
                     
                     DictionaryArray: TArray<TPair<string, integer>>;
                     DictionaryArrayItem: TPair<string, integer>;
                     
                     Dictionary : TDictionary<String,Integer>;
                    begin
                      First:=4;
                     
                      Dictionary:= TDictionary<String,Integer>.Create;
                     
                      SLOut:=TStringList.Create;
                     
                      SLIn:=TStringList.Create;
                      SLIn.LoadFromFile('c:\123.txt');
                      SLIn.Delimiter:=' ';
                      SLIn.DelimitedText:=SLIn.Text;
                     
                        For I:=0 to slIn.Count-1 do
                          Begin
                            SLInS:=slIn.Strings[I];
                              if Pos(':',SLInS)<>0 Then delete(SLInS,1,Pos(':',SLInS));
                     
                              If Dictionary.ContainsKey(SLInS) then Dictionary[SLInS]:=Dictionary[SLInS]+1
                              Else Dictionary.Add(SLInS,1);
                          End;
                     
                     
                      DictionaryArray := Dictionary.ToArray;
                     
                      TArray.Sort<TPair<string, integer>>(
                        DictionaryArray, TComparer<TPair<string, integer>>.Construct(
                          function (const Left, Right: TPair<string, integer>): Integer
                          begin
                            Result := CompareStr(Left.Value.ToString, Right.Value.ToString);
                            if Result = 0 then
                              Result := CompareStr(Left.Key, Right.Key);
                          end));
                     
                     
                          for I :=Length(DictionaryArray)-1 downto Length(DictionaryArray)-First do
                           SLOut.add(Format('%s: %s',[DictionaryArray[I].Key,DictionaryArray[I].Value.ToString]));
                     
                      SLOut.SaveToFile('c:\321.txt');
                     
                      Dictionary.Free;
                      SLIn.Free;
                      SLOut.Free;
                    end;


                  Добавлено
                  очень тяжело на самом деле.
                  В First задается сколько нужно первых записей. Проблема в том что TDictionary не может сортировать напрямую, его приходится передавать в TArray, который может сортировать только возрастанию. Ну и с учетом того что это джинерики это все тяжело читается и составляется. Весь мозг сломал. Мне как не программисту это очень тяжело :wacko:
                    ^D^ima, Благодарю и последний вопрос. Заключительный, по этой теме.

                    Вот я переделал код что бы читала программа построчно, потому что в таком виде больше 250 мегабайт не грузит. То есть ошибка памяти из за нагрузки.

                    Работает, но выдает только цифру, а слово не показывает. Что делаю не так ? , если возможно то посмотрите.
                    ExpandedWrap disabled
                      var
                        f1:TextFile;
                        SLInS,st:string;
                        I:Integer;
                        Dictionary : TDictionary <String,Integer>;
                        SLIn,s:TStringList;
                      begin
                      if OpenDialog1.Execute then begin
                        AssignFile(F1,OpenDialog1.FileName);
                        Reset(f1);
                       
                         Dictionary:= TDictionary<String,Integer>.Create;
                        S:=TStringList.Create;
                        SLIn:=TStringList.Create;
                        SLIn.Delimiter:=' ';
                        SLIn.DelimitedText:=SLIn.Text;
                       
                      While not EOF(f1) do
                            begin
                              readln(F1,st);
                            For I:=0 to slIn.Count-1 do
                       
                              SLInS:=slIn.Strings[I];
                                if Pos(':',SLInS)<>0 Then delete(SLInS,1,Pos(':',SLInS));
                                If Dictionary.ContainsKey(SLInS)=true then
                                    Dictionary[SLInS]:=Dictionary[SLInS]+1
                                Else Dictionary.Add(SLInS,1);
                            End;
                       
                        for St in Dictionary.Keys do
                        if Dictionary[St]>1 then S.Add(St+' '+IntToStr(Dictionary[St]));
                          end;
                      s.SaveToFile('Rezult.txt');
                        s.Free;
                        CloseFile(f1);
                      end;
                    Сообщение отредактировано: Kirilis2018 -
                      ExpandedWrap disabled
                        Var
                         I,First:Integer;
                         SLInS,S:String;
                         SLIn,SLOut:TStringList;
                         
                         FIn:TextFile;
                         DictionaryArray: TArray<TPair<string, integer>>;
                         DictionaryArrayItem: TPair<string, integer>;
                         
                         Dictionary : TDictionary<String,Integer>;
                        begin
                          First:=4;
                         
                          Dictionary:= TDictionary<String,Integer>.Create;
                         
                          SLOut:=TStringList.Create;
                         
                          SLIn:=TStringList.Create;
                         
                          AssignFile(FIn,'c:\123.txt');
                          reset(FIn);
                            while not EOF(FIn) do
                              begin
                                readln(FIn,S);
                                SLIn.Add(S);
                              end;
                         
                          CloseFile(FIn);
                         
                        //  SLIn.LoadFromFile('c:\123.txt');
                          SLIn.Delimiter:=' ';
                          SLIn.DelimitedText:=SLIn.Text;
                         
                            For I:=0 to slIn.Count-1 do
                              Begin
                                SLInS:=slIn.Strings[I];
                                  if Pos(':',SLInS)<>0 Then delete(SLInS,1,Pos(':',SLInS));
                         
                                  If Dictionary.ContainsKey(SLInS) then Dictionary[SLInS]:=Dictionary[SLInS]+1
                                  Else Dictionary.Add(SLInS,1);
                              End;
                         
                         
                          DictionaryArray := Dictionary.ToArray;
                         
                          TArray.Sort<TPair<string, integer>>(
                            DictionaryArray, TComparer<TPair<string, integer>>.Construct(
                              function (const Left, Right: TPair<string, integer>): Integer
                              begin
                                Result := CompareStr(Left.Value.ToString, Right.Value.ToString);
                                if Result = 0 then
                                  Result := CompareStr(Left.Key, Right.Key);
                              end));
                         
                         
                              for I :=Length(DictionaryArray)-1 downto Length(DictionaryArray)-First do
                               SLOut.add(Format('%s: %s',[DictionaryArray[I].Key,DictionaryArray[I].Value.ToString]));
                         
                          SLOut.SaveToFile('c:\321.txt');
                         
                          Dictionary.Free;
                          SLIn.Free;
                          SLOut.Free;
                        end;


                      Добавлено
                      Цитата Kirilis2018 @
                      Что делаю не так ?

                      почти все. Вместо
                      ExpandedWrap disabled
                        SLIn.LoadFromFile('c:\123.txt');

                      поставь
                      ExpandedWrap disabled
                          AssignFile(FIn,'c:\123.txt');
                          reset(FIn);
                            while not EOF(FIn) do
                              begin
                                readln(FIn,S);
                                SLIn.Add(S);
                              end;
                        ^D^ima,
                        Сделал так но при обработке выдает: access violation at address in module

                        Поставил Break и посмотрел что это выдает эта строка:
                        Overwrite := AddBuf(CurrentArg.VUnicodeString, Precision,
                          Цитата Kirilis2018 @
                          Сделал так но при обработке выдает: access violation at address in module

                          на каком месте? Покажи код. У меня все работает.
                            ^D^ima,

                            В коде что ниже в строке reset(FIn);
                            ExpandedWrap disabled
                              Var
                               I,First:Integer;
                               SLInS,S:String;
                               SLIn,SLOut:TStringList;
                               
                               FIn:TextFile;
                               DictionaryArray: TArray<TPair<string, integer>>;
                               DictionaryArrayItem: TPair<string, integer>;
                               
                               Dictionary : TDictionary<String,Integer>;
                              begin
                                First:=4;
                               
                                Dictionary:= TDictionary<String,Integer>.Create;
                               
                                SLOut:=TStringList.Create;
                               
                                SLIn:=TStringList.Create;
                               
                                AssignFile(FIn,'in.txt');
                                reset(FIn); //////////////////////////// Вот тут ///////////////////////////////
                                  while not EOF(FIn) do
                                    begin
                                      readln(FIn,S);
                                      SLIn.Add(S);
                                    end;
                               
                                CloseFile(FIn);
                               
                              //  SLIn.LoadFromFile('c:\123.txt');
                                SLIn.Delimiter:=' ';
                                SLIn.DelimitedText:=SLIn.Text;
                               
                                  For I:=0 to slIn.Count-1 do
                                    Begin
                                      SLInS:=slIn.Strings[I];
                                        if Pos(':',SLInS)<>0 Then delete(SLInS,1,Pos(':',SLInS));
                               
                                        If Dictionary.ContainsKey(SLInS) then Dictionary[SLInS]:=Dictionary[SLInS]+1
                                        Else Dictionary.Add(SLInS,1);
                                    End;
                               
                               
                                DictionaryArray := Dictionary.ToArray;
                               
                                TArray.Sort<TPair<string, integer>>(
                                  DictionaryArray, TComparer<TPair<string, integer>>.Construct(
                                    function (const Left, Right: TPair<string, integer>): Integer
                                    begin
                                      Result := CompareStr(Left.Value.ToString, Right.Value.ToString);
                                      if Result = 0 then
                                        Result := CompareStr(Left.Key, Right.Key);
                                    end));
                               
                               
                                    for I :=Length(DictionaryArray)-1 downto Length(DictionaryArray)-First do
                                     SLOut.add(Format('%s: %s',[DictionaryArray[I].Key,DictionaryArray[I].Value.ToString]));
                               
                                SLOut.SaveToFile('REZ.txt');
                               
                                Dictionary.Free;
                                SLIn.Free;
                                SLOut.Free;
                              end;
                              Попробуй абсолютный путь указать c:\ и тск далее
                                Цитата ^D^ima @
                                Попробуй абсолютный путь указать c:\ и тск далее

                                Пробовал, то же самое, access violation at address in module. На первом варианте работает, а на том, что в посте 10 нет.
                                Если не сложно прикрепите файл проекта. Потому как подозреваю что это глюк делфи или уже даже не знаю.
                                Сообщение отредактировано: Kirilis2018 -
                                0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                                0 пользователей:


                                Рейтинг@Mail.ru
                                [ Script execution time: 0,0521 ]   [ 17 queries used ]   [ Generated: 28.03.24, 20:25 GMT ]