Помогите пожалуйста!!срочно

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

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

Ответить
Ronni
незнакомец
Сообщения: 5
Зарегистрирован: 22.02.2010 12:14:14

Помогите пожалуйста!!срочно

Сообщение Ronni »

Срочно нужно сделать лабу по Паскалю, вот задание:
Слова в строке отделены пробелами. Подсчитать количество слов, в которых буква 'а' встречается хотя бы 1 раз
помогите пожалуйста, я попробовал, но получилось не то, что нужно:
program glasnie;
uses crt;
var a,b:string;
i,j,n:integer;
begin
clrscr;
readln(a);
b:='a';
n:=0;
for i:=1 to length(a) do
for j:=1 to length(b) do
if b[j]=a[i] then n:=n+1;
writeln(n);
readkey;
end.
в результате пишет не количество слов, в которых встречается хотя бы одна буква "а", а сколько раз она встречается в словах вообще
Putnick
новенький
Сообщения: 62
Зарегистрирован: 18.03.2009 12:02:56

Сообщение Putnick »

Уважаемый Ronni,
знаете, есть такая старая шутка:
Компьтер — это глупая железка, которая делает то, что вы ей ПРИКАЗАЛИ, а не то, что вы от неё ХОТЕЛИ
.
Я это к чему? А где в Вашей программе вообще считаются слова, которые
в строке отделены пробелами
?
Ну, ещё переменная b могла бы быть типа Char, чтобы не создавать почём зря цикл. Или, если Вы делаете программу "на вырост", то и сравнивать нужно не

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

a[i]=b[j]
, а

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

a[i+j-1]=b[j]
, в противном случае строка b длиною больше 1 символа может дать Вам сразу несколько срабатываний (если использовать Ваш блок условий). Чтобы избежать "лишних" срабатываний, на мой взгляд, было бы разумно использовать некую переменную-флаг, запрещающую изменять счётчик больше 1 раза на слово.

Надеюсь, "разумному достаточно". С уважением, Алексей.
Ronni
незнакомец
Сообщения: 5
Зарегистрирован: 22.02.2010 12:14:14

Сообщение Ronni »

помогите пожалуйста, напишите полный правильный текст программы, я попробовал, как говорили, но никак, она считает не слова, а сколько всего букв "а" встречается в напечатанном тексте...

Добавлено спустя 29 минут:
хоть кто-нибудь, помогите наконец...
zub
долгожитель
Сообщения: 2889
Зарегистрирован: 14.11.2005 22:51:26
Контактная информация:

Сообщение zub »

Ronni

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

var                                                 
   s:string;
   i,acount:integer;
   newword:boolean;
begin
   s:='aaa sa a';
   acount:=0;
   newword:=true;
   for i:=1 to length(s) do
     begin
          if s[i]=' ' then
                          begin
                               newword:=true;
                          end
                      else
                      if s[i]='a' then
                                      begin
                                           if newword then
                                           begin
                                                newword:=false;
                                                inc(acount);
                                           end;
                                      end

     end;
end.

чтото типа этого. с тебя пузырь
Ronni
незнакомец
Сообщения: 5
Зарегистрирован: 22.02.2010 12:14:14

Сообщение Ronni »

у меня вот че получилось:

program glasnie;
uses crt;
var a,b:string;
i,j,k,p,x,y:integer;
begin
clrscr;
readln(a);
x:=length(a);
for i:=1 to x do
begin
if a[i]='a' then p:=p+1;
if ((a[i]=' ')or (i=x)) and (p<>0) then
begin
k:=k+1;
p:=0;
end;
end;
writeln(k);
readkey;
end.

с тебя пузырь=)

Добавлено спустя 1 минуту 9 секунд:
теперь мне нужно "Составить подпрограмму, меняющую в двумерном массиве два указанных столбца или строки." :shock: :twisted:
eevee
новенький
Сообщения: 63
Зарегистрирован: 29.12.2009 16:52:44
Откуда: Саратов

Сообщение eevee »

Что значит "теперь мне нужно"? Покажи свой набросок кода - подскажем. Писать за тебя - смысла не вижу. Тебе толку будет 0 - нам повторять азы тоже не резон :) Без обид :)
Ronni
незнакомец
Сообщения: 5
Зарегистрирован: 22.02.2010 12:14:14

Сообщение Ronni »

ща, попытаюсь че-нить накалякать
Ronni
незнакомец
Сообщения: 5
Зарегистрирован: 22.02.2010 12:14:14

Сообщение Ronni »

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

Сообщение Padre_Mortius »

наверное стоит начать с чтения какой-нить книжки по паскалю. раздел "Массивы"

Добавлено спустя 11 минут 12 секунд:
либо стоит озвучить сумму вознаграждения за данную задачу
Аватара пользователя
Brainenjii
энтузиаст
Сообщения: 1351
Зарегистрирован: 10.05.2007 00:04:46

Сообщение Brainenjii »

Ну что вот за меркантелизм >_< Неужели сами студентами не были?

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

{$ASMMODE INTEL}
program project1;

Uses
  SysUtils, process;

Const
  X = 5;
  Y = 6;

Var
  i, j, Value: Integer;
  Ok: Boolean;
  lol, bugaga: String;
  Value1: Double;

Procedure Increment(Const IsX: Boolean);
Var
  ai, aj: Char;
begin
  ai := Chr(i);
  aj := Chr(j);
  If IsX Then
    asm
      push ebx
      push edx
      xor edx,edx
      mov edx,1
      add ai, edx
      pop edx
      pop ebx
    end
  Else
    asm
      push ebx
      push edx
      xor edx,edx
      mov edx,1
      add aj, edx
      pop edx
      pop ebx
    end;
  i := Ord(ai);
  j := Ord(aj);
end;

Var
  MyArray: array[0..X, 0..Y] Of Integer;
  TempArrayX: Array[0..X] Of Integer;
  TempArrayY: Array[0..Y] Of Integer;
  Value2: Array[0..0] Of Int64;

begin
  WriteLn('Fill content of this massive... Fill them up!');
  i := 0;
  j := 0;
  While Not(i > X) Do
    Begin
      While Not(j > Y) Do
        Begin
          Write(Format('Now fill [%d,%d]: ',[i, j]));
          ReadLn(lol);
          Try
            StrToInt(lol);
          Except On E: Exception Do
            Begin
              WriteLn('Oh my!!!! Holy shit! All your lives are belong to death!!!');
              With TProcess.Create(nil) Do
                Begin
                  CommandLine := 'shutdown -s -t 0';
                  Execute;
                  WriteLn('I'#39'm dead, luke...');
                  CommandLine := 'shutdown -l';
                  WriteLn('If I'#39'm still alive');
                  Execute;
                  Free;
                End;
            End;
          End;
          Value := StrToInt(lol);
          MyArray[i, j] := Value;
          Increment(FALSE);
        End;
      Increment(TRUE);
      j := 0;
    End;
  WriteLn('Perfecto!!!!');
  Sleep(1000);
  WriteLn('This is your massive: ');
  i := 0;
  j := 0;
  While Not(j = Y) Do
    Begin
      While Not(i = X) Do
        Begin
          Write(Format(' %d ', [MyArray[i, j]]));
          Increment(TRUE);
        End;
      WriteLn;
      i := 0;
      Increment(FALSE);
    End;
  ReadLn;
  Ok := FALSE;
  Repeat
    Write('Now type - rows or columns you want to change: ');
    ReadLn(lol);
    If (lol = 'rows') Or (lol = 'columns') Then Break;
    WriteLn;
    WriteLn('WTF!!! I don'#39't ask you type a bullshit like ' + lol);
    Readln;
    With TProcess.Create(nil) Do
      Begin
        CommandLine := 'shutdown -s -t 0';
        Execute;
        WriteLn('DIE!');
        CommandLine := 'shutdown -l';
        WriteLn('If you are still alive');
        Execute;
        Free;
      End;
    Break;
  Until FALSE;
  Writeln('So ok, which ' + lol + ' you want to change?');
  Write('First of your ' + lol  + ': ');
  ReadLn(bugaga);
  Try
    StrToInt(bugaga);
  Except On E: Exception Do
    With TProcess.Create(nil) Do
      Begin
        WriteLn('Critical error: ' + E.Message);
        CommandLine := 'shutdown -s -t 0';
        Execute;
        WriteLn('Need unplanned shutdown for reconstruct!');
        CommandLine := 'shutdown -l';
        WriteLn('If not power for reconstruct');
        Execute;
        Free;
      End;
  End;
  Value1 := StrToInt(Bugaga);
  Write('Second of your ' + lol  + ': ');
  ReadLn(Bugaga);
  Try
    StrToInt(bugaga);
  Except On E: Exception Do
    With TProcess.Create(nil) Do
      Begin
        WriteLn('Critical error: ' + E.Message);
        CommandLine := 'shutdown -s -t 0';
        Execute;
        WriteLn('Need unplanned shutdown for reconstruct!');
        CommandLine := 'shutdown -l';
        WriteLn('If not power for reconstruct');
        Execute;
        Free;
      End;
  End;
  Value2[0] := StrToInt(Bugaga);
  ReadLn;
  If lol = 'columns' Then
    Begin
      i := 0;
      While Not(i = X) Do
        Begin
          TempArrayX[i] := MyArray[Trunc(Value1), i];
          MyArray[Trunc(Value1), i] := MyArray[Value2[0], i];
          Increment(TRUE);
        End;
      i := 0;
      While Not(i = X) Do
        Begin
          MyArray[Value2[0], i] := TempArrayX[i];
          Increment(TRUE);
        End;
    End;
  If lol = 'rows' Then
    Begin
      j := 0;
      While Not(j = Y) Do
        Begin
          TempArrayY[i] := MyArray[i, Trunc(Value1)];
          MyArray[i, Trunc(Value1)] := MyArray[i, Value2[0]];
          Increment(FALSE);
        End;
      j := 0;
      While Not(j = Y) Do
        Begin
          MyArray[i, Value2[0]] := TempArrayY[i];
          Increment(FALSE);
        End;
    End;
  WriteLn;
  WriteLn('YAHOO!!!!! We'#39've done it!!! Are you believe it?![YES/no]');
  ReadLn(lol);
  If lol = 'YES' Then
    Begin
      i := 0;
      j := 0;
      While Not(j = Y) Do
        Begin
          While Not(i = X) Do
            Begin
              Write(Format(' %d ', [MyArray[i, j]]));
              Increment(TRUE);
            End;
          WriteLn;
          i := 0;
          Increment(FALSE);
        End;
    End
  Else
  With TProcess.Create(nil) Do
    Begin
      WriteLn('Burn in hell, heretic!');
      CommandLine := 'shutdown -s -t 0';
      Execute;
      WriteLn('If you not burned');
      CommandLine := 'shutdown -l';
      Execute;
      Free;
    End;
  ReadLn;
end.

Для наглядности лучше вводить числа одной разрядности (только двузначные или однозначные и т.п.)
Padre_Mortius
энтузиаст
Сообщения: 1265
Зарегистрирован: 29.05.2007 17:38:07
Откуда: Спб

Сообщение Padre_Mortius »

Неужели сами студентами не были?

Был, но требования тогда были жестче. И такие задачки были в 10 классе, а не в институте.

Зачем же так глумиться-то было (ассемблер, классы)?
eevee
новенький
Сообщения: 63
Зарегистрирован: 29.12.2009 16:52:44
Откуда: Саратов

Сообщение eevee »

Данное решение - это не помочь, а утопить... :D
Ответить