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

Các mẹo vặt linh tinh không thuộc các nhóm trên

Các điều hành viên: tungcan5diop, QUANITGROBEST

Đăng trả lời
Hình đại diện của thành viên
vo_minhdat2007
Quản trị
Quản trị
Bài viết: 2227
Ngày tham gia: Chủ nhật 17/07/2005 1:40 am
Has thanked: 13 times
Been thanked: 87 times
Tiếp xúc:

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

Gửi bài by 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 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
Hình đại diện của thành viên
alexanderdna
Guru
Guru
Bài viết: 214
Ngày tham gia: Thứ 3 14/07/2009 11:13 am
Đến từ: Sài Gòn
Has thanked: 3 times
Been thanked: 15 times

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

Gửi bài by 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.


  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


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.
Sửa lần cuối bởi 1 vào ngày alexanderdna với 0 lần sửa trong tổng số.
Hình đại diện của thành viên
truongphu
VIP
VIP
Bài viết: 4785
Ngày tham gia: Chủ nhật 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 528 times

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

Gửi bài by 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
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
Hình đại diện của thành viên
xuanquy_th
Guru
Guru
Bài viết: 803
Ngày tham gia: Thứ 3 05/08/2008 9:15 pm
Đến từ: Thanh Hoá
Has thanked: 1 time
Been thanked: 10 times
Tiếp xúc:

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

Gửi bài by xuanquy_th »

  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
Khi Chúa Trời đóng cánh cửa này lại, Ngài sẽ mở một cánh cửa khác cho ta.
Nhưng ta thường nhìn quá lâu vào cánh cửa đã đóng nên không thấy được có một cánh cửa khác đang mở ra cho ta!!!
Hình đại diện của thành viên
alexanderdna
Guru
Guru
Bài viết: 214
Ngày tham gia: Thứ 3 14/07/2009 11:13 am
Đến từ: Sài Gòn
Has thanked: 3 times
Been thanked: 15 times

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

Gửi bài by 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.
Đăng trả lời

Quay về