Developing.ru

Код: Выделить всё

PROGRAM CountWords(INPUT, OUTPUT);
CONST
  Chars = [' ', '.', ',', '!', '?', ':', ';'];
VAR
  Ch: CHAR;
  T: TEXT;
  S: STRING;
  I, Wc, W: INTEGER;
PROCEDURE Count;
  BEGIN
    WHILE NOT (Ch IN Chars) AND NOT EOF(T)
    DO
      BEGIN
        READ(T, Ch);
        IF Ch IN Chars
        THEN
          BEGIN
            INC(I);
            READ(T, Ch);
            Count;
          END;
      END;
    IF Ch = ' '
    THEN
      BEGIN
        READ(T, Ch);
        Count;
      END;
  END;
BEGIN
  ASSIGN(T, 'Text1.txt');
  RESET(T);
  Count;
  WRITELN(I);
END.

Код: Выделить всё

PROGRAM CountWords(INPUT, OUTPUT);
CONST
  Chars = [' ', '.', ',', '!', '?', ':', ';',#10,#13];
VAR
  T: TEXT;
  Count: integer;

function NextWord:string;
var
  Ch: char;
begin
  Read(T,Ch);
  if (Ch in Chars) or eof(T)
    then NextWord:=''
    else NextWord:=Ch+NextWord;
end;

BEGIN
  Count:=0;
  ASSIGN(T, 'c:\somefile.txt');
  RESET(T);
  repeat
    if NextWord<>'' then inc(Count);
  until eof(T);
  close(T);
  writeln('Найдено ',Count,' слов(а)');
  readln;
END.

Код: Выделить всё

PROGRAM CountWords(INPUT, OUTPUT);
CONST
  Chars = [' ', '.', ',', '!', '?', ':', ';',#10,#13];
type
  PCounter=^TCounter;
  TCounter=record
    Word:string;
    Count:integer;
    Next:PCounter;
  end;
VAR
  T: TEXT;
  Counts,Tmp: PCounter;
  W:string;
  CountTotal,CountUnique:integer;

function NextWord:string;
var
  Ch: char;
begin
  Read(T,Ch);
  if (Ch in Chars) or eof(T)
    then NextWord:=''
    else NextWord:=Ch+NextWord;
end;

function AddCounter(var ioHead:PCounter;iWord:string):boolean;
var
  Curr,New:PCounter;
begin
  {$B-}
  Curr:=ioHead;
  AddCounter:=false;
  if Curr<>nil then while (Curr^.Next<>nil) and (Curr^.Word <> iWord) do
    Curr:=Curr^.Next;
  if (Curr=nil) or ((Curr^.Next=nil) and (Curr^.Word<>iWord)) then begin
    getmem(New,SizeOf(TCounter));
    with New^ do begin
      Word:=iWord;
      Count:=1;
      Next:=nil;
      AddCounter:=true;
    end;
    if Curr=nil then ioHead:=New else Curr^.next:=New;
  end else {Curr^.Word=iWord} inc(Curr^.Count);
end;

BEGIN
  Counts:=nil;
  CountTotal:=0;
  CountUnique:=0;
  ASSIGN(T, 'c:\somefile.txt');
  RESET(T);
  repeat
    W:=NextWord;
    if W<>'' then begin
      inc(CountTotal);
      if AddCounter(Counts,W) then inc(CountUnique);
    end;
  until eof(T);
  close(T);

  writeln('Всего слов тексте: ', CountTotal);
  if CountUnique>0 then begin
    writeln('Различных слов обнаружено: ', CountUnique, '. Среди них:');
    Tmp:=Counts;
    while Tmp<>nil do begin
      writeln('Слово "',Tmp^.Word,'" встречается ',Tmp^.Count,'раз(а)');
      Tmp:=Tmp^.Next;
    end;
  end;
  readln;
END.