Câu lạc bộ Visual Basic

.:: Nơi trao đổi về ngôn ngữ Visual Basic ::.
http://caulacbovb.com/forum/

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

http://caulacbovb.com/forum/viewtopic.php?f=57&t=8212

Trang 1 trên 1

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

Đã gửi: T.Sáu 10/07/2009 4:00 pm
gửi bở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ả :P


Mã: Chọn hết

  1. Private Function ConvertToRoman(ByVal pstrDecimalNumber As String) As String
  2.         '--------------------------------------------------------------------------------------
  3.  
  4.         Const strPOS_VAL As String = "IXCM"
  5.         Const strFIVE_VAL As String = "VLD"
  6.  
  7.         Dim strRoman As String
  8.         Dim strCurrRomanPos As String
  9.         Dim strLetter1 As String
  10.         Dim strLetter2 As String
  11.         Dim intCurrPos As Integer
  12.         Dim intDigit As Integer
  13.         Dim intDigitPos As Integer
  14.  
  15.         intCurrPos = 1
  16.         strRoman = ""
  17.  
  18.         For intDigitPos = Len(pstrDecimalNumber) To 1 Step -1
  19.             intDigit = Val(Mid$(pstrDecimalNumber, intDigitPos, 1))
  20.             strCurrRomanPos = Mid$(strPOS_VAL, intCurrPos, 1)
  21.             Select Case intDigit
  22.                 Case 9
  23.                     strLetter1 = strCurrRomanPos
  24.                     strLetter2 = Mid$(strPOS_VAL, intCurrPos + 1, 1)
  25.                 Case Is > 4
  26.                     strLetter1 = Mid$(strFIVE_VAL, intCurrPos, 1)
  27.                     strLetter2 = New String(strCurrRomanPos, intDigit - 5)
  28.                 Case 4
  29.                     strLetter1 = strCurrRomanPos
  30.                     strLetter2 = Mid$(strFIVE_VAL, intCurrPos, 1)
  31.                 Case Else
  32.                     strLetter1 = New String(strCurrRomanPos, intDigit)
  33.                     strLetter2 = ""
  34.             End Select
  35.             strRoman = strLetter1 & strLetter2 & strRoman
  36.             intCurrPos = intCurrPos + 1
  37.         Next
  38.  
  39.         ConvertToRoman = strRoman
  40.  
  41.     End Function


Mã: Chọn hết

  1. Private Function ConvertToDecimal(ByVal pstrRomanNumeral As String) As String
  2.         '--------------------------------------------------------------------------------------
  3.  
  4.         Dim aintRomanValues() As Integer
  5.         Dim intInputLen As Integer
  6.         Dim intX As Integer
  7.         Dim intSum As Integer
  8.  
  9.         intInputLen = Len(pstrRomanNumeral)
  10.  
  11.         If intInputLen = 0 Then
  12.             ConvertToDecimal = 0
  13.             Exit Function
  14.         End If
  15.  
  16.         ReDim aintRomanValues(intInputLen)
  17.  
  18.         For intX = 1 To intInputLen
  19.             Select Case Mid$(pstrRomanNumeral, intX, 1)
  20.                 Case "M" : aintRomanValues(intX) = 1000
  21.                 Case "D" : aintRomanValues(intX) = 500
  22.                 Case "C" : aintRomanValues(intX) = 100
  23.                 Case "L" : aintRomanValues(intX) = 50
  24.                 Case "X" : aintRomanValues(intX) = 10
  25.                 Case "V" : aintRomanValues(intX) = 5
  26.                 Case "I" : aintRomanValues(intX) = 1
  27.             End Select
  28.         Next
  29.  
  30.         For intX = 1 To intInputLen
  31.             If intX = intInputLen Then
  32.                 intSum = intSum + aintRomanValues(intX)
  33.             Else
  34.                 If aintRomanValues(intX) >= aintRomanValues(intX + 1) Then
  35.                     intSum = intSum + aintRomanValues(intX)
  36.                 Else
  37.                     intSum = intSum - aintRomanValues(intX)
  38.                 End If
  39.             End If
  40.         Next
  41.  
  42.         ConvertToDecimal = CStr(intSum)
  43.  
  44.     End Function

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

Đã gửi: CN 20/12/2009 1:01 pm
gửi bởi 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 hết] [Mở rộng/Thu hẹp] [Tải về]
  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


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.

Re: Chuyển đổi từ La Mã về Ả Rập

Đã gửi: CN 20/12/2009 7:57 pm
gửi bởi 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

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

Đã gửi: CN 20/12/2009 8:31 pm
gửi bởi xuanquy_th
Mã: [Chọn hết] [Mở rộng/Thu hẹp] [Tải về]
  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

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

Đã gửi: T.Hai 21/12/2009 8:24 am
gửi bởi 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.
Múi giờ UTC+07:00
Trang 1 trên 1
Powered by phpBB® Forum Software © phpBB Limited
https://www.phpbb.com/