Pascal/Turbo Pascal - ¿Error de este subprograma?

   
Vista:
Imágen de perfil de Rubén

¿Error de este subprograma?

Publicado por Rubén (2 intervenciones) el 23/10/2014 23:59:50
Hola buenas, estoy un poco desesperado con esto y seguramente es una tontería pero el subprograma tiene que sacar los multiplos sinceros de un número hasta un limite especificado por el usuario.

Múltiplos sinceros: Se denomina “múltiplos sinceros” a "los números que son múltiplos de un
número base de una cifra y en los cuales la suma de sus cifras es también este mismo número base".
Por ejemplo, “múltiplos sinceros” del número base 2 son el 2, 20, 110, 200, 1.010, 1.100, 2.000, ...
Ya que el 20 es múltiplo de 2 y además la suma de sus cifras (2+0) da 2.
El 110 también es múltiplo de 2 y además la suma de sus cifras (1+1+0) da 2.
Otro ejemplo: “múltiplos sinceros” del número base 9 son el 9, 18, 27, 36, 45, 54, 63, 72, 81, 90,
108, 117, ...

En mi código he definido el subprograma de esta manera:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
PROCEDURE MultiplosSinceros (base,limite:integer);
 	BEGIN
	     suma:=0;
		 FOR contador:=1 TO limite DO
		 BEGIN
		 auxi:=contador;
		 IF (contador MOD base=0) THEN
		 BEGIN
		 		WHILE auxi<>0 DO
		 		BEGIN
		 			auxi2:=auxi MOD 10;
		 			suma:=suma + auxi2;
		 			auxi:=auxi DIV 10;
		 		END;
		 		IF suma=base THEN
		 			write(' ', contador);
		 END;
		 END;
	END;

En teoría creo que está bien el algoritmo pero no salen los resultados adecuados asi que me gustaría que alguien le echara un ojito y me dijera donde falla y a poder ser como hacerlo funcionar correctamente. Gracias de antemano ;)
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
1
Responder

¿Error de este subprograma?

Publicado por David (139 intervenciones) el 25/10/2014 12:29:56
Te propongo la siguiente solución.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Uses CRT;
 
var
  i,Multi,base,tope : integer;
 
function Sumacifras(n:Integer):Integer;
 
var
  suma:Integer;
 
begin
  suma:=0;
  while n>0 do
    begin
      suma:=suma + (n mod 10);
      n:=n div 10;
    end;
  sumacifras:=suma;
end;
 
 
begin
  clrscr;
  Writeln('Introduzca un n£mero:');
  readln(base);
  Writeln('Tope: ');
  readln(tope);
  for i:=1 to tope do
    begin
      if (sumacifras(i)=base) and (i mod base=0) then
        writeln(I);
    end;
 
  readln;
 
end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
Imágen de perfil de Rubén

¿Error de este subprograma?

Publicado por Rubén (5 intervenciones) el 26/10/2014 14:45:45
Muchas gracias, he cogido la parte del programa principal para hacerla un subprograma sencillo en el que el subprograma que me ofreces se realiza dentro.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

¿Error de este subprograma?

Publicado por David (139 intervenciones) el 26/10/2014 18:12:17
No olvides copiar también la función ;-)
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar