fork(1) download
copy 
  1. set f(8) 142
  2. set f(7) 68
  3. set f(6) 33
  4. set f(5) 18
  5. set f(4) 9
  6. set f(3) 5
  7.  
  8. proc generate_gf {m} {
  9. 	global f
  10. 	set n [expr {(1 << $m) - 1}]
  11. 	set GF 1
  12. 	for {set i 0} {$i < $n} {incr i} {
  13. 		set GF_exp($i) $GF
  14. 		set GF_log($GF) $i
  15. 		set feedback [expr {($GF >> ($m - 1)) & 1}]
  16. 		if {$feedback != 0} {
  17. 			set GF [expr {$GF ^ $f($m)}]
  18. 		}
  19. 		set GF [expr {(($GF << 1) | $feedback) & $n}]
  20. 	}
  21. 	return [list [array get GF_exp] [array get GF_log] $m $n]
  22. }
  23.  
  24. proc gf_mul {a b GF} {
  25. 	array set GF_exp [lindex $GF 0]
  26. 	array set GF_log [lindex $GF 1]
  27. 	set n [lindex $GF 3]
  28. 	if {$a == 0 || $b == 0} {
  29. 		return 0
  30. 	}
  31. 	set sum [expr {($GF_log($a) + $GF_log($b)) % $n}]
  32. 	return $GF_exp($sum)
  33. }
  34.  
  35. proc gf_div {a b GF} {
  36. 	array set GF_exp [lindex $GF 0]
  37. 	array set GF_log [lindex $GF 1]
  38. 	set n [lindex $GF 3]
  39. 	if {$a == 0 || $b == 0} {
  40. 		return 0
  41. 	}
  42. 	set sub [expr {($GF_log($a) - $GF_log($b) + $n) % $n}]
  43. 	return $GF_exp($sub)
  44. }
  45.  
  46. proc gen_genpoly {t GF} {
  47. 	array set GF_exp [lindex $GF 0]
  48. 	set m [lindex $GF 2]
  49. 	set y 1
  50. 	for {set i 1} {$i <= 2 * $t} {incr i} {
  51. 		set ay {}
  52. 		for {set j 0} {$j < [llength $y]} {incr j} {
  53. 			lappend ay [gf_mul $GF_exp($i) [lindex $y $j] $GF]
  54. 		}
  55. 		set y [linsert $y 0 0]
  56. 		for {set j 0} {$j < [llength $ay]} {incr j} {
  57. 			set y [lreplace $y $j $j [expr {[lindex $ay $j] ^ [lindex $y $j]}]]
  58. 		}
  59. 	}
  60. 	return $y
  61. }
  62.  
  63. proc encode {d genpoly t GF} {
  64. 	set m [lindex $GF 2]
  65. 	set n [lindex $GF 3]
  66. 	set k [expr {$n - 2 * $t}]
  67. 	set data $d
  68. 	if {[llength $data] < $k} {
  69. 		set lz [expr {$k - [llength $data]}]
  70. 		for {set i 0} {$i < $lz} {incr i} {
  71. 			lappend data 0
  72. 		}
  73. 	}
  74. 	for {set i 0} {$i < [llength $genpoly] - 1} {incr i} {lappend reg 0}
  75. 	for {set i 0} {$i < $k} {incr i} {
  76. 		set new {}
  77. 		set data_in [lindex $data [expr {$k - 1 - $i}]]
  78. 		lappend d $data_in
  79. 		set feedback [expr {[lindex $reg [expr {2 * $t - 1}]] ^ $data_in}]
  80. 		lappend new [gf_mul $feedback [lindex $genpoly 0] $GF]
  81. 		for {set j 1} {$j < [expr {2 * $t}]} {incr j} {
  82. 			set mul [gf_mul $feedback [lindex $genpoly $j] $GF]
  83. 			lappend new [expr {$mul ^ [lindex $reg $j-1]}]
  84. 		}
  85. 		lset reg $new
  86. 	}
  87. 	return [concat $reg $data]
  88. }
  89.  
  90. proc decode {codeword genpoly t GF} {
  91. 	set m [lindex $GF 2]
  92. 	set n [lindex $GF 3]
  93. 	set k [expr {$n - 2 * $t}]
  94. 	array set GF_exp [lindex $GF 0]
  95. 	array set GF_log [lindex $GF 1]
  96.  
  97. 	# Вычисление синдрома
  98. 	for {set i 0} {$i <= [expr {2 * $t}]} {incr i} {set answer($i) 0}
  99. 	for {set i 1} {$i <= [llength $codeword]} {incr i} {
  100. 		set input [lindex $codeword [expr {$n - $i}]]
  101. 		for {set j 0} {$j < [expr {2 * $t}]} {incr j} {
  102. 			set answer($j) [expr {$input ^ [gf_mul $answer($j) $GF_exp([expr {$j + 1}]) $GF]}]
  103. 		}
  104. 	}
  105.  
  106. 	for {set j 0} {$j < [expr {2 * $t}]} {incr j} {
  107. 		#puts "S($j) = $answer($j)"
  108. 	}
  109.  
  110. 	# Вычисление полинома локаторов (методом Б-М)
  111. 	set Lambda 1
  112. 	set L 0
  113. 	set r 0
  114. 	set B 1
  115. 	while 1 {
  116. 		incr r
  117. 		# Вычисление ошибки в следующей компоненте синдрома
  118. 		set delta 0
  119. 		for {set i 0} {$i <= $L} {incr i} {
  120. 			set f [gf_mul [lindex $Lambda $i] $answer([expr {$r - $i - 1}]) $GF]
  121. 			set delta [expr {$delta ^ $f}]
  122. 		}
  123. 		# Генерирует ли существующий регистр сдвига следующую компоненту синдрома?
  124. 		if {$delta != 0} {
  125. 			# Вычислить новый многочлен связей, для которого delta = 0
  126. 			set xB [linsert $B 0 0]
  127. 			set T {}
  128. 			for {set i 0} {$i < [llength $xB]} {incr i} {
  129. 				set Li [lindex $Lambda $i]
  130. 				if {$Li == {}} {set Li 0}
  131. 				lappend T [expr {[gf_mul $delta [lindex $xB $i] $GF] ^ $Li}]
  132. 			}
  133. 			# Надо ли увеличивать длину регистра?
  134. 			if {[expr {2 * $L}] <= [expr {$r - 1}]} {
  135. 				# Сохранение прежнего регистра после нормализации
  136. 				set B {}
  137. 				for {set i 0} {$i < [llength $Lambda]} {incr i} {
  138. 					lappend B [gf_div [lindex $Lambda $i] $delta $GF]
  139. 				}
  140. 				# Модификация регистра сдвига
  141. 				set Lambda $T
  142. 				set L [expr {$r - $L}]
  143. 			} else {
  144. 				set Lambda $T
  145. 				set B [linsert $B 0 0]
  146. 			}
  147. 		} else {
  148. 			set B [linsert $B 0 0]
  149. 		}
  150. 		if {$r == [expr {2 * $t}]} break
  151. 	}
  152.  
  153. 	#puts "L(x) = $Lambda, L = $L"
  154.  
  155. 	if {$Lambda == 1} {
  156. 		return $codeword
  157. 	}
  158.  
  159. 	# Вычисление корней полинома локаторов
  160. 	set Lr {}
  161. 	for {set i 1} {$i <= $n} {incr i} {
  162. 		set L 0
  163. 		set aj 1
  164. 		for {set j 0} {$j < [llength $Lambda]} {incr j} {
  165. 			set L [gf_mul [expr {$L ^ [lindex $Lambda [expr {[llength $Lambda] - $j - 1}]]}] $i $GF]
  166. 		}
  167. 		if {$L == 0} {
  168. 			lappend U $GF_log([gf_div 1 $i $GF])
  169. 			lappend Lr $i
  170. 		}
  171. 	}
  172.  
  173. 	# Вычисление значений ошибок
  174. 	set msg_recov $codeword
  175.  
  176. 	set lambda_ {}
  177. 	for {set i 1} {$i <= [llength $U]} {incr i} {
  178. 		if {$i % 2 == 1} {
  179. 			lappend lambda_ [lindex $Lambda $i]
  180. 		} else {
  181. 			lappend lambda_ 0
  182. 		}
  183. 	}
  184.  
  185. 	set omega {}
  186. 	for {set q 0} {$q < [llength $U]} {incr q} {
  187. 		set OMi 0
  188. 		for {set i 0} {$i <= $q} {incr i} {
  189. 			set Li [lindex $Lambda [expr {$i}]]
  190. 			set Sqi $answer([expr {$q - $i}])
  191. 			set OMi [expr {$OMi ^ [gf_mul $Li $Sqi $GF]}]
  192. 		}
  193. 		lappend omega $OMi
  194. 	}
  195. 	foreach u $Lr {
  196. 		set A 0
  197. 		for {set i 1} {$i <= [llength $omega]} {incr i} {
  198. 			set A [expr {[lindex $omega [expr {[llength $omega] - $i}]] ^ [gf_mul $A $u $GF]}]
  199. 		}
  200. 		set B 0
  201. 		for {set i 1} {$i <= [llength $lambda_]} {incr i} {
  202. 			set B [expr {[lindex $lambda_ [expr {[llength $lambda_] - $i}]] ^ [gf_mul $B $u $GF]}]
  203. 		}
  204. 		set pos $GF_log([gf_div 1 $u $GF])
  205. 		set val [expr {[gf_div $A $B $GF] ^ [lindex $msg_recov $pos]}]
  206. 		set msg_recov [lreplace $msg_recov $pos $pos $val]
  207. 		puts "исправлено позиция $pos, число $val"
  208. 	}
  209. 	return [lreplace $msg_recov 0 [expr {2 * $t - 1}] ]
  210. }
  211.  
  212. proc print_multiplication_table {GF} {
  213. 	array set GF_exp [lindex $GF 0]
  214. 	array set GF_log [lindex $GF 1]
  215. 	set n [lindex $GF 3]
  216. 	for {set i 0} {$i <= $n} {incr i} {
  217. 		for {set j 0} {$j <= $n} {incr j} {
  218. 			puts "$i * $j = [gf_mul $i $j $GF]"
  219. 		}
  220. 	}
  221. }
  222.  
  223. set m 8
  224. set t 8
  225.  
  226. set GF [generate_gf $m]
  227. set genpoly [gen_genpoly $t $GF]
  228. puts "genpoly = $genpoly"
  229.  
  230. set M {122 222 43 74}
  231. puts "Message = $M"
  232.  
  233. set codeword [encode $M $genpoly $t $GF]
  234. puts "Кодовое слово"
  235. puts "$codeword\n"
  236.  
  237. # Вносим ошибку
  238. set codeword [lreplace $codeword 16 16 78]
  239. set codeword [lreplace $codeword 17 17 55]
  240. set codeword [lreplace $codeword 18 18 11]
  241. set codeword [lreplace $codeword 19 19 11]
  242. puts "Кодовое слово с внесенными ошибками"
  243. puts "$codeword\n"
  244.  
  245. # Декодируем.
  246. set decoded_msg [decode $codeword $genpoly $t $GF]
  247. puts "Исправленное сообщение"
  248. puts "$decoded_msg\n"
  249.  
Success #stdin #stdout 1.71s 15904KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
genpoly = 79 44 81 100 49 183 56 17 232 187 126 104 31 103 52 118 1
Message = 122 222 43 74
Кодовое слово
48 175 34 254 120 150 164 145 28 218 171 195 159 17 160 65 122 222 43 74 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

Кодовое слово с внесенными ошибками
48 175 34 254 120 150 164 145 28 218 171 195 159 17 160 65 78 55 11 11 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

исправлено позиция 17, число 222
исправлено позиция 16, число 122
исправлено позиция 18, число 43
исправлено позиция 19, число 74
Исправленное сообщение
122 222 43 74 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
https://ideone.com/O8s298
language:
TCL (tcl 8.6)
created:
8 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!