Mail

Уголок начинающего программиста

В данном разделе приводятся программы, написанные посетителями данного сайта. Идея данного раздела принадлежит Валерию из города Новотроицк Оренбургской области, который прислал мне письмо, в котором предложил публиковать его программы, мотивировав это тем, что на сайте не хватает простых, элементарных программ. А поскольку он все-равно будет "мучаться", то чтоб труд не пропадал зря, он предложил размещать его примеры на сайте. Мне эта идея понравилась и вот первая партия программ размещена в данном новом разделе. Я постараюсь снабжать программы комментариями, если что-то можно сделать в программах лучше. Я не обещаю проверять данные программы на работоспособность, компилируя их, но просматривать на предмет ошибок обязательно буду.

Модератор.

Задач в выбранных темах: 66

Страница 16

Условие задачи

Из данного предложения вычеркнуть слова, встречающиеся больше одного раза.

Решение
Автор: strike

uses crt;
var s,s1,a:string;
    i:integer;
    k:byte absolute s;
begin
s:='';s1:='';
clrscr;
write('Input phrase: ');readln(s);
while s[1]=' ' do delete(s,1,1);
while s[k]=' ' do dec(k);
while pos('  ',s)<>0 do delete (s,pos('  ',s),1);
a:='';s:=s+' ';
repeat
  s1:=copy(s,1,pos(' ',s)-1);
  delete(s,1,length(s1)+1);
  if pos(s1,s)=0 then a:=a+' '+s1;
until length(s)=0;
write('Modified string: ',a);
readln
end.

Комментарии

Модератор:
Честно говоря, мне не совсем четко понятно условие. Я склоняюсь к мысли, что из предложения надо удалять ВСЕ те слова, которые встречаются более одного раза. Все. То есть если слово "кот" встречается более одного раза, то в итоговом предложении слова "кот" быть не должно. Тогда надо внутри цикла добавить код для поиска и удаления найденного слова. Что-то вроде:

k:=Pos(' '+s1+' ',s);
while (k>0) and (lenght(s)>0) do
  begin
  Delete(s,k,k+length(s1)+1);
  k:=Pos(' '+s1+' ',s);
  end;

Если же одну копию слова надо оставить, то задача решена верно.

to top

Условие задачи

Написать прогу, проверяющую, является ли частью данного слова слово "сок". Ответ дать в формате "да/нет".

Решение
Автор: strike

uses crt;
var s,s1,r:string;
    t,y:integer;
begin
repeat
clrscr;
write('Input word1: ');readln(s);
write('Input word2: ');readln(s1);
until length(s1)<=length(s);
y:=0;
t:=length(s1);
while (y=0) and (length(s)>0) do begin
             r:=copy(s,1,t);
             if r=s1 then y:=1
             else y:=0;
             delete(s,1,1);
             end;
if y=0 then write ('no')
else write('yes');
readln
end.

Комментарии

1. Здесь сделана проверка на правильность вводимых данных. Но вы не пишите ничего в случае неправильно введенных данных! Надо не только писать что данные введены неверно, но и ПОЧЕМУ неверно. Например, "введите слово и затем еще одно, превосходящее первое по длине".

На самом деле это проблема серъезнее, чем кажется на первый взгляд. Уже не раз натыкался на формы в интернете "проверяющие" данные. Вводишь свой емейл, например, а она говорит "неправильный формат емейла" и поди догадайся, что они имеют в виду. Потом выясняется, что, например, емейл должен был иметь определенное доменное расширение и никакое иное.
2. else y:=0; лишнее - он и так нуль.
3. А чего, собственно, не написать:

if (Pos(s1,s)>0)
then write ('yes')
else write('no');

??

to top

Условие задачи

Дано слово. Определить, сколько различных букв в нем.

Решение
Автор: strike

Uses crt;
Var s,c: string;
p,i,f,j: integer;
  begin
  write('Введите строку: '); readln(s);
  c:=''; p:=1;
  c[1]:=s[1];
  for i:=1 to length(s) do
    begin
    f:=0;
    for j:=1 to p do
      if a[i]=c[j] then f:=1;
    if f=0 then
      begin
      p:=p+1;
      c[p]:=a[i];
      end;
    end;
  write('в слове',p,' различных букв');
  readln;
  end.

Комментарии

strike: Сразу предупрежу, что задачу не компилировал, а написал решения "с листа".
Moderator: Очень хорошо, учитывая, что решение дано "с листа", на вопрос в форуме.

Правда, в середине переменная "s" превратилась в переменную "a", а в остальном все правильно.

Могу предложить альтернативный, с моей точки зрения более рациональный, вариант:

Uses crt;
Var s,c: string;
p,i,f,j: integer;
  begin
  write('Введите строку: '); readln(s);
  c:=''; p:=0;
  while (length(s)>0) do
    begin
    inc(p);
    c[p]:=s[1];
    while Pos(c[p],s)>0 do
      Delete(s,pos(c[p],s);
    end;
  write('в слове',p,' различных букв');
  readln;
  end.

to top

Условие задачи

В строке заменить все двоеточия точкой запятой и подсчитать количество замен.

Решение
Автор: Moderator

var st:string;
  k,i:byte;
  what2look,replacement:char;
begin
st:='This is: just an example string: wich has few colons.';
what2look:=':';
replacement:=';';
i:=pos(what2look,st);
k:=0;
while (i>0) do
  begin
  inc(k);
  st[i]:=replacement;
  i:=pos(what2look,st);
  end;
writeln('found ',k,' colons');
writeln('st=',st);
end.

Комментарии

to top

Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

Задач в выбранных темах: 66