тип String Опции

[симав]

Подсчитайте, какой процент слов в тексте содержит удвоенную букву.
Вот, что я сделала:

Код

var s:string;
p:real;
n,k,i:byte;
begin
readln(s);
for i:=1 to length(s) do begin
if s[i]=' ' then n:=n+1;
if s[i]:=s[i+1] then k:=K+1;
end;
p:=(n/k)*0.1;
writeln('p=',p:3:3);
readln;
end.

[volvo]

Сразу ошибка:

{ вот тут до len - 1 иначе будет выход за конец строки }
for i:=1 to length(s)-1 do begin 
if s[i]=' ' then n:=n+1
else
  { здесь сравнение, а не присваивание }
  if s[i]=s[i+1] then k:=K+1; 

Скорее всего должно сработать, только "процент" - это 0.01 а не 0.1

[симав]

Спасибо. :thanks:

[hiv]

Проценты совсем неправильно считаются! n - количество слов, k - количество слов где есть парные буквы. Тогда процент счтается как k/n*100
Вот как надо:

Код

program dubleb;
var s:string;
   n,k,i:byte;
   boy :boolean;
begin
readln(s);
n:=0;
k:=0;
i:=1;
while (i<=length(s))and(s[i]=' ') do inc(i);

while i<=length(s) do
begin
 if s[i]=' ' then
 begin
   inc(n);
   inc(i);
   while (i<=length(s))and(s[i]=' ') do inc(i);
 end
 else
 begin
   boy:=false;
   while (i<=length(s))and(s[i]<>' ') do
   begin
     if i>1 then boy:=boy or (s[i]=s[i-1]);
     inc(i);
   end;
   if boy then inc(k);
   if (i>length(s))and(s[length(s)]<>' ') then inc(n);
 end;
end;

if n>0 then writeln('p=',(k/n*100):5:1,'%')
else writeln('В тексте нет слов!');
readln;
end.

[симав]

Вот задачка.
Найти кол-во слов начинающихся и заканчивающихся на обнуи туже букву.

Код

var s:string;
k,i:byte;
begin
readln(s);
for i:=1 to length(s) do begin
if (s[i-1]=' ')and (s[1]=s[i]) then k:=K+1;
end;
writeln('k=',k);
readln;
end.

Что-то не идет.

[volvo]

Что-то не идет.

:yes: Правильно, не идет... Вот должно пойти:

var
  s:string;
  k,i, start:byte;
begin
readln(s);
i := 1; start := 1;
while i <= length(s) do
begin
  if s[i] = ' ' then begin
    if (i - start > 0) and
       (s[start] = s[i - 1]) then k := k + 1;
    start := i + 1;
  end;
  inc(i);
end;
writeln('k=',k);
readln;
end.

[симав]

Спасибо. :p4:

[Atos]

Код

var ch:char; i:byte;

...

begin
k:=0;
...
{тут  сделай обработку случаев, когда длина s равно 0 или 1}
...
{else}

if s[1]<>' ' then ch:=s[1];
i:=2;
repeat
if s[i]<>'  ' then
   begin
   if s[i-1]='  ' then ch:=s[i];
   if s[i+1]='  ' then if ch=s[i] then k:=k+1;
   end;
inc(i);
until (i=length(s));
if s[i]<>' ' then if ch=s[i] then k:=k+1;

...

end.

[Atos]

Опять я торможу с ответом...
Однако, volvo, "как показало вскрытие", твой код некорректно обрабатывает случай, когда последнее слово - однобуквенное ;)

[volvo]

"как показало вскрытие", твой код некорректно обрабатывает случай, когда последнее слово - однобуквенное  ;)

Да, этого я не предусмотрел Но это очень просто исправить...

...
readln(s); s := s + ' ';
i := 1; start := 1;
...

[симав]

В фразе содержатся цифры и знаки арифметическмх операций вывести на экран результат операции.
так?

Код

var
   s,s1,s2:string;
   m,op,c:char;
   i,a,b,o,j,n:integer;
begin m:=['1','2','3','4','5','6','7','8','9','0'];
     op:=['+','-','*','/'];
     readln(s);
             writeln(s);
             for i:=2 to length(s)-1 do
                if (s[i]  in op)and
                  (s[i-1]in m) and
                  (s[i+1]in m)
                   then begin
                              j:=1;
                              s1:='';
                              while (s[i-j] in m) and (i-j>0) do
                                begin s1:=s[i-j]+s1;
                                      j:=j+1
                                end;
                              j:=1;
                              s2:='';
                              while (s[i+j] in m) and (i+j<=length(s)) do
                                begin s2:=s2+s[i+j];
                                      j:=j+1
                                end;
                              val(s1,a,n);val(s2,b,n);
                               O:=a+b;
                               O:=a-b;
                               O:=a*b;
                               O:=a div b;
                                 end;
                              writeln(a,s[i],b,'=',O,' ')
                         end;
        end;
      end.

[volvo]

Этот бред начнет выдавать ошибки, начиная с 4-ой строки...

симав, начинайте пользоваться поиском!!!
Эта тема поднималась неоднократно... Вот ОДНА из возможных реализаций:
FAQ: Калькулятор