IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Сортировка слов в строке
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 5
Пол: Женский

Репутация: -  0  +


Помогите решить задачку smile.gif
Вводится произвольное кол-во слов в строку, программа выводит кол-во слов в строке и переставляет местами слова (1 со 2, 3 с 4 и т.д), если перед первым словом пробел, или между словами более одного пробела, то выдается сообщение о ошибке и предлагается начать сначала.

//в строке переставить местами рядом стоящие слова(1 со 2, 3 с 4, и т.д.) Дана
//дана строка, нач. не пробелом, между словами по 1 пробелу,
//и строка закан. буквой

program ctroca;
{$APPTYPE CONSOLE}
uses
SysUtils;
var s,s1,temp:string;
s2:array[1..25]of string;
p,k,n,i,t:integer;
begin
writeln('Vvedite text');
readln(s);
writeln;
k:=1;
n:=1;
p:=0;
s1:='';

for i:=1 to length(s) do
begin
if (s[i]<>' ')and(s[i+1]=' ')
then inc(k);
end;

for i:=1 to length(s) do
begin
if (s[i]<>' ')
then begin
insert(s[i],s1,n);
inc(n);
end;
if (s[i]=' ') or (i=length(s))
then begin
n:=1;
inc(p);
s2[p]:=s1;
s1:='';
end;
end;

if

for i:=1 to length(s) do
if (s[i]=' ') and (s[i+1]=' ')
then begin
writeln('Error!!!!');
s:='';
writeln('Mnogo probelov ');
writeln('Vvedite text :');
readln(s);
for i:=1 to Length(s) do
begin
if (s[i]<>' ')and(s[i+1]=' ')
then inc(k);
end;
end;
end;

if s[1]=' '
then begin
writeln('Error!!!!');
writeln('Nachalo probel ');
writeln('Vvedite text :');
readln(s);
for i:=1 to Length(s) do
begin
if (s[i]<>' ')and(s[i+1]=' ')
then inc(k);
end;
end;
writeln('Kol-vo slov: ',k);

readln;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

Репутация: -  55  +


1. Пользуйся тэгами.
2. Приведи пример строки, которая на входе, и строки, которая на выходе.


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Знаток
****

Группа: Пользователи
Сообщений: 424
Пол: Мужской

Репутация: -  2  +


Код

var s : string;
var arr : array [1..256] of string;
var c : integer;
var slov : integer;
function make_words(s:string):boolean;
var i: integer;
begin
  slov:=1;
  c:=1;
  make_words:=false;
  i:=1;
  while (i<=length(s)) and (s[i]=' ') do
    inc(i);
  while i<=length(s)do begin
    if (s[i]=' ') and (i<length(s)) and (s[i+1]=' ') then exit;
    if (s[i] in ['A'..'z']) then arr[c]:=arr[c]+s[i];
    if (s[i]=' ') then begin inc©; inc(slov); end;
    inc(i);
  end;
  if s[length(s)]=' ' then begin dec©; dec(slov); end;
  make_words:=true;
end;
var flag : boolean;
i : integer;
tmp : string;
begin
  readln(s);
  flag:=make_words(s);
  if (flag) and (c>1) then begin
    for i:= 0 to (©div 2) do begin
      tmp:=arr[i*2+1];
      arr[i*2+1]:=arr[i*2+2];
      arr[i*2+2]:=tmp;
    end;
    for i:=1 to c do write(arr[i],' '); writeln; writeln('slov:',slov);
  end else
    if (c=1) and (flag) then begin
      writeln(s); writeln(1);
    end else
      writeln('Strashnij error!!!');
  readln;
end.


Сообщение отредактировано: arhimag -


--------------------
Чего хочет женщина – того хочет Бог
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4





Группа: Пользователи
Сообщений: 5
Пол: Женский

Репутация: -  0  +


У меня считает кол-во слов, а местами не меняет
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Знаток
****

Группа: Пользователи
Сообщений: 424
Пол: Мужской

Репутация: -  2  +


если будут вопросы, спрашивай


--------------------
Чего хочет женщина – того хочет Бог
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гуру
*****

Группа: Пользователи
Сообщений: 1 117
Пол: Мужской
Реальное имя: Богдан

Репутация: -  11  +


Не работает:
Цитата
a b c d e


Сообщение отредактировано: Bokul -


--------------------
Лао-Цзы :
Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7





Группа: Пользователи
Сообщений: 5
Пол: Женский

Репутация: -  0  +


@-что означает?(dec©)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Знаток
****

Группа: Пользователи
Сообщений: 424
Пол: Мужской

Репутация: -  2  +


извини багу нашел, ща правлю

Код
(с)
означает ( с )

в моей проге цифры - не есть буквы в словах

Сообщение отредактировано: arhimag -


--------------------
Чего хочет женщина – того хочет Бог
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гуру
*****

Группа: Пользователи
Сообщений: 1 117
Пол: Мужской
Реальное имя: Богдан

Репутация: -  11  +


Цитата
@-что означает?(dec©)

Глюк форума - поставь dec и в дужках с
dec( с ) - так только без пробелов.

Цитата
в моей проге цифры - не есть буквы в словах

Глянь еще раз, я изменил на буквы.


--------------------
Лао-Цзы :
Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Знаток
****

Группа: Пользователи
Сообщений: 424
Пол: Мужской

Репутация: -  2  +


Код
program Project2;


var s : string;
var arr : array [1..256] of string;
var c : integer;
var slov : integer;
function make_words(s:string):boolean;
var i: integer;
begin
  slov:=1;
  c:=1;
  make_words:=false;
  i:=1;
  while (i<=length(s)) and (s[i]=' ') do
    inc(i);
  while i<=length(s)do begin
    if (s[i]=' ') and (i<length(s)) and (s[i+1]=' ') then exit;
    if (s[i] in ['A'..'z']) then arr[c]:=arr[c]+s[i];
    if (s[i]=' ') then begin inc(c); inc(slov); end;
    inc(i);
  end;
  if s[length(s)]=' ' then begin dec(c); dec(slov); end;
  make_words:=true;
end;
var flag : boolean;
i : integer;
tmp : string;
begin
  readln(s);
  flag:=make_words(s);
  if (flag) and (c>1) then begin
    for i:= 1 to ((c)div 2) do begin
      tmp:=arr[i*2-1];
      arr[i*2-1]:=arr[i*2];
      arr[i*2]:=tmp;
    end;
    for i:=1 to c do write(arr[i],' '); writeln; writeln('slov:',slov);
  end else
    if (c=1) and (flag) then begin
      writeln(s); writeln(1);
    end else
      writeln('Strashnij error!!!');
  readln;
end.


вот теперь все ок smile.gif


--------------------
Чего хочет женщина – того хочет Бог
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Гуру
*****

Группа: Пользователи
Сообщений: 1 117
Пол: Мужской
Реальное имя: Богдан

Репутация: -  11  +


Ты еще одно условие забыл:
Цитата
если перед первым словом пробел , или между словами более одного пробела, то выдается сообщение о ошибке и предлагается начать сначала

smile.gif


--------------------
Лао-Цзы :
Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12





Группа: Пользователи
Сообщений: 5
Пол: Женский

Репутация: -  0  +


Работает, но частично!Строка считывается, кол-во слов считается. Но мне нужно, чтобы после вывода на экран кол-ка слов была выведена строка, в которой были бы поменены местами слова из исходной строки. К примеру:
Цитата
МАМА ПАПА Я
слов:3
ПАПА МАМА Я

Если слов больше, он меняет 1 со 2, 3 с 4, 5 с 6, и тд.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Гуру
*****

Группа: Пользователи
Сообщений: 1 117
Пол: Мужской
Реальное имя: Богдан

Репутация: -  11  +


сНежная, а ты внимательно смотрела? Все работает, как ты описала.
Прикрепленное изображение

Сообщение отредактировано: Bokul -


--------------------
Лао-Цзы :
Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Знаток
****

Группа: Пользователи
Сообщений: 424
Пол: Мужской

Репутация: -  2  +


черт smile.gif
Код

program Videlenieslovzamenachetnogonanechetnoe;

var s : string;
var arr : array [1..256] of string;
var c : integer;
var slov : integer;
function make_words(s:string):boolean;
var i: integer;
begin
  slov:=1;
  c:=1;
  make_words:=false;
  i:=1;
  while (i<=length(s)) and (s[i]=' ') do
    inc(i);
  while i<=length(s)do begin
    if (s[i]=' ') and (i<length(s)) and (s[i+1]=' ') then exit;
    if (s[i] in ['A'..'z']) then arr[c]:=arr[c]+s[i];
    if (s[i]=' ') then begin inc(c); inc(slov); end;
    inc(i);
  end;
  if s[length(s)]=' ' then begin dec(c); dec(slov); end;
  make_words:=true;
end;
function doit : boolean;
var flag : boolean;
i : integer;
tmp : string;
begin
  doit:=false;
  readln(s);
  flag:=make_words(s);
  if (flag) and (c>1) then begin
    for i:= 1 to ((c)div 2) do begin
      tmp:=arr[i*2-1];
      arr[i*2-1]:=arr[i*2];
      arr[i*2]:=tmp;
    end;
    doit:=true;
    for i:=1 to c do write(arr[i],' '); writeln; writeln('slov:',slov);
  end else
    if (c=1) and (flag) then begin
      writeln(s); writeln(1); doit:=true;
    end else  begin
      writeln('Strashnij error!!!');
      exit;
    end;
  readln;
end;
var ch : char;
i:integer;
begin
  ch:=' ';
  repeat
    if not(doit) then begin
      writeln('Chtobi povtorit nazmi R i enter, chobi vijti nezmi E i enter');
      readln(ch);
      for i:= 1 to 256 do
        arr[i]:='';
    end else
      ch:='E';
  until ch='E';
end.


сНежная я сделал только для английских букв


--------------------
Чего хочет женщина – того хочет Бог
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15





Группа: Пользователи
Сообщений: 5
Пол: Женский

Репутация: -  0  +


Работает! Огромное спасибо! Сейчас буду пытаться понять, как это сделано! good.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


const max_words = 128;
type
TWords = array [1..max_words] of String;

function GetWords(s: String; var w: TWords): Integer;
var
n, i: Integer;
begin
n := 0;
while Length(s) > 0 do begin
inc(n);
i := 1;
while (i <= Length(s)) and (s[i] <> ' ') do inc(i);
w[n] := Copy(s, 1, pred(i));
delete(s, 1, i);
end;
GetWords := n;
end;

procedure Exchange(var w: TWords; const n: Integer);
var
i: Integer;
T: String;
begin
i := 2;
while (i <= n) do begin
T := w[i]; w[i] := w[pred(i)]; w[pred(i)] := T;
inc(i, 2);
end;
end;

var
s: String;
w: TWords;
n, i: Integer;

begin
repeat
clrscr;
write('s = '); readln(s);
until (s[1] <> ' ') and (Pos(' ', s) = 0);

n := GetWords(s, w);
Exchange(w, n);
for i := 1 to n do write(w[i], ' ');
end.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Знаток
****

Группа: Пользователи
Сообщений: 424
Пол: Мужской

Репутация: -  2  +


klem4 , я не уверен что автор темы знает функции Copy, Delete, Pos и т.д.


--------------------
Чего хочет женщина – того хочет Бог
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Гость






Опять за флейм? mad.gif А насчет Length ты что, уверен? А насчет While? Мало ли, кто чего не знает? Если ты не знаешь, что такое Thread, давай, Windows+Linux + все остальные многозадачные ОСи отменим? Ты ведь этого не знаешь, это же ужасно, как в MS ТЕБЯ не спросили, знаком ли ты с этим понятием, или не очень?
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 23.01.2021 9:32
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name