0votos

Codigo de Hamming en Haskell

por josejuan hace 3 años

Es aplicar el método tal cual.

Hamming en C#

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
{- 
 
  Se implementa el código Hamming (7.4) extendido. 
 
  Cuatro bits para correción y detección de error por cada cuatro de datos. 
 
  La implementación tomará como entradas bytes y generará bytes (del doble de longitud). 
 
-} 
import Data.Bits 
import Data.Word 
import Test.QuickCheck 
 
-- Codificar una secuencia es codificar cada uno de sus elementos (bytes) 
stream2hamming :: [Word8] -> [Word8] 
stream2hamming = concatMap byte2hamming 
 
-- Codificar un byte a 7.4+1 es codificar por separado los dos nibbles afectados 
byte2hamming :: Word8 -> [Word8] 
byte2hamming w = map nibble2hamming [(a,b,c,d),(e,f,g,h)] where (a,b,c,d,e,f,g,h) = toBits w 
 
-- Las paridades de las posiciones hamming 
parities :: (Bool, Bool, Bool, Bool) -> (Bool, Bool, Bool) 
parities (d1,d2,d3,d4) = (fxor [d1,d2,d4], fxor [d1,d3,d4], fxor [d2,d3,d4]) 
 
-- Codificar un hamming es calcular directamente las paridades (parciales y la total) 
nibble2hamming :: (Bool, Bool, Bool, Bool) -> Word8 
nibble2hamming d@(d1,d2,d3,d4) = fromBits (p1,p2,d1,p3,d2,d3,d4,fxor [p1,p2,d1,p3,d2,d3,d4]) where (p1,p2,p3) = parities d 
 
-- Y ya sabemos codificar hamming 7.4+1 
 
 
 
 
-- Decodificar una secuencia puede dar errores (Left ~ error, Right ~ correcto) usando aplicative es mapear cada elemento 
hamming2stream :: [Word8] -> Either String [Word8] 
hamming2stream [ ] = Right [] 
hamming2stream [_] = Left "La secuencia contiene un número impar de bytes de entrada" 
hamming2stream (a:b:xs) = (:) <$> hamming2byte a b <*> hamming2stream xs 
 
-- Decodificar cada elemento es decodificar cada uno de los dos nibbles involucrados 
hamming2byte :: Word8 -> Word8 -> Either String Word8 
hamming2byte w x = do (a,b,c,d) <- hamming2nibble w 
                      (e,f,g,h) <- hamming2nibble x 
                      return $ fromBits (a,b,c,d,e,f,g,h) 
 
-- Decodificar un nibble es revisar los tres casos posibles de interés 
hamming2nibble :: Word8 -> Either String (Bool, Bool, Bool, Bool) 
hamming2nibble w = 
  case (fromBits (p1 /= b1, p2 /= b2, p3 /= b3, False,False,False,False,False), xb == fxor [p1,p2,d1,p3,d2,d3,d4]) of 
    (0, _    ) -> Right (d1,d2,d3,d4) 
    (i, False) -> Right (3 % d1,5 % d2,6 % d3,7 % d4) where u % b = (i == u) `xor` b 
    _          -> Left "Detectado error doble" 
  where (p1,p2,d1,p3,d2,d3,d4,xb) = toBits w 
        (b1,b2   ,b3            ) = parities (d1,d2,d3,d4) 
 
-- Y ya sabemos decodificar hamming 7.4+1 
 
 
 
 
-- Funciones auxiliares 
fxor :: Foldable t => t Bool -> Bool 
fxor = foldl1 xor 
 
fromBits :: (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool) -> Word8 
fromBits (a,b,c,d,e,f,g,h) = sum [ 1 `shiftL` i | (z, i) <- zip [a,b,c,d,e,f,g,h] [0..], z] 
 
toBits :: Word8 -> (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool) 
toBits w = (a,b,c,d,e,f,g,h) where [a,b,c,d,e,f,g,h] = map (testBit w) [0..7] 
 
 
 
 
 
-- === tests =========================== 
 
-- podemos realizar alteraciones sobre secuencias 
alterStream :: (Word8 -> Word8) -> [Word8] -> Bool 
alterStream t xs = Right xs == (hamming2stream . map t . stream2hamming) xs 
 
-- testear que sin cambio es correcto 
test1 = alterStream id 
 
-- testear que un cambio durante la transición hamming es corregido 
test2 n = alterStream (flip complementBit i) where i = abs n `mod` 8 
 
-- testear que dos cambios durante la transición hamming son detectados 
test3 n m xs = not (null xs) && i /= j ==> not $ alterStream (flip complementBit i . flip complementBit j) xs 
               where (i, j) = (abs n `mod` 8, abs m `mod` 8) 
 
 
 
{-- lanzar todos los test podría ser 
  > mapM_ ($ (stdArgs { maxSuccess = 1000 })) [flip quickCheckWith test1, flip quickCheckWith test2, flip quickCheckWith test3] 
  +++ OK, passed 1000 tests. 
  +++ OK, passed 1000 tests. 
  +++ OK, passed 1000 tests. 
 
-} 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.