строки, работа со строками Опции

[zmei123]

ребят помогите очень надо плиз

дано k-литерных строк (эти строки сохраняются в массиве строк a ). Каждая строка содержит латинские и русские буквы, цифры и все возможные делители требуется:

1 надо выделить из каждой строки (сформировать еще один массив строк b и массив С из целых чисел, в котором будут храниться номера исходных строк , из которых выделяются подстроки) и напечатать подстроки (оформить процедурой)-расположенные между /* и */


если че не понятно в условии пишите прямо в форуме


надеюсь что кто нибудь поможет

[volvo]

Во-первых, давай определимся с компилятором, чем пользуешься?

Во-вторых, тебе теоретически или программу делать будем? (если программу - я перенесу тему в "Задачи")

Ну, и третье - приведи пример входного массива строк и соответствующего ему вывода...

[zmei123]

Во-первых, давай определимся с компилятором, чем пользуешься?

Во-вторых, тебе теоретически или программу делать будем? (если программу - я перенесу тему в "Задачи")

Ну, и третье - приведи пример входного массива строк и соответствующего ему вывода...

ну насчет компилятора то это турбо паскаль7.0 конечно
конечно нужна программа теоретически я сам ее объяснить могу

входной массив :

авыаыва/*авыаываыв*/авыаыва
аыва/*ывавы*/аывавы/*авыавыаыв*/авыаыв/*
кцукцув*/аываыв

вывод:
авыаываыв
ывавы
авыавыаыв

можеш ьпереносить тему а можеш и нет на твое усмотрение

[zmei123]

вот вроде че то сделал но не доконца можете объяснить в чем ошибка

Код

program mas1;

type
mas= array [1..20] of string;
mass= array [1..20] of integer;
procedure one(var a,b:mas;var c:mass;var y,x:string; k:integer;var u:integer);
var i,j,t,d,e:integer;
begin
  t:=0;
  d:=0;
  u:=0;
  x:='';
  y:='';
  for i:=1 to k do
    begin
    x:=a[i];
    begin
      begin
    T:=pos('*/',x);
    d:=pos('/*',x);
    if (t>d) then
    begin
      for e:=d+2 to t-1 do
      begin
        y:=y+a[i][e];
        {c[i]:=c[i]+s[i][e];}
        delete(x,d,1);
      end;
    end;
      end;
      begin
    if y<>'' then
    begin
      inc(u);
      b[u]:=y;
      y:='';
      c[u]:=i;
      delete(x,d,4);
      t:=0;
      d:=0;

      for e:=1 to d+1 do
      for p:=t-1 to length(x) do
      x:=x+x[e]+x[p]
    end;
      end;
    end;
  end;
end;


var a,b:mas;
    c:mass;
    n,k,i,u:integer;
    y,x:string;
begin
  writeln('vvedite k');
  readln(k);
  for i:=1 to k do
  begin
  readln(a[i]);
  end;
  one(a,b,c,y,x,k,u);
  for i:=1 to u do
  begin
  writeln(b[i],' ',c[i]);
  end;

  readln;
end.

Сообщение отредактировано: volvo - 28.01.2006 21:34

[volvo]

Чего это такое? Попроще нельзя было сделать? Вот так, например:

program mas1;
type
  mas  = array [1..20] of string;
  mass = array [1..20] of integer;


procedure check(const a: mas; var b: mas; var c: mass;
          const n: integer; var p: integer);
var
  i, T, start, finish: integer;

begin
  p := 0;
  for i := 1 to n do begin
    start := pos('/*', a[i]);
    finish := pos('*/', a[i]);
    if start * finish > 0 then begin

      if start > finish then begin
        T := finish; finish := start; start := T
      end;

      writeln('debug: start = ', start, ' finish = ', finish);
      inc(p);
      b[p] := copy(a[i], start + 2, finish - start - 2);

      c[p] := i;

    end;

  end;
end;

var
  a, b: mas;
  c: mass;
    n,k,i,u:integer;
    y,x:string;
begin
  write('k = '); readln(k);

  for i := 1 to k do
    readln(a[i]);

  check(a, b, c, k, u);

  for i := 1 to u do
    writeln(b[i], '':5, c[i]);

  readln;
end.

[zmei123]

да , но если допустим строка :


fsd/*fdsfsd*/fsdfsd/*vcxvx*/vcxv
fsdfsd
fsdf

то выведет fdsfsd , а vcxvx где ?????????????

вот еще одна правдо мало отличающаяся от той только в ней я не пойму после прохода цикла он берет на 2 цикле строку из первого цикла получается каша ничего не могу поделать объясните че сдесь не так

Код

program mas1;

type
mas= array [1..20] of string;
mass= array [1..20] of integer;
procedure one(var a,b:mas;var c:mass;var y,x:string; k:integer;var u:integer);
var i,j,t,d,e,q,w,z:integer;
begin
  t:=0;
  d:=0;
  u:=0;
  x:='';
  y:='';
  for i:=1 to k do
    begin
    x:=a[i];
    for j:=1 to length(x) do
    begin
      begin
    T:=pos('*/',x);
    d:=pos('/*',x);
    if (t>d) then
    begin
      for e:=d+2 to t-1 do
      begin
        y:=y+a[i][e];
        {c[i]:=c[i]+s[i][e];}
        delete(x,d,1);
      end;
    end;
      end;
      begin
    if y<>'' then
    begin
      inc(u);
      b[u]:=y;
      y:='';
      c[u]:=i;
      delete(x,d,4);
      t:=0;
      d:=0;
      {z:=length(x);
      for q:=1 to d-1 do
      for w:=t to length(x) do
      begin
        x:=x+x[q]+x[w];
      end;
      delete(x,1,z);}
    end;
      end;
    end;
  end;
end;


var a,b:mas;
    c:mass;
    n,k,i,u:integer;
    y,x:string;
begin
  writeln('vvedite k');
  readln(k);
  for i:=1 to k do
  begin
  readln(a[i]);
  end;
  one(a,b,c,y,x,k,u);
  for i:=1 to u do
  begin
  writeln(b[i],' ',c[i]);
  end;

  readln;
end.

Сообщение отредактировано: volvo - 28.01.2006 23:36

[volvo]

да, но если допустим строка :
fsd/*fdsfsd*/fsdfsd/*vcxvx*/vcxv
fsdfsd
fsdf
то выведет fdsfsd , а vcxvx где ?????????????

Измени процедуру вот так:

procedure check(const a: mas; var b: mas; var c: mass;
          const n: integer; var p: integer);
var
  i, T, start, finish: integer;

begin
  p := 0;
  for i := 1 to n do begin

    finish := -1;
    repeat
      inc(finish, 2);

      start := finish + pos('/*', copy(a[i], finish, 255)) - 1;
      finish := finish + pos('*/', copy(a[i], finish, 255)) - 1;

      if start <> finish then begin

        if start > finish then begin
          T := finish; finish := start; start := T
        end;

        inc(p);
        b[p] := copy(a[i], start + 2, finish - start - 2);

        c[p] := i;

      end;

    until start = finish;


  end;
end;

Должно работать...

И пользуйся тегами !!!

[klem4]

Вот мой вариант, офрмил не очень красиво правда .. При желанииможно убрать циклы из основной части ..

uses crt;
type
   TType = string;
   TArray = array [1..100] of TType;

procedure Input(var arr : TArray; n : byte);
var
   i : byte;
begin
   for i := 1 to n do begin
      write('s[',i,']=');
      readln(arr[i]);
   end;
   writeln;
end;

procedure CheckStr(s : TType; var arr : TArray; size : byte; var i : byte);
const
   open   = '/*';
   close  = '*/';
begin
   while (length(s) > 0) and (pos(open,s) <> 0) do begin
      delete(s,1,pos(open,s)+1);
      if (pos(close,s) < pos(open,s)) or ((pos(close,s) <> 0) and (pos(open,s) = 0)) then begin
         inc(i);
         arr[i] := copy(s,1,pos(close,s)-1);
         delete(s,1,pos(close,s)+1);
      end;
   end;
end;

var
   _in,_out : TArray;
   size,size1,j : byte;
begin

   clrscr;

   write('n = '); readln(size);

   Input(_in, size);

   size1 := 0;

   for j := 1 to size do CheckStr(_in[j], _out, size, size1);

   for j := 1 to size1 do writeln(_out[j]);

   readln;

end.

[zmei123]

ой спасибо заработало но мне еще надо чтобы она выводила символ (с наименьшим кодом) из получившихся строк и чтобы в исходных строках она удаляла пробелы в начале строки

[klem4]

Ответы на эти вопросы найдешь тут : FAQ : Строки

[zmei123]

вот прога она должна выводить все тоже самое что и до этого но и удалять пробелы в исходном массиве ,чего она не делает можете объяснить почему

uses crt;
type
   TType = string;
   TArray = array [1..100] of TType;
   mass=array [1..20] of integer;

procedure Input(var arr : TArray; n : byte);
var
   i : byte;
begin
   for i := 1 to n do begin
      write('s[',i,']=');
      readln(arr[i]);
   end;
   writeln;
end;

procedure CheckStr(s : TType; var arr : TArray;var rew:mass; size : byte; var i : byte;var j:integer);
const
   open   = '/*';
   close  = '*/';
   var
   k:integer;
   e:integer;
   q:integer;
begin
   while (length(s) > 0) and (pos(open,s) <> 0) do begin
      delete(s,1,pos(open,s)+1);
      if (pos(close,s) < pos(open,s)) or ((pos(close,s) <> 0) and (pos(open,s) = 0)) then begin
	 inc(i);
	 arr[i] := copy(s,1,pos(close,s)-1);
	 rew[i]:=j;
	 delete(s,1,pos(close,s)+1);

      end;
   end;
end;


procedure tri(var s:tarray;var n:byte);
var j,q,e,k:integer;
    x:string;
begin
  k:=0;
  e:=0;
  for q:=1 to n do
  begin
    x:=s[q];
    begin
      for j:=1 to length(s[q]) do
      begin
	if copy(x,j,1)=' ' then
	begin
	  k:=k+1;
	end;
      end;
      for e:=k to length(s[q]) do
      begin
	write(x[e]);
      end;
    end;
  end;
end;
var
   _in,_out : TArray;
   rew:mass;
   size,size1,i,n : byte;
   j:integer;
begin
   clrscr;
   write('n = '); readln(size);
   Input(_in, size);
   begin
     tri(_in,size);
   end;
   size1 := 0;
   for j := 1 to size do
   CheckStr(_in[j], _out,rew, size, size1,j);
   for j := 1 to size1 do
   begin
     writeln(_out[j],' ',rew[j]);
   end;
   readln;
end.

Тегами пользоваться будем ?

Сообщение отредактировано: volvo - 2.11.2006 19:35

[volvo]

Еще одно сообщение без тегов - и я тебя начну наказывать !!! Надоел !!!

она должна выводить все тоже самое что и до этого но и удалять пробелы в исходном массиве ,чего она не делает

Что, ВСЕ пробелы удалять? Ты задание изначально какое привел? Теперь так и будешь по крупицам что-то новое выдумывать?

"Коней на переправе не меняют"...

[zmei123]

извини я новичок в этом деле , значит все услвие приводить вначале хорошо так и сделаю