sábado, 7 de junio de 2008

Solución de la Hoja Problemas Nº 8

Function Esprimo(Numero As Long) As Booelan
aaaa
'Como comentamos en clase simplificamos la función introduciendo directamente los diez primeros números primos

Dim Primos(1 to 10) as Integer
Primos(1) = 2
Primos(2) = 3
Primos(3) = 5
Primos(4) = 7
Primos(5) = 11
Primos(6) = 13
Primos(7) = 17
Primos(8) = 19
Primos(9) = 23
Primos(10) = 29

'Comenzamos a comprobar divisibilidad con los números primos
Dim Contador as Integer
Contador = 1

Dim Continuar as Booelan
Continuar = True
EsPrimo = True 'Suponemos inicialmente que el número es primo

Do While Continuar = True
If Numero Mod Primos(Contador) = 0 Then
Esprimo = False
Continuar = False
End if
If Primos(Contador) > Sqr(Numero) Then
Continuar = False
End if
Contador = Contador + 1
Loop

End Function



Sub Primos(NumPrimos() As Integer)

NumPrimos(1) = 2
Dim ContadorPrimos As Integer
ContadorPrimos = 1

Dim I as Integer

For I = 3 to 100
Dim Continuar, EsPrimo As Booelan
Dim Contador As Integer
Contador = 1
Continuar = True
EsPrimo = True
Do While Continuar = True
If I Mod NumPrimos(Contador) = 0 Then
Esprimo = False
Continuar = False
End if
If NumPrimos(Contador) > Sqr(I) Then
Continuar = False
End if
Loop
If EsPrimo = True Then
ContadorPrimos = ContadorPrimos + 1
End if
Next I

End Sub


Function AreaRectangulo (Diagonal As Single, Angulo As Single) As Single
'Convertirmos el Angulo de grados a radianes
Angulo = Angulo * 3,14159 / 180

AreaRectangulo = Diagonal * cos(Angulo) * Diagonal * sin(Angulo)

End Function

Sub PonerCeros(Datos() As Byte)

Dim I, J As Integer

For I = 1 to 5
For J = 1 to 10
Datos(I,J) = 0
Next J
Next I

End Sub


Function Moda(Datos() As Single) As Single

Dim Repeticiones1, Repeticiones2 I, J As Integer

Repeticiones1 = 0
Repeticiones2 = 0

For I = 1 to 10
Repeticiones1 = 0
For J = 1 to 10
If Datos(I) = Datos(J) Then
Repeticiones1 = Repeticiones1 + 1
End If
Next J
If Repeticiones1 > Repeticiones2 Then
Repeticiones2 = Repeticiones1
Moda = Datos(I)
End if
Next I

End Function

No hay comentarios: