Chuyển số thập phân sang la mã và ngược lại

[vo_minhdat2007]

Tên chương trình: Chuyển số thập phân sang la mã và ngược lại
Ngôn ngữ lập trình: VB.NET
Tác giả: Sưu tầm
Chức năng: Cái tên nói lên tất cả

---

Mã: Chọn tất cả

Private Function ConvertToRoman(ByVal pstrDecimalNumber As String) As String        '--------------------------------------------------------------------------------------         Const strPOS_VAL As String = "IXCM"        Const strFIVE_VAL As String = "VLD"         Dim strRoman As String        Dim strCurrRomanPos As String        Dim strLetter1 As String        Dim strLetter2 As String        Dim intCurrPos As Integer        Dim intDigit As Integer        Dim intDigitPos As Integer         intCurrPos = 1        strRoman = ""         For intDigitPos = Len(pstrDecimalNumber) To 1 Step -1            intDigit = Val(Mid$(pstrDecimalNumber, intDigitPos, 1))            strCurrRomanPos = Mid$(strPOS_VAL, intCurrPos, 1)            Select Case intDigit                Case 9                    strLetter1 = strCurrRomanPos                    strLetter2 = Mid$(strPOS_VAL, intCurrPos + 1, 1)                Case Is > 4                    strLetter1 = Mid$(strFIVE_VAL, intCurrPos, 1)                    strLetter2 = New String(strCurrRomanPos, intDigit - 5)                Case 4                    strLetter1 = strCurrRomanPos                    strLetter2 = Mid$(strFIVE_VAL, intCurrPos, 1)                Case Else                    strLetter1 = New String(strCurrRomanPos, intDigit)                    strLetter2 = ""            End Select            strRoman = strLetter1 & strLetter2 & strRoman            intCurrPos = intCurrPos + 1        Next         ConvertToRoman = strRoman     End Function

Mã: Chọn tất cả

Private Function ConvertToDecimal(ByVal pstrRomanNumeral As String) As String        '--------------------------------------------------------------------------------------         Dim aintRomanValues() As Integer        Dim intInputLen As Integer        Dim intX As Integer        Dim intSum As Integer         intInputLen = Len(pstrRomanNumeral)         If intInputLen = 0 Then            ConvertToDecimal = 0            Exit Function        End If         ReDim aintRomanValues(intInputLen)         For intX = 1 To intInputLen            Select Case Mid$(pstrRomanNumeral, intX, 1)                Case "M" : aintRomanValues(intX) = 1000                Case "D" : aintRomanValues(intX) = 500                Case "C" : aintRomanValues(intX) = 100                Case "L" : aintRomanValues(intX) = 50                Case "X" : aintRomanValues(intX) = 10                Case "V" : aintRomanValues(intX) = 5                Case "I" : aintRomanValues(intX) = 1            End Select        Next         For intX = 1 To intInputLen            If intX = intInputLen Then                intSum = intSum + aintRomanValues(intX)            Else                If aintRomanValues(intX) >= aintRomanValues(intX + 1) Then                    intSum = intSum + aintRomanValues(intX)                Else                    intSum = intSum - aintRomanValues(intX)                End If            End If        Next         ConvertToDecimal = CStr(intSum)     End Function

[alexanderdna]

Tên chương trình: Chuyển đổi từ chữ số La Mã về chữ số Ả Rập
Ngôn ngữ lập trình: VB.NET
Tác giả: Đặng Nhật Anh
Chức năng: Như tên gọi, ngoài ra còn để trình bày thuật toán

---

Lâu lâu đi lạc vào đây, thấy chủ đề cũng khá thú vị, bèn suy nghĩ viết ra một hàm chuyển đổi.

Hàm chuyển đổi này kiểm tra tính chính xác của dãy số La Mã một cách khắc khe.
Trước hết, xin trình bày quy luật kiểm tra.
- Đánh chỉ số từ 0 tới 6 cho các ký tự trong dãy I, V, X, L, C, D, M.
- Gọi Cur là ký tự đang xét, Prev là ký tự vừa xét, PPrev là ký tự đứng trước Prev.
- Đặt H (hiệu số) = chỉ số của Cur - chỉ số của Prev.
Luật kiểm tra:
1. H không được lớn hơn 2.
2. Nếu H < 0 thì Cur phải khác PPrev HOẶC cả Cur, Prev và PPrev đều giống nhau.
3. Nếu H = 0 thì chỉ số của PPrev phải lớn hơn hoặc bằng chỉ số của Prev.
4. Nếu H = 1 thì chỉ số của Cur phải là số lẻ.
5. Nếu H = 2 thì chỉ số của Cur phải là số chẵn.

Mã: [Chọn tất cả] [Mở rộng/Thu hẹp]

1. ' Trả về -1 nếu gặp lỗi
2. Public Function Roman2Arabic(ByVal Roman As String) As Integer
3.     Roman = Roman.Trim.ToUpper
4.     If Roman.Length = 0 Then Return 0
5.    
6.     ' Không có ký tự nào lặp lại liên tục hơn 3 lần
7.     ' (do vậy không thể dùng kiểu cổ IIII)
8.     If Roman.Length > 3 Then
9.         Dim m As Char = ""
10.         Dim k As Integer = 1
11.         For Each n As Char In Roman.ToCharArray
12.             If m = n Then k += 1 Else k = 1
13.             If k > 3 Then Return -1 ' Báo lỗi
14.             m = n
15.         Next n
16.     End If
17.  
18.     Dim R As String = "IVXLCDM"
19.     Dim V() As Integer = {1, 5, 10, 50, 100, 500, 1000}
20.  
21.     Dim Prev As Char = "", PPrev As Char = ""
22.     Dim i As Integer = 0 ' Giá trị nguyên sẽ trả về
23.  
24.     For Each c As Char In Roman.ToCharArray
25.         Select Case c ' c là Cur
26.             Case "I"c, "V"c, "X"c, "L"c, "C"c, "D"c, "M"c ' Chỉ xét các ký tự này
27.                 ' Chỉ số của Cur
28.                 Dim IndexOfC As Integer = R.IndexOf(c)
29.                 ' Chỉ số của Prev (nếu Prev chưa có thì xem như bằng IndexOfC)
30.                 Dim IndexOfPrev As Integer = IIf(Prev = Nothing, IndexOfC, R.IndexOf(Prev))
31.                 Select Case IndexOfC - IndexOfPrev
32.                     Case Is < 0 ' Luật #2
33.                         If (c <> PPrev) Or (c = Prev And c = PPrev) Then
34.                             i += V(IndexOfC)
35.                         Else
36.                             Return -1 ' Báo lỗi
37.                         End If
38.                     Case 0 ' Luật #3
39.                         ' Nếu PPrev chưa có thì xem như chỉ số của PPrev bằng chỉ số của Cur
40.                         If IIf(PPrev = Nothing, IndexOfC, R.IndexOf(PPrev)) >= IndexOfC Then
41.                             i += V(IndexOfC)
42.                         Else
43.                             Return -1 ' Báo lỗi
44.                         End If
45.                     Case 1 ' Luật #4
46.                         If IndexOfC Mod 2 <> 0 Then ' Số lẻ
47.                             i = i + V(IndexOfC) - 2 * V(IndexOfPrev)
48.                         Else
49.                             Return -1 ' Báo lỗi
50.                         End If
51.                     Case 2 ' Luật #5
52.                         If IndexOfC Mod 2 = 0 Then ' Số chẵn
53.                             i = i + V(IndexOfC) - 2 * V(IndexOfPrev)
54.                         Else
55.                             Return -1 ' Báo lỗi
56.                         End If
57.                     Case Else ' Luật #1
58.                         Return -1 ' Báo lỗi
59.                 End Select
60.             Case Else
61.                 ' Ký tự không đúng
62.                 Return -1 ' Báo lỗi
63.         End Select
64.         PPrev = Prev
65.         Prev = c
66.     Next c
67.  
68.     Return i
69. End Function

GeSHi © Codebox Plus Extension

Dù có kiểm lỗi nhiều cách mấy cũng không tránh khỏi sơ xuất. Do đó rất mong mọi người giúp một tay.

[truongphu]

1- alexanderdna đã có ý đúng khi đặt tên chương trình là "Chuyển đổi từ La Mã về Ả Rập"; lẽ ra thêm từ "chữ số" thì chính xác hơn.
Khái niệm "thập phân" liên quan hệ đếm, và đương nhiên viết số theo chữ số la mã nhưng hệ đếm La mã vẫn là hệ thập phân
2- Thuật toán Chuyển đổi từ La Mã về Ả Rập của alexanderdna trông có vẻ "rườm rà" quá!
Thuật toán của lập trình cũng y chang cách đọc bình thường, có khác bình thường ở chổ:
* bình thường: Đọc trái sang phải, theo phép cọng. Đang từ số nhỏ chuyển qua số lớn thì ưu tiên làm phép trừ nhóm chuyển trước
vd1: XI = 10 + 1
vd2: XIX = 10 + (10 - 1)
* lập trình: (truongphu) đọc từ Phải sang Trái theo phép cọng
nếu số đọc nhỏ hơn số đã đọc liền trước (phải) thì mang dấu -
vd1: XI = 1 + 10
vd2: XIX = 10 + (-1) + 10

[Ta cũng có thể lập trình theo hướng trái sang phải theo phép cọng, nếu số đọc nhỏ hơn số kề sau thì mang dấu -]

alexanderdna nghĩ sao? Tôi đã viết code vb6 rất gọn

[xuanquy_th]

Mã: [Chọn tất cả] [Mở rộng/Thu hẹp]

1. Public Function NumeralsRoman(s As String) As Integer
2.     Dim arabic() As String, roman() As String, i1 As Integer
3.     arabic = Split("900,400,90,40,9,4,1000,500,100,50,10,5,1", ",")
4.     roman = Split("CM,CD,XC,XL,IX,IV,M,D,C,L,X,V,I", ",")
5.     For i1 = 0 To UBound(roman)
6.         s = Replace(UCase(s), roman(i1), arabic(i1) & "|")
7.     Next i1
8.     roman = Split(s, "|")
9.     For i1 = 0 To UBound(roman)
10.         NumeralsRoman = NumeralsRoman + Val(roman(i1))
11.     Next i1
12. End Function

GeSHi © Codebox Plus Extension

[alexanderdna]

Cảm ơn bác truongphu và anh xuanquy_th. Code của cả hai rất gọn và hữu dụng.

Gởi bác truongphu:
1. Dạ, đúng là con sơ xuất, phải ghi thêm "chữ số" mới phải đạo.
2. Lúc ban đầu con cũng có ý đọc từ phải sang trái như bác nói. Nhưng không hiểu sao rốt cuộc lại hướng thuật toán về chiều ngược lại.
- Lẽ cố nhiên, nếu muốn chuyển đổi số từ dạng La Mã về dạng Ả Rập, không nhứt thiết phải rườm rà như vậy.
- Song, ở đây con muốn trình bày song hành hai phương pháp chuyển đổi và kiểm tra. Trong đó, phần kiểm tra rất khắc khe, cố ý không bỏ sót một lỗi nào ở định dạng chuỗi số (theo 5 quy luật ghi ở trên).
- Lại nói, chuỗi số cần chuyển đổi, trong đại đa số trường hợp, là đúng định dạng (vì không phải do "tay mơ' viết ra). Do đó việc kiểm tra dường như hơi thừa thải.
-> Suy ra, đoạn mã bên trên không có tánh cách thực dụng, chỉ nhằm mục tiêu trình bày và cũng vì... ham vui.