Народ поможите решить задачки.

Задача 1) Реализовать алгоритм решения задачи на преобразование десятичного числа n в число m. Вводимое пользователем число n должно быть integer или logint. Программа должна работать правильно для чисел, содержащих не менее 8 цифр. В случае невозможности формирования числа m на основе числа n выводить соответствующее сообщение.
- Число m состоит из нечетных цифр числа n, стоящих на позициях, номера которых четны, считая с начала.


Задача 2) Составить программу решения (задачи 1(смотреть выше)), в которой n и m имеют строковый тип данных (string).


Задача 3) По условию (задачи 1(смотреть выше)) составить программу вывода на экран по данному числу n типа string матрицу SxS, (S – кол-во цифр в числе m), состоит из нулей и цифр числа m которые расположены:
- В последней строке справа на лево.

Еще бы узнать где в твоем понимании начало у цифры ...
1)

uses crt;
var
   a,b : LongInt;
   count : byte;
   flag : boolean;

begin
   clrscr;
   write('a='); readln(a);
   count := 0;
   b := 0;
   flag := false;
   while(a <> 0) do begin
      if flag and (odd(a mod 10)) then begin
         b := b + round(exp(count*ln(10))) * (a mod 10);
         inc(count);
      end;
      a := a div 10;
      flag := not(flag);
   end;
   writeln(b);
   readln;
end.

12345678 -> 1357

klem4, по заданию:

Должно быть так: 123451789 -> 1,
ибо 2, 4 и 8 - четные цифры...

Исправил ;)

klem4, ну, и что ты исправил?

Какой номер позиции у цифры '1'?

Я же говорю, с мотря как воспринимать "начало числа"

Для меня номер цифры 1 = 8, вполне четный номер ... А так как автор не привел тестов то ..

Я бы вот так делал:

var
  a, n: longint;
  count: byte;

begin
  n := 2134754;

  a := n; count := 0;
  while a > 0 do begin
    inc(count); a := a div 10;
  end;

  while n > 0 do begin
    if (not odd(count)) and odd(n mod 10) then
      a := 10 * a + (n mod 10);
    n := n div 10; dec(count);
  end;

  while a > 0 do begin
    write(a mod 10);
    a := a div 10;
  end;
  writeln;
end.

2134754 -> 15

P.S. Вообще-то числа ДАЖЕ У НАС пишутся слева направо... Так что 1 в твоем примере - первая...

Ну я эту задачу делал таким образом, четные номера найти могу, а вот дальше не получается :

program lab; uses crt;
var n,m,b:string;
i,k,x:integer;
begin clrscr;
writeln('Введите  n:');readln(n);
m:='';
for i:=1 to length(n) do begin
if not odd(i) then begin
val(n[i],x,k);
str(x,b);
m:=concat(m,b);
end;end;
writeln;
writeln;
writeln('n=',n,' m=',m);
readln;
end.

@WARlock@, это другая задача... Под №2... В первой тебе нельзя пользоваться типом String, нужно справиться только с целочисленными типами...

Ладно спасибо с (задачей 1) помогли разобраться, остались еще две задачи.

Усе в поряде наконец-то я въехал как (задачу 3) решать.

Вот код проги:

program lab3; uses crt;
var a:array[1..100] of real;
i,j,n:integer;
b:real;
s:string;
begin clrscr;
while n<8 do begin clrscr;
write('Vvedite s:');readln(s);
val(s,n,i);end;
for i:=1 to n do begin
write('a[',i,']=');
readln(a[i]);
end;
writeln;
for i:=1 to n do begin
for j:=1 to n do begin
write(' 0'); end; writeln; end;
write(' ');
for i:=1 to n div 2 do
begin
b:=a[n+1-i];
a[n+1-i]:=a[i];
a[i]:=b;
end;
for i:=1 to n do
write(a[i]:1 :0,' ');
readln;
end.

Число-палиндром
http://forum.pascalnet.ru/index.php?showt...660&#entry30660

Люди где вы? Не спите выручайте. Кто знает как делать (задачу 2(смотреть в самом начале)) с типом string, пожалуйста напишите код проги. Осталось 3 дня до зачета.

Вот решение 3-й задача, в ней же присутствует решение второй. (вариант если матрицу хранить надо ...)

{$R-}
uses crt;
type
   TElem = char;
   PArr = ^TArr;
   TArr = array [1..1] of TElem;
   PMX  = ^TMx;
   TMx  = array [1..1] of PArr;
var
   n,m : string;
   s : PMx;
   i,j,size : byte;
begin
   clrscr;
   write('n = '); readln(n);
   i := 2;
   m := '';
   while (i <= length(n)) do begin
      if n[i] in ['1','3','5','7','9'] then m := m + n[i];
      inc(i,2);
   end;
   size := length(m);
   if size <> 0 then begin
      writeln('m = ',m);
      GetMem(s, size * sizeof(PArr));
      for i := 1 to size do GetMem(s^[i], size * sizeof(TElem));
      for i := 1 to size do begin
         writeln;
         for j := 1 to size do begin
            if i = size then s^[i]^[j] := m[j]
             else s^[i]^[j] := '0';
            write(s^[i]^[j],' ');
         end;
      end;

      for i := 1 to size do FreeMem(s^[i], size * sizeof(TElem));
      FreeMem(s, size * sizeof(PArr));
   end;

   readln
end.

Или еще вот такой вариант,

uses crt;
var
   n,m : string;
   i,size : byte;

begin

   clrscr;

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

   i := 2;

   m := '';

   while (i <= length(n)) do begin
      if n[i] in ['1','3','5','7','9'] then m := m + n[i];
      inc(i,2);
   end;

   size := length(m);

   if size <> 0 then begin
      writeln('m = ',m);
      writeln;
    for i := 1 to size * size do begin
       if i in [size * size - size + 1 .. size * size] then write(m[(size * size - i + 1)],' ')
        else write('0 ');
       if i mod size = 0 then writeln;
    end;
   end;

   readln;
end.

ps В первой проге немного перепутал, в матрице цифры идут не справа на лево а наоборот. В это проге правильно.

Выше написан код (задачи 1) решенной с помощью longint, а как ее решить с помощью integer.

Заменить LongInt на Integer не пробовал?

И еще каким образом можно решить (задачу 2(Смотреть в начале)), через if not odd(i) then begin.
odd и not odd отвечают за четность и нечетность.

А ты пост №6 ВООБЩЕ смотрел? Как можно СМОТРЕТЬ и не ВИДЕТЬ??? Там же есть использование Odd !!!

Вот я и говорю, что мне нужно решение (задачи 2) с помощью odd, а не (задачи 1) т.к она уже разобрана.