Помогите плиз до понедельника 29 декабря надо написать

Форум для изучающих FPC и их учителей.

Модератор: Модераторы

Помогите плиз до понедельника 29 декабря надо написать

Сообщение rraassttaa » 23.12.2009 17:15:39

Помогите плиз до понедельника 29 декабря надо написать прогу.

Вообщем смысл этой программы в том чтобы состоит из 2 текствоых edit 'ов и одной кнопки

В одном текстовом поле написано:

weter weter ti mogu4

При нажатии на кнопку программа должна подсчитать сколько в этой строчке букв:

w-2,e-4,t-3,r-2,i-1,m-1,o-1,g-1,u-1


Вот помогите плиз!!до 29 декабря 2009 года!!

Добавлено спустя 1 минуту 12 секунд:
программа должна быть написана через цикл For to do

P.S. Сам пока пробую писать но мало что получаеться(
rraassttaa
незнакомец
 
Сообщения: 5
Зарегистрирован: 23.12.2009 17:09:57

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение AbakAngelSoft » 23.12.2009 17:37:54

студиосы постепенно перепрыгивают с delphikingdom сюда!
Аватара пользователя
AbakAngelSoft
постоялец
 
Сообщения: 273
Зарегистрирован: 06.08.2008 19:28:26
Откуда: Краснодар

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение Padre_Mortius » 23.12.2009 17:51:50

Может все-таки стоит написать о проблемах, которые возникли при решении данной задачи?
Padre_Mortius
энтузиаст
 
Сообщения: 1265
Зарегистрирован: 29.05.2007 17:38:07
Откуда: Спб

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение VirtUX » 23.12.2009 18:06:03

Покажи свой вариант, а мы поможем разобраться в возникших ошибках, если таковые найдутся. Задача ж совершенно не сложная.
Аватара пользователя
VirtUX
энтузиаст
 
Сообщения: 880
Зарегистрирован: 05.02.2008 10:52:19
Откуда: Крым, Алушта

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение rraassttaa » 23.12.2009 19:32:05

хорошо сейчас выложу

Добавлено спустя 1 минуту 6 секунд:
Re: Помогите плиз до понедельника 29 декабря надо написать
VirtUX да согласен задача не сложная но я только учусь програмированию

Добавлено спустя 4 минуты 9 секунд:
Re: Помогите плиз до понедельника 29 декабря надо написать
Код: Выделить всё
var
  Form1: TForm1;
  a,a1,k,p,k1,w:integer;
  b,b1:string;
implementation

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
b1:=Edit1.Text;
k:=0;

For p:=1 to length (b1) do
begin
a:=length(b1);
k1:=w;
Edit2.Text:=copy(b1,k,1);





end

end;                 



вот,но это не закончиненный код я только начал писать)
P.S. не судите строго я всего лишь начал програмирование изучать 2 недели назад)
rraassttaa
незнакомец
 
Сообщения: 5
Зарегистрирован: 23.12.2009 17:09:57

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение Padre_Mortius » 23.12.2009 19:54:24

странное начало...
Код: Выделить всё
var
  Form1: TForm1;
  Edit1: TEdit;
  Edit2: TEdit;
  Button1: TButton;
implementation

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  a,a1,k,p,k1,w:integer;
  b,b1:string;
begin


Наверное должно быть так.

Дальше мы должны найти все уникальные символы в нашей фразе и после этого уже считать кол-во вхождений конкретного символа в фразу

Добавлено спустя 5 минут 21 секунду:
Re: Помогите плиз до понедельника 29 декабря надо написать
Так как наша фраза является строкой (тип string), то мы можем обращаться к ней как к массиву элементов, т.е. обращение к n-ному элементу будет выглядеть как b[n]
Padre_Mortius
энтузиаст
 
Сообщения: 1265
Зарегистрирован: 29.05.2007 17:38:07
Откуда: Спб

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение rraassttaa » 23.12.2009 20:00:46

Padre_Mortiu
то есть найти на какой позиции стоит та или иная буква?
rraassttaa
незнакомец
 
Сообщения: 5
Зарегистрирован: 23.12.2009 17:09:57

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение Padre_Mortius » 23.12.2009 20:02:25

нет. нам нужно сначала составить список не повторяющихся символов. Нам ведь не нужно выводить в результат несколько раз один и тот же символ
Padre_Mortius
энтузиаст
 
Сообщения: 1265
Зарегистрирован: 29.05.2007 17:38:07
Откуда: Спб

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение Putnick » 23.12.2009 20:14:22

Уважаемый rraassttaa,
полностью присоединяясь к словам Padre_Mortius
Может все-таки стоит написать о проблемах, которые возникли при решении данной задачи?
(ведь, согласитесь, что форумчане в большинстве своём — не телепаты), осмелюсь предположить, что у Вас возникла проблема при обработке строк, содержащих символы кириллицы.
Дело в том, что кодировка UTF-8, используемая FreePascal, имеет переменную длину кодирования символов (от 1 до 6 байт) и поэтому, обращение к символам строки по их индексу — в общем случае, невозможно.
К счастью для нас (русскоязычных), мы используем символы, кодируемые 1 или 2 байтами. Причем, если символ кодируется 2 байтами, то первый байт имеет значение большее 127. Хотя, кажется (вот ведь... сам когда-то перекодировщик для UTF-8 писал, а сейчас в голове ветер гуляет :( ), в любом случае если байт больше 127, он — часть UTF-8 символа.
Приведённая ниже программа подсчитывает число 1 и 2-байтовых символов в строке:
Код: Выделить всё
program test;
var
  s:string='!Мама, я пойду на party!'; // значение добавлено для проверки: должно быть 12 однобайтовых и 12 двухбайтовых
  i:integer;
  b1c:integer=0; // счётчик 1-байтовых символов
  b2c:integer=0; // счётчик 2-байтовых символов
  Is2b:boolean=false; // флаг "2-байтовости"
begin
  for i:=1 to Length(s) do begin
    if Is2b then begin // 2-байтовый символ начался
      Is2b:=not(Is2b);
      Continue
    end;
    if s[i]>#127 then begin // 2-байтовый символ начался
      Is2b:=not(Is2b);
      inc(b2c); // увеличим счетчик 2-байтовых символов
      Continue
    end;
    inc(b1c) // увеличим счетчик 1-байтовых символов
  end;
end;

Ну, а уж реализовать по аналогии Вашу программу, думаю не составит Вам никакого труда.
С уважением, Алексей.

P.S.
Хотя, конечно, проще преобразовать системными средствами строку к однобайтовой кодировке (UTF8toAnsi), но мы ведь не ищем лёгких путей? :wink:

P.P.S.
Надеюсь, что говорить о том, что для символов можно осуществлять операции сравнения ('z'>'a'), а функция Chr преобразует байт в символ — излишне?
Последний раз редактировалось Putnick 23.12.2009 20:22:41, всего редактировалось 1 раз.
Putnick
новенький
 
Сообщения: 62
Зарегистрирован: 18.03.2009 13:02:56

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение rraassttaa » 23.12.2009 20:22:18

Большое спасибо за помощь :) далле пробую сам написать что-либо, а что из этого получится выложу сюда для просмотра вами :)
rraassttaa
незнакомец
 
Сообщения: 5
Зарегистрирован: 23.12.2009 17:09:57

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение rraassttaa » 27.12.2009 12:32:45

вот что я наделал посмотрите скажите как сделать так чтобы он не выводил повторяющиеся символы по нескольку раз а 1 раз пример

w-2,t-2....и т.д.


Код: Выделить всё
TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

N,K,w:integer;
strA,strB,strM:string;
implementation

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
N := 0;
K := 0;
strA := Edit1.Text;
for n:=1 to Length(Edit1.Text) do
begin
strM:=Copy(Edit1.Text,N,1);
//w
If strM = 'w' Then
begin
k:=0;
K:=K+1;
edit2.text:= edit2.text+'w-'+ IntToStr(K)+',';
end;
//e
If strM = 'e' Then
begin
k:=0;
K:=K+1;
edit2.text:= edit2.text+('e-'+ IntToStr(K))+',';
end;
//t
If strM = 't' Then
begin
K:=0;
K:=K+1;
Edit2.Text:=edit2.text+('t-' +IntToStr(K))+',';
end;
//r
If strM = 'r' Then
begin
K:=0;
K:=K+1;
Edit2.Text:=edit2.text+('r-' +IntToStr(K))+',';
end;
//i
If strM = 'i'  then
begin
K:=0;
K:=K+1;
Edit2.Text:=edit2.text+('i-' +IntToStr(K))+',';
end;
//m
If strM = 'm'  then
begin
K:=0;
K:=K+1;
Edit2.Text:=edit2.text+('m-' +IntToStr(K))+',';
end;
//o
If strM = 'o'  then
begin
K:=0;
K:=K+1;
Edit2.Text:=edit2.text+('o-' +IntToStr(K))+',';
end;
//g
If strM = 'g'  then
begin
K:=0;
K:=K+1;
Edit2.Text:=edit2.text+('g-' +IntToStr(K))+',';
end;
//u
If strM = 'u'  then
begin
K:=0;
K:=K+1;
Edit2.Text:=edit2.text+('u-' +IntToStr(K))+',';
end;
//4
If strM = '4'  then
begin
K:=0;
K:=K+1;
Edit2.Text:=edit2.text+('4-' +IntToStr(K))+'.';
end;
end;
end;     
rraassttaa
незнакомец
 
Сообщения: 5
Зарегистрирован: 23.12.2009 17:09:57

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение Putnick » 27.12.2009 13:45:45

Уважаемый, rraassttaa, прошу прощения за резкость, НО
Начнём с того, что в русском языке существуют знаки препинания, скажу больше — некоторые ретрограды их даже используют на письме, наивно считая, что предложения вида
вот что я наделал посмотрите скажите как сделать так чтобы он не выводил повторяющиеся символы по нескольку раз а 1 раз пример
читать как минимум неприятно, а как максимум — невозможно, ибо не ясно, где кончается одна мысль и начинается другая (пресловутое "казнить нельзя помиловать").

Теперь о программе:
Простите, но Вы в цикле используете одну и ту же переменную в качестве счётчика ВСЕХ символов. Более того, Вы её постоянно обнуляете внутри цикла при встрече каждого допустимого символа. Подобный (конечно, весьмаааа отдалённо, но всё-таки...) подход имеет право на существование (если Вы не_хотите/не_можете (по условию задания) использовать массив), но в этом случае алгоритм должен был бы выглядеть примерно следующим образом:
1. Создаётся набор допустимых символов: "abc...xyzABC...XYZ0...9"
2. Для КАЖДОГО символа из набора осуществляется подсчёт его вхождений в обрабатываемую строку. Если количество вхождений больше нуля, в выходную строку добавляем соответствующее сообщение.
Приблизительный код:
Код: Выделить всё
var
  i, j, k:integer;
  Nabor:string; // Символы, количество которых необходимо подсчитать
  InStr:string; // входная строка
  OutStr:string; // выходная строка
begin
OutStr:='';
for i:=1 to Length(Nabor) do begin
  k:=0;
  for j:=1 to Length(InStr) do
    if InStr[j]=Nabor[i] then inc(k);
  if k>0 then OutStr:=OutStr+Nabor[i]+' - '+IntToStr(k)+'; '
end;
end.

Набор уникальных символов формируется программистом (если Вы желаете исключить из учёта какие-то символы (пробел, знаки пунктуации и арифметических операций, прочие специальные символы) или программно из введенной строки приблизительно так:
Код: Выделить всё
var
  i, j, k:integer;
  nabor:string; // набор уникальных символов
  InStr:string; // входная строка
begin
Nabor:='';
for i:=1 to Length(InStr) do begin
  k:=-1;
  for j:=1 to Length(Nabor) do
    if InStr[i]=Nabor[j] then begin
      k:=j;
      Break
    end;
  if k=-1 then Nabor:=Nabor+InStr[i]
end;
end.

Очевидно, что если использовать динамический массив для хранения счётчиков вхождения символов в строку, то скорость выполнения программы можно повысить:
Код: Выделить всё
var
  i, j, k:integer;
  Counters:array of integer;
  nabor:string; // набор уникальных символов
  InStr:string; // входная строка
  OutStr:string; // выходная строка
begin
Nabor:='';
SetLength(Counters, 1);
for i:=1 to Length(InStr) do begin
  k:=-1;
  for j:=1 to Length(Nabor) do
    if InStr[i]=Nabor[j] then begin
      k:=j;
      Break
    end;
  if k=-1 then begin
    Nabor:=Nabor+InStr[i];
    k:=Length(Counters);
    SetLength(Counters, k+1);
    Counters[k]:=0
  end;
  inc(Counters[k])
end;
  OutStr:='';
  for i:=1 to Length(Nabor) do
    OutStr:=OutStr+Nabor[i]+' - '+IntTostr(Counters[i])+'; '
end.


P.S.
В случае конкретно FreePascal, лучше использовать UTF8Length(s) вместо Length(s) и UTF8Copy(s,i,1) вместо s[i].
Если Вы не хотите различать строчные и прописные буквы, то сравнивать нужно не собственно символы, а символы, преобразованные к верхнему (AnsiUpperCase(s) / UTF8UpperCase(s)) или нижнему (AnsiLowerCase(s) / UTF8LowerCase(s)) регистру.
Для использования UTF8-функций, Вы должны подключить к своей программе модуль LCLProc.

С уважением, Алексей.
Putnick
новенький
 
Сообщения: 62
Зарегистрирован: 18.03.2009 13:02:56

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение Astralis » 28.12.2009 04:01:40

может быть имеет смысл вообще работать с widestring, а данные уже конвертить при входе и выходе, но это уже не решение конкретной задачи, а систематический подход
Аватара пользователя
Astralis
новенький
 
Сообщения: 45
Зарегистрирован: 06.06.2007 20:33:05
Откуда: Tvercity-Annet

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение Climber » 28.12.2009 23:23:09

Я предыдущих ораторов не читал и не осуждаю, но, имхо, для этой задачи подошел бы класс TStringList, а именно его умение работать с парами "Name=value". Решение не самое быстрое, зато, имхо, простое и изящное:
Код: Выделить всё
procedure TForm1.Button1Click(Sender: TObject);
var i:longint;
begin
  with TStringList.Create do
    try
      for i:=1 to length(Edit1.Text) do
        if Values[Edit1.Text[i]]='' then
           Values[Edit1.Text[i]]:='1'
           else
           Values[Edit1.Text[i]]:=IntToStr(StrToInt(Values[Edit1.Text[i]])+1);
    finally
      free;
    end;
end;
А, ну и проверку на буква/не буква еще вставить между for и if.

Добавлено спустя 1 минуту:
Re: Помогите плиз до понедельника 29 декабря надо написать
P. S. Так я не понял - надо было до 29-го или до понедельника? Понедельник-то - 28-е :wink:
Climber
постоялец
 
Сообщения: 415
Зарегистрирован: 03.06.2007 20:09:57
Откуда: Москва

Re: Помогите плиз до понедельника 29 декабря надо написа

Сообщение Putnick » 29.12.2009 12:36:53

Уважаемый, Climber.
Предлагаемое Вами решение несомненно красиво и изящно. НО.
Возьму на себя смелость утверждать, что, как правило, преподаватель требует решения не "как лучше", а "как положено", т.е. в рамках прочитанных этим преподавателем лекций. Что, на мой взгляд, правильно: для научного поиска и полёта фантазии у вас будут курсовые и диплом, а пока — "учимся ходить", господа-товарищи студенты.
В рамках же упомянутых ранее лекций, наш друг rraassttaa, скорее всего, понятия не имеет о TStringList, о существовании динамических массивов, в лучшем случае, смутно догадывается, а богопротивные UniСode и WideString считает грязными ругательствами и краснеет от ушей до пяток, когда их слышит. :)

С уважением, Алексей.
Putnick
новенький
 
Сообщения: 62
Зарегистрирован: 18.03.2009 13:02:56

След.

Вернуться в Обучение Free Pascal

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 8

Рейтинг@Mail.ru