Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.05.02;
Скачать: [xml.tar.bz2];

Вниз

Обработка строки. Паскаль   Найти похожие ветки 

 
Troy ©   (2004-04-13 01:49) [0]

ужасно глючит комиплятор, не могу доделать прогу.
надо из строки "123 456    789" сделать строку "789 456 123" и на экран вывести. помогите пожалста.
добился только : из "123 456    789" в "987 654 321"
:-( ну не врумаю я как ....

program stroka;
var a,b,st,st1,st2:string;
   var1,i,n,d,n1:integer;
begin
writeln("введите строку");
readln(st);
a:=" ";
b:="  ";
n:=pos (a,st);
if n<>0 then
while n=1 do
       begin
       delete(st,1,1);
       n:=pos(a,st);
       end;
n:=pos(b,st);
while n<>0 do
   begin
   delete(st,n,1);
   n:=pos(b,st);
   end;
n:=length(st);
n1:=n;
st2:=st[n];
while d<n do
 begin
  st1[d]:=st[n1];
  n1:=n1-1;
  d:=d+1;
  end;
st1:=concat(st2,st1);
n:=pos (a,st1);if n<>0 then
while n=1 do
       begin
       delete(st1,1,1);
       n:=pos(a,st);
       end;
writeln (st1);
end.


 
TUser ©   (2004-04-13 07:30) [1]

setLength(ar,0);
i:=pos(" ",s); j:=1;
if i<>0 then
repeat
if i<>j+1 then begin
  setLength(ar,length(ar)+1);
  ar[length(ar)-1]:=copy(s,j,i-j);
  j:=i+1;
  i:=posex(" ",s,j);
  if i=0 then i:=length(s)+1;    
  end;
until (i=0) or (j=length(s)+2);
s:="";
for i:=length(ar)-1 downto 0 do
  s:=s+ar[i]+" ";
writeln(copy(s,1,length(s)-1));


 
PKT   (2004-04-13 07:34) [2]


 St1 := "";
 repeat
   I := Pos(#32, St);
   if I > 0 then begin
     St1 := Copy(St, 1, I - 1) + #32 + St1;
     Delete(St, 1, I);
     while St[1] = #32 do Delete(St, 1, 1);
   end;
 until I = 0;
 St1 := St + #32 + St1;


 
TUser ©   (2004-04-13 08:03) [3]

var i:integer; s,news:string; buf:string;
procedure writebuf;
var j:integer;
begin
if buf<>"" then begin
  j:=1;
  while j<(length(s) div 2) do begin
     c:=s[j];
     s[j]:=s[length(s)-j+1];
     s[length(s)-j+1]:=c;
     inc(j);
     end;
  news:=news+buf+" ";
  buf:="";
  end;
end;

begin
buf:=""; news:="";
for i:=length(s) downto 1 do
  if s[i]<>" " then buf:=buf+s[i]
  else writebuf;
writebuf;
writeln(copy(news,1,length(news)-1);
end;


 
Troy ©   (2004-04-13 08:55) [4]

TUser, c : string?


 
TButton ©   (2004-04-13 09:07) [5]

>ужасно глючит комиплятор
"ничто так не ограничивает полет мысли програмиста, как компилятор" (с)


 
Troy ©   (2004-04-13 09:10) [6]

TUser
procedure writebuf;
var j:integer;
begin
if buf<>"" then begin
 j:=1;
 while j<(length(s) div 2) do begin
    c:=s[j];
    s[j]:=s[length(s)-j+1];
    s[length(s)-j+1]:=c;
 {Type mismatch :( }
    inc(j);
    end;
 news:=news+buf+" ";
 buf:="";
 end;
end;


 
Troy ©   (2004-04-13 09:12) [7]

причем var c:string;


 
TButton ©   (2004-04-13 09:43) [8]

тебе только
"надо из строки "123 456    789" сделать строку "789 456 123" и на экран вывести"
вот вам код

function GetValueS(s: string; num: integer): string;
var
 sl: TStringList;
begin
 result:="";
 sl:=TStringList.Create;
 sl.AddStrings(ParseToWords(s));
 if num>sl.Count-1 then Exit;
 result:=sl[num];
end;

и то без чего он не будет работать

function ParseToWords(s: string): TStringList;
var
 i: integer;
 ss: string;
begin
 result:=TStringList.Create;
 if s="" then Exit;
 ss:="";
 for i:=1 to length(s) do
 begin
   if s[i]=" " then
   begin
     result.Add(ss);
     ss:="";
   end
   else
     ss:=ss+s[i];
 end;
 if ss<>"" then result.Add(ss);
end;

это правда для дельфи, для паскаля попробуй написать свой вариант TStringList или из той же дельфы рипни.


 
Troy ©   (2004-04-13 09:48) [9]

а "num" это что ?


 
Ega23 ©   (2004-04-13 09:55) [10]

TButton ©   (13.04.04 09:43) [8]

А где  result:=TStringList.Create данный стринглист убиваться будет, что-то понять не могу?


 
Troy ©   (2004-04-13 09:59) [11]

хм...
ну вот переделал под паскаль...

program stroka;
var out,result,inpstr : string;

function ParseToWords(s: string): String;
var
i: integer;
ss: string;
begin
result:="";
if s="" then Exit;
ss:="";
for i:=1 to length(s) do
begin
  if s[i]=" " then
  begin
    insert(ss,result,length(ss)+1);
    ss:="";
  end
  else
    ss:=ss+s[i];
end;
if ss<>"" then insert(ss,result,length(ss)+1);
end;
function GetValueS(s: string; num: integer): string;
var
sl: String;
begin
result:="";
sl:="";
sl:=ParseToWords(s);
if num > length(sl)-1 then Exit;
result:=sl[num];
end;
begin
writeln ("vvedite stroku");
readln (inpstr);
out:=ParseToWords(inpstr);
writeln(out);
end.

но похоже непрально...


 
TButton ©   (2004-04-13 09:59) [12]

re 9
первая функция выдергивает слово номер num из строки s

re 10
пральна. это сказывается недостаток опыта на момент написания кода, а сейчас просто времени нет переписать. а вообще - имхо он убьется сам вместе с прогой.


 
Anonimous   (2004-04-13 10:03) [13]

Может это поможет:


function ReOrder(str: string): string;
var
 buf, res: string;
 i, j: Integer;
begin
 for i := Length(str) downto 1 do
 begin
   if str[i] <> " " then
     buf := buf + str[i]
   else if (buf <> "") then
   begin
     for j := Length(buf) downto 1 do
       res := res + buf[j];
     buf := "";
     res := res + " ";
   end;
 end;
 result := res + buf;
end;

var
 s: string = " 123   456   789   2354234 ";
begin
 Writeln(ReOrder(s));
 Readln
end.


 
Ega23 ©   (2004-04-13 10:06) [14]

re 10
пральна. это сказывается недостаток опыта на момент написания кода, а сейчас просто времени нет переписать. а вообще - имхо он убьется сам вместе с прогой.

Тогда уж лучше
function ParseToWords(s: string; List:TStringList): Boolean;


 
Troy ©   (2004-04-13 10:11) [15]

Re 13
хм. ничто не выводится на экран :(


 
TButton ©   (2004-04-13 10:12) [16]

но похоже непрально...
да. вы как нельзя правы =) ибо преждний вариант возвращал TStringList. в Паскале, я его заменил на array of string, а местами (не без подсказки мастеров) - на TStringArray
type
 TStringArray = array of string;

т.е. переписать надо было примерно так

procedure ParseToWords(s: string; var res: TStringArray);
var
i: integer;
ss: string;
begin
SetLength(res,0);          // чистим
if s="" then Exit;         // если строка пустая - уходим
ss:="";                    // чистим буфер
for i:=1 to length(s) do    
begin
  if s[i]=" " then         // нашли пробел
  begin
    SetLength(res, high(res)+2);  // добавляем к массиву еще одну строку
    res[high(res)]:=ss;           // нишем в нее буфер
    ss:="";                       // чистим буыер
  end
  else
    ss:=ss+s[i];           // не пробел - добавляем к буферу  
end;
// если по концове в буфере что-то есть
if ss<>"" then
begin
  SetLength(res, high(res)+2);  // добавляем к массиву еще одну строку
    res[high(res)]:=ss;           // нишем в нее буфер
end;
end;


 
panov ©   (2004-04-13 10:13) [17]

function ParseStr(aSrc: String):String;
var
 tmpStr: String;
 i: Integer;
begin
 if aSrc="" then Exit;
 Result := "";
 tmpStr :="";
 for i := 1 to Length(aSrc) do
 begin
   if aSrc[i]=" " then
   begin
     Result := tmpStr+" "+Result;
     tmpStr := "";
   end
   else tmpStr := tmpStr + aSrc[i];
 end;
 Result := tmpStr+" "+Result;
end;


 
Ega23 ©   (2004-04-13 10:13) [18]

Troy ©   (13.04.04 10:11) [15]

Хочешь совет дельный?
Возьми бумажку, карандаш, отодвинь клавиатуру нафиг и нарисуй себе алгоритм. Если ты будешь представлять что делать, то и вопросы такие задавать не будешь.


 
Troy ©   (2004-04-13 10:14) [19]

рисовал. сделал. не получается функциями замутить это в паскале мля.
на бэйские то проще...


 
TButton ©   (2004-04-13 10:16) [20]

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

var
 ar1, ar2; TStringArray;
 i: integer;
 source: string;
begin
 Writeln("input a string");
 Readln(source);
 ParseToWords(source, ar1);
 ParseToWords(source, ar2);
 if high(ar1)>=0 then
 for i:=0 to high(ar1) do
   ar2[i]:=ar1[high(ar1)-i];
 source:="";
 if high(ar1)>=0 then
 for i:=0 to high(ar1) do
   source:=source+ar2[i]+" ";
 Writeln(source);
 Write("Press Enter");
 Readln;
end.


 
Ega23 ©   (2004-04-13 10:17) [21]

Всё, что тебе нужно, это
Length, и Str[i].
Подумай!


 
TButton ©   (2004-04-13 10:19) [22]

комментарий:
 парсим два раза чтоб получить два одинаковых массива.
 вместо собирания последней строки можно просто последовательно вывести все элементы ar1
 более того, можно обойтись без ar2 вообще. в таком случае нужно собрать в строку все эл-ты ar1 в обратном порядке. что-то я об этом сразу не подумал =)


 
TButton ©   (2004-04-13 10:20) [23]

работа над ошибками:
 вместо собирания последней строки можно просто последовательно вывести все элементы ar2


 
Troy ©   (2004-04-13 10:20) [24]

re 16. TButton
SetLength - unknown identifier


 
TButton ©   (2004-04-13 10:23) [25]

че правда?
я думаю, если в паскале есть динамические массивы, то и SetLength должен быть.


 
Troy ©   (2004-04-13 10:25) [26]

ну вот нету...
паскаль 7.0


 
Anonimous   (2004-04-13 10:27) [27]

program a1;
function ReOrder(str: string): string;
var
buf, res: string;
i, j: Integer;
begin
buf:="";
res:="";
for i := Length(str) downto 1 do
begin
  if str[i] <> " " then
    buf := buf + str[i]
  else if (buf <> "") then
  begin
    for j := Length(buf) downto 1 do
      res := res + buf[j];
    buf := "";
    res := res + " ";
  end;
end;
for j := Length(buf) downto 1 do
res := res + buf[j];
reOrder := res;
end;

var
s: string;
begin
Write("Insert str:");
Readln(s);
Writeln(ReOrder(s));
Readln
end.


 
Anonimous   (2004-04-13 10:27) [28]


program a1;
function ReOrder(str: string): string;
var
buf, res: string;
i, j: Integer;
begin
buf:="";
res:="";
for i := Length(str) downto 1 do
begin
  if str[i] <> " " then
    buf := buf + str[i]
  else if (buf <> "") then
  begin
    for j := Length(buf) downto 1 do
      res := res + buf[j];
    buf := "";
    res := res + " ";
  end;
end;
for j := Length(buf) downto 1 do
res := res + buf[j];
reOrder := res;
end;

var
s: string;
begin
Write("Insert str:");
Readln(s);
Writeln(ReOrder(s));
Readln
end.


 
TButton ©   (2004-04-13 10:28) [29]

вот. Anonimous правильный код кажет, а я полезный =)


 
Troy ©   (2004-04-13 10:33) [30]

re 28
во !!! %))
четное колиество пробелов приводит к ненаписанию вывода :)
но спасибо. преподу буду с 1м и 3мя пробелами показывать ) если не "успеем" :) доработать. а то через 30 мин уходить ужо :(


 
Troy ©   (2004-04-13 10:41) [31]

эхх было б время и нормальный компилятор я б сделал правильный и полезный код! :)))


 
TButton ©   (2004-04-13 10:45) [32]

имхо, Дельфи(ConsoleApp) функционально мощнее, чем Pascal 7.0


 
Troy ©   (2004-04-13 10:49) [33]

я уже говорил преподу и про C и про дельфи "консольным видом". он меня посылал к зафкафу. на что тот сказал: минвуз сказал - мы сделали иди отсюда мальчик не мешай :)


 
Anonimous   (2004-04-13 11:04) [34]

Что значит ненаписание вывода Alt_F5 нажми и посмотри что получилось.


 
VEG ©   (2004-04-13 20:45) [35]

Видимо, вопрос мало кто понял - требуется из строки "123 456    789" сделать строку "789 456 123". Делаем так:

function GyperReOrder(s: string): string;
begin
GyperReOrder:="789 456 123";
end;
{--==USING==--}
GyperReOrder("123 456 789");


:)


 
VEG ©   (2004-04-13 20:49) [36]

>TButton ©   (13.04.04 10:45) [32]
 ИМХО, FreePascal много удобнее подходит для этой цели.


 
SergP ©   (2004-04-13 21:14) [37]

>ужасно глючит комиплятор

Нечего на компилятор пенять, коли ... (Русская пословица)


 
VEG ©   (2004-04-13 21:45) [38]

Я имел ввиду FreePascal намного лучше использовать при решении задач. Правда, он немного глюковат, но это не всегда мешает. Всегда есть обходные пути. Да и разработчики его постоянно дебаггят.



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.05.02;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.55 MB
Время: 0.033 c
3-1081233326
Иришка
2004-04-06 10:35
2004.05.02
Запрос в ADOQuery


6-1078992878
knack
2004-03-11 11:14
2004.05.02
Установка и изменение настроек протокола TCP/IP.


1-1082287187
Андрей Сенченко
2004-04-18 15:19
2004.05.02
Поймать ответ ShellExecute в случае ошибки


1-1082095259
Dentist
2004-04-16 10:00
2004.05.02
ICO to BMP


14-1081437031
E1
2004-04-08 19:10
2004.05.02
интересный IRC бот :)





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский