Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.128.198.21] |
|
Страницы: (2) [1] 2 все ( Перейти к последнему сообщению ) |
Сообщ.
#1
,
|
|
|
Суть кода в том что:
Он ищет повторяющиеся слова и сохраняет их в файл и напротив каждого слова пишет сколько слово встречается раз в тексте. К примеру в тексте: 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 встречается два раза 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. |
Сообщ.
#2
,
|
|
|
т.е. возможен вариант такой?
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. На входе текстовый файл строк? |
Сообщ.
#3
,
|
|
|
Цитата ^D^ima @ т.е. возможен вариант такой? Да, такой как Вы выше указали. Или такой: Humpty:Dumpty Humpty:Dumpty All:the Couldn't:put И после обработки: Dumpty 2 //то есть слово Dumpty встречается два раза |
Сообщ.
#4
,
|
|
|
Цитата Kirilis2018 @ Humpty:Dumpty там точно пробела нет? Humpty: Dumpty |
Сообщ.
#5
,
|
|
|
Цитата ^D^ima @ там точно пробела нет? В этом варианте Humpty:Dumpty Точно пробелов нет, все слитно написано. |
Сообщ.
#6
,
|
|
|
Kirilis2018
Твоя задача решается довольно легко без таких простынок кода(+\- каие-то блоки можно решить по другому. Например отказавшись от джинериков и используя 2-х мерный массив и перебором всех записей в нем). 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 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: Dumpty 3 the 3 King's 2 Humpty 3 In: Humpty:Dumpty Humpty:Dumpty All:the Couldn't:put Out: Dumpty 2 |
Сообщ.
#7
,
|
|
|
Цитата ^D^ima @ Твоя задача решается довольно легко без таких простынок кода(+\- каие-то блоки можно решить по другому. Например отказавшись от джинериков и используя 2-х мерный массив и перебором всех записей в нем). Благодарю, работает. А вот как сделать что бы слова сортировались от большего до меньшего. И ограничить список результатов. К примеру ввожу число 15 и программа выводит только 15 результатов от большего до меньшего. На выходе: test 1255 Pro 1000 slovo 550 |
Сообщ.
#8
,
|
|
|
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, который может сортировать только возрастанию. Ну и с учетом того что это джинерики это все тяжело читается и составляется. Весь мозг сломал. Мне как не программисту это очень тяжело |
Сообщ.
#9
,
|
|
|
^D^ima, Благодарю и последний вопрос. Заключительный, по этой теме.
Вот я переделал код что бы читала программа построчно, потому что в таком виде больше 250 мегабайт не грузит. То есть ошибка памяти из за нагрузки. Работает, но выдает только цифру, а слово не показывает. Что делаю не так ? , если возможно то посмотрите. 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; |
Сообщ.
#10
,
|
|
|
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 @ Что делаю не так ? почти все. Вместо SLIn.LoadFromFile('c:\123.txt'); поставь AssignFile(FIn,'c:\123.txt'); reset(FIn); while not EOF(FIn) do begin readln(FIn,S); SLIn.Add(S); end; |
Сообщ.
#11
,
|
|
|
^D^ima,
Сделал так но при обработке выдает: access violation at address in module Поставил Break и посмотрел что это выдает эта строка: Overwrite := AddBuf(CurrentArg.VUnicodeString, Precision, |
Сообщ.
#12
,
|
|
|
Цитата Kirilis2018 @ Сделал так но при обработке выдает: access violation at address in module на каком месте? Покажи код. У меня все работает. |
Сообщ.
#13
,
|
|
|
^D^ima,
В коде что ниже в строке reset(FIn); 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; |
Сообщ.
#14
,
|
|
|
Попробуй абсолютный путь указать c:\ и тск далее
|
Сообщ.
#15
,
|
|
|
Цитата ^D^ima @ Попробуй абсолютный путь указать c:\ и тск далее Пробовал, то же самое, access violation at address in module. На первом варианте работает, а на том, что в посте 10 нет. Если не сложно прикрепите файл проекта. Потому как подозреваю что это глюк делфи или уже даже не знаю. |