Несколько прог надо перевести из паскаля в си++

Ответить
3nil
Сообщения: 4
Зарегистрирован: 23 ноя 2007, 13:38

рублю в программировании, как дебил в игре на контрабасе, поэтому прошу помощи более опытных.
прогу и еще несколько надо перевести с паскаля на с++.

program chisla_armstronga;
uses crt;
var d,y,m,i,p,j,a,k,b,n:longint;
t,tr,r,s:real;

begin
clrscr;
Writeln('Vvedite tseloye chislo do kotorogo nujno podschitat`');
writeln('Vse chisla ARMSTRONGA');
readln(m);
for a:=11 to m do begin
j:=-1;
i:=1;
r:=a;
repeat
d:=a div i;
tr:=r/i;
i:=i*10;
j:=j+1;
until tr<=1;
p:=a mod 10;
if p<>0 then
s:=exp(j*ln(p));
k:=1;
tr:=1;
repeat
k:=k*10;
d:=a div k mod 10;
if d<>0 then begin t:=exp(j*ln(d)); s:=s+t; end;
tr:=r/k
until tr<=1;
if trunc(s)=a then writeln(s:9:0);
end;
writeln('Najmite Enter chtobi viyti');
readkey;

end.
3nil
Сообщения: 4
Зарегистрирован: 23 ноя 2007, 13:38

уже решена
3nil
Сообщения: 4
Зарегистрирован: 23 ноя 2007, 13:38

третья тоже решена
3nil
Сообщения: 4
Зарегистрирован: 23 ноя 2007, 13:38

четвертая - схема Горнера вычисления полинома n-ой степени.

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

uses crt;
var
	i,n,errcode:integer;
	x,s,a:real;
	q,w,e,r,t,y:string;

 begin         clrscr;
	Writeln('Shema Gornera dlya resheniya Polinoma');
	writeln;

	writeln('Vvedite X');
	readln(q);
	val(q,x,errcode); if errcode<>0 then begin writeln('Tak Nel`zya!!! Najmite ENTER chtobi viyti'); readln;exit;end else begin

	writeln('Vvedite kolichestvo koeffitsientov');
	readln(w);
	val(w,n,errcode); if errcode<>0 then begin writeln('Tak Nel`zya!!! Najmite ENTER chtobi viyti'); readln;exit;end else begin

	writeln('Vvedite ',n,' koeffitsient' );
	readln(e);
	val(e,a,errcode); if errcode<>0 then begin writeln('Tak Nel`zya!!! Najmite ENTER chtobi viyti'); readln;exit;end else begin
	s:=x*a;
	i:=n-1;
		repeat
		writeln('Vvedite ',i,' koeffitsient' );
		readln(e);
		val(e,a,errcode); if errcode<>0 then begin writeln('Tak Nel`zya!!! Najmite ENTER chtobi viyti'); readln;exit;end else begin
		s:=(s+a)*x;
		i:=i-1;end
		until i=0;

	writeln('Vvedite 0 koeffitsient' );
	readln(a);
	s:=s+a;
	writeln('Summa Mnogochlena ravna ',s:12:2);
	writeln('Najmite Enter chtobi viyti');
	readln;
	end;end;end;
 end.
пятая, поиск седловой точки в прямоугольной вещественной матрице (элемент матрицы максимальный в своей строке и минимальный в столбце

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

uses crt;
const   m=3;
	n=3;
var
	a:array[1..m,1..n] of integer;
	u:array[1..m,1..n] of string;
	i,w,j,r,z,t,k,errcode:integer;


 BEGIN		clrscr;
	writeln('+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++');
	writeln('                Programma poiska sedlovoy tochki v matrice');
	writeln('+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++');
	writeln;
	writeln('                        Vvedite elementi matrici');
	writeln;
	for i:=1 to m do
		 begin
			for j:=1 to n do
				begin Writeln('Vvedite a[',i,',',j,']');
					readln(u[i,j]);
					val(u[i,j],a[i,j],errcode);
					if errcode<>0 then
						begin
						writeln('Eta programma rabotayet tolko s chislami,najmite ENTER chtobi viyti');
						readln;exit;
						end;
				end;
		 end;
	w:=0;
 for i:=1 to m do
	begin
		 z:=a[i,1];  k:=1;  t:=i;
		 for j:=1 to n do
		     begin
			     if z>=a[i,j] then begin z:=a[i,j]; k:=j; end;

		     end;

		     r:=z;


		     for i:=1 to m do begin
			if r<=a[i,k] then r:=a[i,k];
			end;
			if r=z then
				begin writeln('Sedlovaya tochka etoy matritsi ravna  ',r,', nahoditsya  v ',t,' stroke i v ',k,' stolbce');
					w:=w+1;
				end; i:=t;

    end;
    if w=0 then begin writeln('Sedlovih tochek net, najmite ENTER chtobi viyti'); end;
    if w>1 then begin clrscr; writeln('Sedlovaya tochka mojet bit tolko odna, najmite ENTER chtobi viyti'); end;

 readln;
 end.
шестая -метод половинного деления для поиска в упорядоченной таблице

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

uses crt;
label 1,2,3,4;
var
provera,i,j,n,m:integer;
a:array [1..100] of string;
y,s:string;

 procedure vvod;
	 begin
		writeln;
		writeln('Programma poiska elementa v massiva metodom polovinnogo deleniya');
		writeln;
		write('   Vvedite kolichestvo elementov massiva   ');
		readln(n);
		for i:=1 to n do
			begin
			 write('    Vvedite ',i,'-y element   ');
			 readln(a[i]);
			end;
	 end;
 procedure Sortirovka;
 var k: integer;
 begin

 writeln ('     Proizvedena sortirovka');
    for i:=1 to n-1 do
	begin
		for j:=i to n do
			begin
			if a[i]>=a[j] then
				begin
				  y:=a[i];
				  a[i]:=a[j];
				  a[j]:=y;
				end;
			end;
	end;
 end;
 procedure vivod;
	 begin
		for i:=1 to n do writeln('       ',i,'-y element raven`  ', a[i]);
	 end;
 procedure poisk;
 label 1,2,3,4;
 var
 k:integer;
 netu:boolean;
 begin
	writeln;
	Write('         Chto ishem???    ');
	readln(s);
	if s<>'' then begin
	for i:=1 to n do begin if a[i]=s then begin
	k:=n;
1:	k:=k div 2;
2:      if a[k]=s then begin writeln;writeln('     Zaproshenniy element  ', a[k],'  nayden v stroke  ',k);
				 readln;halt(1);end else
	if a[k]>s then goto 1 else
		begin
			if k=n-1 then k:=n;
			k:=k+((n-k) div 2); goto 2;
		end;
	end;
	netu:=false;
	provera:=1;
	end;
end;
end;
 procedure net_takovo;
  begin if provera<>1 then writeln;writeln('      Net takogo'); end;
 BEGIN  clrscr;
	vvod;
	sortirovka;
	vivod;
	poisk;
	net_takovo;
	readln;
	halt(1);
 end.
Ответить