STUDII DE CAZ – APLICAŢII
1. Să se determine toate numerele perechile de numere gemene pana la o anumita valoare n. Două numere sunt gemene dacă sunt ambele prime şi diferenţa dintre cel mai mare şi cel mai mic este 2.
Private Sub CommandButton1_Click()
Dim rad As Integer, n As Integer, p As Integer, i As Integer, j As Integer
cit_n "n = ", n
For i = 3 To n
p = 1
rad = Int(Sqr(i + 2))
For j = 2 To Int(rad)
If i Mod j = 0 Or (i + 2) Mod j = 0 Then
prim = 0
j = Int(rad)
End If
Next
If p Then
MsgBox "(" + Str$(i) + "," + Str$(i + 2) + ")" + Chr(13)
End If
Next
End Sub
2. Să se citească o valoare naturala n cu valori cuprinse intre 1 şi 100.
Sub cit_n(mes As String, nnn As Integer)
Do
nnn = InputBox(mes, y)
Loop Until n > 0 And n < 100
End Sub
3. Citirea unui vector cu n componente
Sub cit_date(mes As String, n As Integer, a As vector)
For i = 1 To n
a.v(i) = InputBox(mes + "(" + Str$(i) + ")=", y)
Next
End Sub
4. Tipărirea unui tablou cu n componente
Sub tipar(mes As String, n As Integer, a As vector)
sir = ""
For i = 1 To n
sir = sir + Str$(a.v(i)) + ","
Next
MsgBox mes + " " + sir
End Sub
5. Generarea permutărilor utilizănd metoda backtracking
Private Sub CommandButton14_Click()
cit_n "n = ", n
back_perm
End Sub
6. Generarea produsului cartezian a n mulţimi utilizând metoda backtracking
Private Sub CommandButton16_Click()
Dim a As vector
cit_n "n=", n
cit_date "a", n, a
tipar " multimile sunt : ", n, a
back_prod_cart
End Sub
7. Generarea permutărilor utilizănd metoda backtracking
Private Sub CommandButton17_Click()
cit_n "n = ", n
cit_n "p = ", p
back_aranj
End Sub
8. “Problema celor n dame” utilizănd metoda backtracking
Private Sub CommandButton15_Click()
cit_n "n = ", n
back
End Sub
9. Generarea combinărilor (de n luate câte m) utilizănd metoda backtracking
Private Sub CommandButton18_Click()
cit_n "n = ", n
cit_n "p = ", p
back_comb
End Sub
10. Generarea partiţiilor unei mulţimi utilizănd metoda backtracking
Private Sub CommandButton19_Click()
cit_n "n=", n
back_partitii
End Sub
11. Căutarea binară utilizând metoda “Divide et Impera” pentru sortarea unui şir de numere
Private Sub CommandButton2_Click()
Dim n As Integer, x As Integer, a As vector
cit_n "n = ", n
cit_date "a", n, a
tipar "sirul dat este : ", n, a
divimp 1, n, a
'MsgBox "Sirul a sortat este"
tipar "Sirul a sortat este", n, a
x = InputBox(" x = ", y)
st = 1
dr = n
l = True
While st <= dr And l = True
pp = (st + dr) / 2
If a.v(pp) = x Then
l = False
MsgBox "numarul x = " + Str$(x) + " se afla printre elementele vectorului a"
End If
If a.v(pp) < x Then
st = pp + 1
Else
dr = p - 1
End If
Wend
If l = True Then
MsgBox "numarul x = " + Str$(x) + " nu se fala in sir "
End If
End Sub
12. Realizarea unei subrutine pentru sortarea rapidă “Quicksort”
Sub sort(p As Integer, q As Integer, a As vector)
Dim m As Integer
If a.v(p) > a.v(q) Then
m = a.v(p)
a.v(p) = a.v(q)
a.v(q) = m
End If
End Sub
13. Sortarea “Merge-Sort” utilizând metoda “Divide et impera”
Sub interc(p As Integer, q As Integer, m As Integer, a As vector)
Dim b As vector, i, j, k As Integer
i = p
j = m + 1
k = 1
While (i <= m) And (j <= q)
If a.v(i) <= a.v(j) Then
b.v(k) = a.v(i)
i = i + 1
k = k + 1
Else
b.v(k) = a.v(j)
j = j + 1
k = k + 1
End If
Wend
If i <= m Then
For j = i To m
b.v(k) = a.v(j)
k = k + 1
Next
Else
For i = j To q
b.v(k) = a.v(i)
k = k + 1
Next
End If
k = 1
For i = p To q
a.v(i) = b.v(k)
k = k + 1
Next
End Sub
14. Sortarea rapidă utilizând metoda “Divide et impera”
Sub divimp(p As Integer, q As Integer, a As vector)
Dim m As Integer
If (q - p) <= 1 Then
sort p, q, a
Else
m = Int((p + q) / 2)
divimp p, m, a
divimp m + 1, q, a
interc p, q, m, a
End If
End Sub
15. Problema colorării hărţilor utilizând metoda backtracking
Private Sub CommandButton20_Click()
Dim mat As matrice
cit_n " n = ", n
cit_mat "a", n, n, mat
tipar_mat "a", n, n, mat
For i = 1 To n
For j = 1 To n
mat.m(j, i) = mat.m(i, j)
Next
Next
back_col
End Sub
16. Interclasarea a 2 şiruri ordonate crescător
Private Sub CommandButton3_Click()
Dim n As Integer, x As Integer, a As vector, m As Integer, b As vector, k As Integer, c As vector
cit_n "n = ", n
cit_date "a", n, a
tipar "sirul dat este : ", n, a
divimp 1, n, a
'MsgBox "Sirul a sortat este"
tipar "Sirul a sortat este", n, a
cit_n "m = ", m
cit_date "a", m, b
tipar "sirul dat este : ", m, b
divimp 1, m, b
'MsgBox "Sirul a sortat este"
tipar "Sirul b sortat este", m, b
i = 1
j = 1
k = 0
While i <= n And j <= m
If a.v(i) < b.v(j) Then
k = k + 1
c.v(k) = a.v(i)
i = i + 1
Else
If a.v(i) = b.v(j) Then
k = k + 1
c.v(k) = a.v(i)
i = i + 1
j = j + 1
Else
k = k + 1
c.v(k) = b.v(j)
j = j + 1
End If
End If
Wend
If i <= n Then
For l = i To n
k = k + 1
c.v(k) = a.v(l)
Next
End If
If j <= m Then
For l = j To m
k = k + 1
c.v(k) = b.v(l)
Next
End If
tipar "A U B = ", k, c
End Sub
17. Sortarea Shell-Sort utilizând metoda Greedy
Private Sub CommandButton4_Click()
Dim n As Integer, k As Integer, a As vector
cit_n "n = ", n
cit_date "a", n, a
tipar "sirul dat este : ", n, a
k = n
Do
k = k / 2
Do
b = 1
For i = 1 To n - k
If a.v(i) > a.v(i + k) Then
x = a.v(i)
a.v(i) = a.v(i + k)
a.v(i + k) = x
b = 0
End If
Next
Loop Until Not (b = 0)
Loop Until Not (k <> 1)
'MsgBox "Sirul a sortat este"
tipar "Sirul a sortat este", n, a
End Sub
18. Citirea si scrierea unei matrici pe ecran
Private Sub CommandButton5_Click()
Dim n As Integer, m As Integer, a As matrice, b As matrice, p As Integer, c As matrice
cit_n "n = ", n
cit_n "m = ", m
cit_mat "a", n, m, a
tipar_mat "a", n, m, a
End Sub
19. Citirea unei matrici de pe dispozitivul de intrare
Sub cit_mat(mes As String, n As Integer, m As Integer, a As matrice)
For i = 1 To n
For j = 1 To m
a.m(i, j) = InputBox(mes + "(" + Str$(i) + "," + Str$(j) + ")=", y)
Next
Next
End Sub
20. Scrierea unei matrici pe ecran
Sub tipar_mat(mes As String, n As Integer, m As Integer, a As matrice)
sir = mes + Chr(10)
For i = 1 To n
For j = 1 To m
sir = sir + Str$(a.m(i, j)) + " "
Next
sir = sir + Chr(10)
Next
MsgBox sir
End Sub
21. Produsul a două matrici
Private Sub CommandButton6_Click()
Dim n As Integer, m As Integer, a As matrice, b As matrice, p As Integer, c As matrice
cit_n "n = ", n
cit_n "m = ", m
cit_mat "a", n, m, a
tipar_mat "a", n, m, a
cit_n "p = ", p
'cit_n "m = ", m
cit_mat "b", m, p, b
tipar_mat "m", m, p, b
prod_mat n, m, p, a, b, c
tipar_mat "axb=", n, p, c
End Sub
Sub prod_mat(n As Integer, m As Integer, p As Integer, a As matrice, b As matrice, c As matrice)
For i = 1 To n
For j = 1 To p
c.m(i, j) = 0
For k = 1 To m
c.m(i, j) = c.m(i, j) + a.m(i, k) * b.m(k, j)
Next
Next
Next
End Sub
22. Programul principal pentru adunarea a două matrici
Private Sub CommandButton7_Click()
Dim n As Integer, m As Integer, a As matrice, b As matrice, p As Integer, c As matrice
cit_n "n = ", n
cit_n "m = ", m
cit_mat "a", n, m, a
tipar_mat "a", n, m, a
'cit_n "p = ", p
'cit_n "m = ", m
cit_mat "b", n, m, b
tipar_mat "b", n, m, b
ad_mat n, m, a, b, c
tipar_mat "a+b=", n, m, c
End Sub
23. Subrutina pentru adunarea a două matrici
Sub ad_mat(n As Integer, m As Integer, a As matrice, b As matrice, c As matrice)
For i = 1 To n
For j = 1 To m
c.m(i, j) = a.m(i, j) + b.m(i, j)
Next
Next
End Sub
24. Programul principal pentru scăderea a două matrici
Private Sub CommandButton8_Click()
Dim n As Integer, m As Integer, a As matrice, b As matrice, p As Integer, c As matrice
cit_n "n = ", n
cit_n "m = ", m
cit_mat "a", n, m, a
tipar_mat "a", n, m, a
'cit_n "p = ", p
'cit_n "m = ", m
cit_mat "b", n, m, b
tipar_mat "b", n, m, b
scad_mat n, m, a, b, c
tipar_mat "a-b=", n, m, c
End Sub
25. Subrutina pentru adunarea a două matrici
Sub scad_mat(n As Integer, m As Integer, a As matrice, b As matrice, c As matrice)
For i = 1 To n
For j = 1 To m
c.m(i, j) = a.m(i, j) - b.m(i, j)
Next
Next
End Sub
26. Programul principal pentru ridicarea unei matrici la o putere p
Private Sub CommandButton9_Click()
Dim n As Integer, m As Integer, a As matrice, b As matrice, p As Integer, c As matrice, k As Integer
'Sub scad_mat(n As Integer, m As Integer, a As matrice, b As matrice, c As matrice)
'const t as vector ={0,31,28,31,30,31,30,31,30,31,30,31,30}
cit_n "n = ", n
'cit_n "m = ", m
cit_mat "a", n, n, a
tipar_mat "a", n, n, a
cit_n "putere = ", k
'cit_n "m = ", m
'cit_mat "b", n, m, b
'tipar_mat "b", n, m, b
putere_mat n, a, k, c
tipar_mat "a^p=", n, n, c
End Sub
27. Subprogramul pentru ridicarea unei matrici la o putere p
Sub putere_mat(n As Integer, a As matrice, k As Integer, c As matrice)
Dim b As matrice, c1 As matrice
For i = 1 To n
For j = 1 To n
c.m(i, j) = 0
c1.m(i, j) = 0
Next
Next
For i = 1 To n
c.m(i, i) = 1
c1.m(i, i) = 1
Next
'Next
While k > 0
If k Mod 2 = 1 Then
prod_mat n, n, n, c1, a, c
End If
For i = 1 To n
For j = 1 To n
c1.m(i, j) = c.m(i, j)
'c1.m(i, j) = 0
Next
Next
prod_mat n, n, n, a, a, b
k = Int(k / 2)
For i = 1 To n
For j = 1 To n
a.m(i, j) = b.m(i, j)
'c1.m(i, j) = 0
Next
Next
Wend
For i = 1 To n
For j = 1 To n
c.m(i, j) = c1.m(i, j)
'c1.m(i, j) = 0
Next
Next
End Sub
28. Subrutina de iniţializare a stivei pentru metoda backtracking
Sub init(k As Integer, st As stiva)
st.ss(k) = 0
End Sub
29. Subrutina successor pentru “problema celor n dame”
Sub succesor(am_suc As Boolean, st As stiva, k As Integer)
If st.ss(k) < n Then
am_suc = True
st.ss(k) = st.ss(k) + 1
Else
am_suc = False
End If
End Sub
30. Subrutina successor pentru generarea combinărilor
Sub succesor_c(am_suc As Boolean, st As stiva, k As Integer)
If st.ss(k) < n - p + k Then
am_suc = True
st.ss(k) = st.ss(k) + 1
Else
am_suc = False
End If
End Sub
31. Subrutina succesor pentru problema “produsului cartezian a n mulţimi” utilizând metoda backtracking
Sub succesor_prod(am_suc As Boolean, st As stiva, k As Integer)
If st.ss(k) < a.v(k) Then
am_suc = True
st.ss(k) = st.ss(k) + 1
Else
am_suc = False
End If
End Sub
32. Subrutina successor pentru colorarea hărţilor
Sub succesor_col(am_suc As Boolean, st As stiva, k As Integer)
If st.ss(k) < 4 Then
am_suc = True
st.ss(k) = st.ss(k) + 1
Else
am_suc = False
End If
End Sub
33. Subrutina valid pentru “problema celor n dame”
Sub valid(ev As Boolean, st As stiva, k As Integer)
ev = True
For i = 1 To k - 1
If (st.ss(i) = st.ss(k)) Or (Abs(st.ss(i) - st.ss(k)) = Abs(k - i)) Then
ev = False
End If
Next
End Sub
34. Subrutina valid pentru colorarea hărţilor
Sub valid_col(ev As Boolean, st As stiva, k As Integer)
ev = True
For i = 1 To k - 1
If (st.ss(i) = st.ss(k)) And (mat.m(i, k) = 1) Then
ev = False
End If
Next
End Sub
Sub valid_c(ev As Boolean, st As stiva, k As Integer)
Dim i As Integer
ev = True
For i = 1 To k - 1
If (st.ss(i) = st.ss(k)) Then
ev = False
End If
Next
If k > 1 Then
If st.ss(k) < st.ss(k - 1) Then
ev = False
End If
End If
End Sub
35. Subrutina valid pentru “produs cartezian a n mulţimi”
Sub valid_prod(ev As Boolean, st As stiva, k As Integer)
ev = True
End Sub
36. Subrutina soluţie pentru generarea permutărilor
Function solutie(k As Integer) As Boolean
If k = n Then
solutie = True
Else
solutie = False
End If
End Function
37. Subrutina soluţie pentru generarea aranjamentelor sau combinărilor
Function solutie1(k As Integer) As Boolean
If k = p Then
solutie1 = True
Else
solutie1 = False
End If
End Function
38. Subrutina tipărire pentru “problema celor n dame”
Sub tiparr()
Dim i As Integer, b As String
b = " "
For i = 1 To n
b = b + "(" + Str$(i) + "," + Str$(st.ss(i)) + "),"
Next
MsgBox b
End Sub
39. Subrutina tipărire pentru “colorarea hărţilor”
Sub tipar_col()
Dim i As Integer, b As String
b = " "
For i = 1 To n
b = b + "Tara = " + Str$(i) + "; culoarea " + Str$(st.ss(i)) + " "
Next
MsgBox b
End Sub
40. Subrutina back pentru “problema celor n dame”
Sub back()
Dim k As Integer
k = 1
init k, st
While k > 0
Do
succesor am_suc, st, k
If am_suc = True Then
valid ev, st, k
End If
Loop Until (Not am_suc) Or (am_suc And ev)
If am_suc Then
If solutie(k) Then
tiparr
Else
k = k + 1
init k, st
End If
Else
k = k - 1
End If
Wend
End Sub
41. Programul principal pentru “problema celor n dame”
Sub Button2_Click()
n = InputBox("n=", ib_title)
back
End Sub
42. Subrutina back pentru “generarea permutărilor”
Sub back_perm()
Dim k As Integer
k = 1
init k, st
While k > 0
Do
succesor am_suc, st, k
If am_suc = True Then
valid1 ev, st, k
End If
Loop Until (Not am_suc) Or (am_suc And ev)
If am_suc Then
If solutie(k) Then
tipar_r
Else
k = k + 1
init k, st
End If
Else
k = k - 1
End If
Wend
End Sub
43. Subrutina back pentru “generarea aranjamentelor”
Sub back_aranj()
Dim k As Integer
k = 1
init k, st
While k > 0
Do
succesor am_suc, st, k
If am_suc = True Then
valid1 ev, st, k
End If
Loop Until (Not am_suc) Or (am_suc And ev)
If am_suc Then
If solutie1(k) Then
tipar_rr
Else
k = k + 1
init k, st
End If
Else
k = k - 1
End If
Wend
End Sub
44. Subrutina valid pentru metoda backtracking
Sub valid1(ev As Boolean, st As stiva, k As Integer)
ev = True
For i = 1 To k - 1
If (st.ss(i) = st.ss(k)) Then
ev = False
End If
Next
End Sub
45. Subrutina tipar pentru metoda backtracking
Sub tipar_r()
Dim i As Integer, b As String
b = " "
For i = 1 To n
b = b + Str$(st.ss(i)) + ","
Next
MsgBox b
End Sub
46. Subrutina tipar pentru metoda backtracking
Sub tipar_rr()
Dim i As Integer, b As String
b = " "
For i = 1 To p
b = b + Str$(st.ss(i)) + ","
Next
MsgBox b
End Sub
47. Subrutina back pentru “generarea combinărilor”
Sub back_comb()
Dim k As Integer
k = 1
init k, st
While k > 0
Do
succesor_c am_suc, st, k
If am_suc = True Then
valid_c ev, st, k
End If
Loop Until (Not am_suc) Or (am_suc And ev)
If am_suc Then
If solutie1(k) Then
tipar_rr
Else
k = k + 1
init k, st
End If
Else
k = k - 1
End If
Wend
End Sub
48. Subrutina back pentru “generarea produsului cartezian a n multimi”
Sub back_prod_cart()
Dim k As Integer
k = 1
init k, st
While k > 0
Do
succesor_prod am_suc, st, k
If am_suc = True Then
valid_prod ev, st, k
End If
Loop Until (Not am_suc) Or (am_suc And ev)
If am_suc Then
If solutie(k) Then
tipar_r
Else
k = k + 1
init k, st
End If
Else
k = k - 1
End If
Wend
End Sub
49. Subrutina back pentru “generarea partiţiilor unei mulţimi”
Sub back_partitii()
Dim k As Integer
k = 1
init k, st
While k > 0
Do
succesor_part am_suc, st, k
If am_suc = True Then
valid_prod ev, st, k
End If
Loop Until (Not am_suc) Or (am_suc And ev)
If am_suc Then
If solutie(k) Then
tipar_part
Else
k = k + 1
init k, st
End If
Else
k = k - 1
End If
Wend
End Sub
50. Subrutina tiparire pentru problema “generare partiţii” a unei mulţimi
Sub tipar_part()
Dim i As Integer, max As Integer, j As Integer, sir As String
sir = ""
max = st.ss(1)
For i = 2 To n
If max < st.ss(i) Then
max = st.ss(i)
End If
Next
sir = " PARTITII "
For j = 1 To max
For i = 1 To n
If st.ss(i) = j Then
sir = sir + Str$(i) + " "
End If
Next
sir = sir + Chr(10)
Next
MsgBox sir
End Sub
51. Subrutina succesor pentru problema “generare partiţii” a unei mulţimi
Sub succesor_part(am_suc As Boolean, st As stiva, k As Integer)
Dim i As Integer, max As Integer
If k = 1 Then
max = 1
Else
max = st.ss(1)
For i = 2 To k - 1
If max < st.ss(i) Then
max = st.ss(i)
End If
Next
End If
If st.ss(k) < max + 1 And st.ss(k) < k Then
am_suc = True
st.ss(k) = st.ss(k) + 1
Else
am_suc = False
End If
End Sub
52. Subrutina back pentru “colorarea hărţilor”
Sub back_col()
Dim k As Integer
k = 1
init k, st
While k > 0
Do
succesor_col am_suc, st, k
If am_suc = True Then
valid_col ev, st, k
End If
Loop Until (Not am_suc) Or (am_suc And ev)
If am_suc Then
If solutie(k) Then
tipar_col
Else
k = k + 1
init k, st
End If
Else
k = k - 1
End If
Wend
End Sub
Public s As String
53. Funcţia pentru a verifica dacă un număr natural n este prim sau nu
Function prim(n As Integer) As Boolean
b = True
For i = 2 To Int(Sqr(n))
If n Mod i = 0 Then
b = False
i = Int(Sqr(n))
End If
Next
prim = b
End Function
54. Programul principal pentru inversarea unui număr natural n
Sub buton1_Click()
Dim n As Integer, ninv As Integer, n1 As Integer, sir As String
Do
n = InputBox(" n = ", y)
Loop Until n > 0
n1 = n
ninv = 0
sir = ""
While n <> 0
sir = sir + LTrim(RTrim(Str$(n Mod 10)))
ninv = ninv * 10 + n Mod 10
n = Int(n / 10)
Wend
MsgBox " numarul initial este : " + Str$(n1) + " numarul inversat este: " + sir
End Sub
55. Algoritmul lui Euclid pentru calcularea CMMDC a două numere naturale pozitive
Private Sub Buton10_Click()
Dim a As Integer, b As Integer, c As Integer
Do
a = InputBox("a = ", y)
b = InputBox("b = ", y)
a1 = a
b1 = b
Loop Until a > 0 And b > 0 And a > b
c = euclid2(a, b)
If c = 1 Then
MsgBox " nr. sunt prime intre ele (" + Str$(a1) + "," + Str$(b1) + ")"
Else
MsgBox "Cmmdc (" + Str$(a1) + "," + Str$(b1) + ")=" + Str$(euclid2(a, b))
End If
End Sub
56. Sortarea unui sir cu n componente utilizând metoda bulelor
Private Sub Buton11_Click()
Dim n As Integer, a As vector
cit_n "n = ", n
cit_date "a", n, a
tipar "vectorul initial a este ", n, a
bule n, a
tipar "vectorul a sortat este : ", n, a
End Sub
57. Subrutina pentru sortarea prin metoda bulelor
Sub bule(n As Integer, a As vector)
Do
k = 0
For i = 1 To n - 1
If a.v(i) > a.v(i + 1) Then
x = a.v(i)
a.v(i) = a.v(i + 1)
a.v(i + 1) = x
k = 1
End If
Next
Loop Until k = 0
End Sub
58. Sortarea unui sir cu n componente utilizând metoda selecţiei directe
Private Sub Buton12_Click()
Dim n As Integer, a As vector
cit_n "n = ", n
cit_date "a", n, a
tipar "vectorul initial a este ", n, a
selectie n, a
tipar "vectorul a sortat este : ", n, a
End Sub
59. Subrutina pentru sortarea prin metoda selecţiei directe
Sub selectie(n As Integer, a As vector)
For i = 1 To n - 1
min = a.v(i)
k = i
For j = i + 1 To n
If min > a.v(j) Then
min = a.v(j)
k = j
End If
Next
If k <> i Then
x = a.v(i)
a.v(i) = a.v(k)
a.v(k) = x
End If
Next
End Sub
60. Sortarea unui sir cu n componente utilizând metoda prin numărare
Private Sub Buton14_Click()
Dim n As Integer, a As vector
cit_n "n = ", n
cit_date "a", n, a
tipar "vectorul initial a este ", n, a
numarare n, a
tipar "vectorul a sortat este : ", n, a
End Sub
61. Suma cifrelor unui număr natural dat n
Sub buton2_Click()
Dim n As Integer, s As Long, n1 As Integer
Do
n = InputBox(" n = ", y)
Loop Until n > 0
n1 = n
s = 0
While n <> 0
s = s + n Mod 10
n = Int(n / 10)
Wend
MsgBox " suma cifrelor numarului n = " + Str$(n1) + " este : " + Str$(s)
End Sub
62. Verificarea unui numar natural n daca este prim sau nu
Sub buton3_Click()
Dim n As Integer, s As Long, n1 As Integer
Do
n = InputBox(" n = ", y)
Loop Until n > 0
n1 = n
b = True
For i = 2 To Int(Sqr(n))
If n Mod i = 0 Then
b = False
i = Int(Sqr(n))
End If
Next
If b = True Then
MsgBox "numarul n = " + Str$(n) + " este prim"
Else
MsgBox "numarul n = " + Str$(n) + " nu este prim"
End If
End Sub
63. Determinarea numerelor prime mai mici sau egale cu n utilizând metoda directă
Sub buton4_Click()
Dim n As Integer, s As Long, n1 As Integer, i As Integer
Do
n = InputBox(" n = ", y)
Loop Until n > 0
n1 = n
If n = 2 Then
MsgBox "numerele prime sunt : 2"
Else
sir = "2,"
i = 3
While i <= n
If prim(i) = True Then
sir = sir + Str$(i) + ","
End If
i = i + 2
Wend
End If
MsgBox "numere prime sunt : " + sir
End Sub
64. Ciurul lui Eratostene
Sub buton5_Click()
Dim n As Integer, a As vector, sir As String
Do
n = InputBox(" n = ", y)
Loop Until n > 0
For i = 1 To n
a.v(i) = i
Next
For i = 2 To Int(Sqr(n))
If a.v(i) <> 0 Then
j = 2 * i
While j <= n
j = j + i
a.v(j) = 0
Wend
End If
Next
sir = ""
For i = 2 To n
If a.v(i) <> 0 Then
sir = sir + Str$(i) + ","
End If
Next
MsgBox "Numerele prime sunt : " + sir
End Sub
65. Descompunerea unui numar in factori primi
Sub buton6_Click()
Dim n As Integer, a As vector, sir As String, n1 As Integer
Do
n = InputBox(" n = ", y)
Loop Until n > 0
i = 2
n1 = n
l = 0
sir = ""
Do
fm = 0
While n Mod i = 0
fm = fm + 1
l = 1
n = Int(n / i)
Wend
If fm <> 0 Then
sir = sir + Str$(i) + "^" + Str$(fm) + "*"
End If
i = i + 1
Loop Until n = 1
If l = 0 Then
sir = Str$(n) + "^1"
End If
MsgBox Str$(n1) + "=" + sir
End Sub
66. Scrierea unui număr ca suma a două cuburi
Sub buton7_Click()
Dim n As Integer, a As vector, sir As String, n1 As Integer
Do
n = InputBox(" n = ", y)
Loop Until n > 0
n1 = n
For n = 1 To n1
Max = Int(n / 2)
nr = 0
For i = 1 To Max
For j = i To Max
If i * i * i + j * j * j = n Then
If nr = 0 Then
i1 = i
j1 = j
Else
i2 = i
j2 = j
End If
nr = nr + 1
End If
Next
Next
If nr > 1 Then
MsgBox Str$(n) + "=" + Str$(i1) + "^" + Str$(j1) + "+" + Str$(i2) + "^" + Str$(j2)
End If
Next
End Sub
67. CMMDC a două numere utilizând recursivitatea
Sub buton8_Click()
Dim a As Integer, b As Integer, c As Integer
Do
a = InputBox("a = ", y)
b = InputBox("b = ", y)
a1 = a
b1 = b
Loop Until a > 0 And b > 0 And a > b
c = euclid(a, b)
If c = 1 Then
MsgBox " nr. sunt prime intre ele (" + Str$(a1) + "," + Str$(b1) + ")"
Else
MsgBox "Cmmdc (" + Str$(a1) + "," + Str$(b1) + ")=" + Str$(euclid(a, b))
End If
End Sub
68. Funcţia euclid
Function euclid(a As Integer, b As Integer) As Integer
Dim r As Integer
Do
r = a Mod b
MsgBox r
a = b
b = r
Loop Until Not (r = 0 And r = 1)
If r = 1 Then
euclid = 1
Else
euclid = a
End If
End Function
69. CMMDC a două numere utilizând scăderi repetate
Private Sub Buton9_Click()
Dim a As Integer, b As Integer, c As Integer
Do
a = InputBox("a = ", y)
b = InputBox("b = ", y)
a1 = a
b1 = b
Loop Until a > 0 And b > 0 And a > b
c = euclid1(a, b)
If c = 1 Then
MsgBox " nr. sunt prime intre ele (" + Str$(a1) + "," + Str$(b1) + ")"
Else
MsgBox "Cmmdc (" + Str$(a1) + "," + Str$(b1) + ")=" + Str$(euclid1(a, b))
End If
End Sub
70. Funcţia Euclid utilizând scăderi repetate
Function euclid1(a As Integer, b As Integer) As Integer
If a > b Then
euclid1 = euclid1(a - b, b)
Else
If a < b Then
euclid1 = euclid1(a, b - a)
Else
euclid1 = a
End If
End If
End Function
71. Funcţia Euclid utilizând scăderi repetate
Function euclid2(a As Integer, b As Integer) As Integer
If b = 0 Then
euclid2 = a
Else
euclid2 = euclid2(b, a Mod b)
End If
End Function
72. x ^ y utilizând un număr minim de înmulţiri
Sub Button15_Click()
Dim x As Integer, y As Integer, z As Integer, t As String, bb As vector
Dim xx As Integer
Do
x = InputBox("a=", ib_title)
y = InputBox("b=", ib_title)
Loop Until (x > 0) And (y > 0) And (x >= y)
baza1 x, y, bb, xx
t = ""
MsgBox "n = " + Str$(xx)
For z = xx To 1 Step -1
t = t + Str$(bb.v(z))
Next
MsgBox t
End Sub
73. Verifică dacă un număr natural este palindrome sau nu
Sub Button16_Click()
Dim n As Long, m As Long
Do
n = InputBox("n=", ib_title)
Loop Until (n > 0)
m = n
If palindrom(n) = True Then
MsgBox "n=" + Str$(m) + " este plaindrom"
Else
MsgBox "n=" + Str$(m) + " nu este plaindrom"
End If
End Sub
74. Baza la exponent
Sub Button17_Click()
Dim x As Double, y As Byte, z As Double, t As Byte
Do
x = InputBox("baza=", ib_title)
y = InputBox("exponent=", ib_title)
Loop Until (x > 0) And (y > 0)
z = putere(x, y, t)
MsgBox Str$(z) + " " + Str$(t - 1)
End Sub
75. Quicksort
Sub Button18_Click()
Dim n As Integer, a As vector
cit_n "n = ", n
cit_date "a", n, a
'MsgBox "Sirul a este"
tipar "Sirul a este", n, a
divimp 1, n, a
'MsgBox "Sirul a sortat este"
tipar "Sirul a sortat este", n, a
End Sub
76. Minimul dintr-un şir de numere utilizând divide et impera
Sub Button19_Click()
Dim n As Integer, a As vector
cit_n "n=", n
cit_date "a", n, a
'MsgBox "Sirul a este"
tipar "sirul dat este ", n, a
MsgBox "minimul in Sirul a este" + Str$(minim(1, n))
End Sub
77. Turnurile din Hanoi
Sub Button20_Click()
Dim n As Integer, a As sir, b As sir, c As sir
d = ""
a.s = "A"
b.s = "B"
c.s = "C"
n = InputBox("n=", ib_title)
hanoi n, a, b, c
MsgBox d
End Sub
78. Subrutina Hanoi
Sub hanoi(n As Integer, a As sir, b As sir, c As sir)
If n = 1 Then
d = d + "(" + a.s + "->" + b.s + "),"
Else
hanoi n - 1, a, c, b
d = d + "(" + a.s + "->" + b.s + "),"
hanoi n - 1, c, b, a
End If
End Sub
79. Subrutina back pentru permutări
Sub back_perm()
Dim k As Integer
k = 1
init k, st
While k > 0
Do
succesor am_suc, st, k
If am_suc = True Then
valid1 ev, st, k
End If
Loop Until (Not am_suc) Or (am_suc And ev)
If am_suc Then
If solutie(k) Then
tipar_r
Else
k = k + 1
init k, st
End If
Else
k = k - 1
End If
Wend
End Sub
80. Calculul sumei 1-1,1-1-1,………….,1-1-1-1-1-1-1…….-1
Private Sub Buttton3_Click()
Dim n As Integer, ss As String
cit_n "n = ", n
ss = ""
i = 0
j = 1
While (i < n)
ss = ss + " 1"
i = i + 1
k = 1
While k <= j And i < n
ss = ss + " -1"
i = i + 1
k = k + 1
Wend
j = j + 1
Wend
MsgBox ss
End Sub
Bibliografie
-
Brassard, G., Bratley, P. “Algorithmics - Theory and Practice”, Prentice-Hall, Englewood Cliffs, 1988.
-
Cormen, T.H., Leiserson, C.E., Rivest, R.L. “Introduction to Algorithms”, The MIT Press, Cambridge, Masshusetts, 1992 (eighth printing).
-
Ellis, M., Stroustrup, B. “The Annotated C++ Reference Manual”, Addison-Wesley, Reading, 1991.
-
Graham, R.L., Knuth, D.E., Patashnik, O. “Concrete Mathematics”, Addison-Wesley, Reading, 1989.
-
Horowitz, E., Sahni, S. “Fundamentals of Computer Algorithms”, Computer Science Press, Rockville, 1978.
-
Knuth, D.E. “Tratat de programarea calculatoarelor. Algoritmi fundamentali”, Editura Tehnica, Bucuresti, 1974.
-
Knuth, D.E. “Tratat de programarea calculatoarelor. Sortare si cautare”, Editura Tehnica, Bucuresti, 1976.
-
Lippman, S. B. “C++ Primer”, Addison-Wesley, Reading, 1989.
-
Livovschi, L., Georgescu, H. “Sinteza si analiza algoritmilor”, Editura Stiintifica si Enciclopedica, Bucuresti, 1986.
-
Morariu N, Limbaje de programare, curs ID,2003
-
Sedgewick, R. “Algorithms”, Addison-Wesley, Reading, 1988.
-
Sedgewick, R. “Algorithms in C”, Addison-Wesley, Reading, 1990.
-
Sethi, R. “Programming Languages. Concepts and Constructs”, Addison-Wesley, Reading, 1989.
-
Smith, J.H. “Design and Analysis of Algorithms”, PWS-KENT Publishing Company, Boston, 1989.
-
Standish, T.A. “Data Structure Techniques”, Addison-Wesley, Reading, 1979.
-
Stroustrup, B. “The C++ Programming Language”, Addison-Wesley, Reading, 1991.
-
Stroustrup, B. “The Design and Evolution of C++”, Addison-Wesley, Reading, 1994.
-
http://thor.info.uaic.ro/~dlucanu/
Dostları ilə paylaş: |