1: #! /usr/bin/tcl 2: 3: proc gen_bf_ver1 {str} { 4: set ret "" 5: set min 255 6: set accum 0 7: for {set i 0} {$i < [string length $str]} {incr i} { 8: set char [string index $str $i] 9: set charval [ctype ord $char] 10: set accum [expr $accum + $charval] 11: if {$charval < $min} { 12: set min $charval 13: } 14: append ret "+" 15: if {($i+1) != [string length $str]} { 16: append ret ">" 17: } 18: } 19: 20: set meanval [expr $accum / [string length $str]] 21: 22: for {set i 1} {$i < [string length $str]} {incr i} { 23: append ret "<" 24: } 25: 26: append ret {[} 27: 28: append ret [replicate + [expr $meanval - 1]] 29: 30: append ret {>]} 31: 32: append ret "++++++++++" 33: for {set i 0} {$i < [expr [string length $str] + 0]} {incr i} { 34: append ret "<" 35: } 36: 37: for {set i 0} {$i < [expr [string length $str] + 0]} {incr i} { 38: set char [string index $str $i] 39: set charval [ctype ord $char] 40: set delta [expr $charval - $meanval] 41: if {$delta != 0} { 42: if {$delta < 0} { 43: set symbol - 44: } else { 45: set symbol + 46: } 47: append ret [replicate $symbol [expr abs($delta)]] 48: } 49: append ret ">" 50: } 51: 52: for {set i 0} {$i < [expr [string length $str] + 0]} {incr i} { 53: append ret "<" 54: } 55: 56: append ret {[.>]} 57: 58: return $ret 59: } 60: 61: proc gen_bf_ver2 {str} { 62: set ret "" 63: 64: set cellval 0 65: for {set i 0} {$i < [string length $str]} { incr i } { 66: set char [string index $str $i] 67: set charval [ctype ord $char] 68: set celldiff [expr $charval - $cellval] 69: if {$celldiff < 0} { 70: append ret [replicate - [expr abs($celldiff)]] 71: } elseif {$celldiff > 0} { 72: append ret [replicate + [expr abs($celldiff)]] 73: } 74: append ret "." 75: set cellval $charval 76: } 77: append ret {>++++++++++.} 78: 79: return $ret 80: } 81: 82: proc gen_bf_ver3 {str} { 83: set ret "" 84: 85: for {set i 0} {$i < [string length $str]} { incr i } { 86: set cellval($i) 0 87: } 88: 89: set cellpos 0 90: for {set i 0} {$i < [string length $str]} { incr i } { 91: set char [string index $str $i] 92: set charval [ctype ord $char] 93: 94: set mincelldiff 255 95: foreach cellcheck [lsort -integer [array names cellval]] { 96: set checkcelldiff [expr $charval - $cellval($cellcheck)] 97: if {abs($checkcelldiff) < abs($mincelldiff)} { 98: set mincelldiff $checkcelldiff 99: set newcellpos $cellcheck 100: } 101: } 102: 103: if {$newcellpos != $cellpos} { 104: if {$newcellpos > $cellpos} { 105: append ret [replicate > [expr $newcellpos - $cellpos]] 106: } else { 107: append ret [replicate < [expr $cellpos - $newcellpos]] 108: } 109: set cellpos $newcellpos 110: } 111: 112: set celldiff $mincelldiff 113: 114: if {$celldiff < 0} { 115: append ret [replicate - [expr abs($celldiff)]] 116: } elseif {$celldiff > 0} { 117: append ret [replicate + [expr abs($celldiff)]] 118: } 119: append ret "." 120: set cellval($cellpos) $charval 121: } 122: 123: return $ret 124: } 125: 126: proc gen_bf_ver4 {str} { 127: set ret "" 128: 129: 130: set sumval 0 131: set cnt 0 132: for {set i 0} {$i < [string length $str]} {incr i} { 133: 134: } 135: 136: # for {set i 0} {$i < 5} { incr i } { 137: # set cellval($i) 0 138: # } 139: set cellval(0) 0 140: set cellval(1) 32 141: set cellval(2) 64 142: set cellval(3) 96 143: set cellval(4) 128 144: append ret {++++++++++++++++++++++++++++++++[->+>++>+++>++++<<<<]} 145: 146: set cellpos 0 147: for {set i 0} {$i < [string length $str]} { incr i } { 148: set char [string index $str $i] 149: set charval [ctype ord $char] 150: 151: set mincelldiff 255 152: foreach cellcheck [lsort -integer [array names cellval]] { 153: set checkcelldiff [expr $charval - $cellval($cellcheck)] 154: if {abs($checkcelldiff) < abs($mincelldiff)} { 155: set mincelldiff $checkcelldiff 156: set newcellpos $cellcheck 157: } 158: } 159: 160: if {$newcellpos != $cellpos} { 161: if {$newcellpos > $cellpos} { 162: append ret [replicate > [expr $newcellpos - $cellpos]] 163: } else { 164: append ret [replicate < [expr $cellpos - $newcellpos]] 165: } 166: set cellpos $newcellpos 167: } 168: 169: set celldiff $mincelldiff 170: 171: if {$celldiff < 0} { 172: append ret [replicate - [expr abs($celldiff)]] 173: } elseif {$celldiff > 0} { 174: append ret [replicate + [expr abs($celldiff)]] 175: } 176: append ret "." 177: set cellval($cellpos) $charval 178: } 179: 180: return $ret 181: } 182: 183: proc gen_bf_ver5 {str} { 184: set ret "" 185: 186: 187: set sumval 0 188: set cnt 0 189: for {set i 0} {$i < [string length $str]} {incr i} { 190: set char [string index $str $i] 191: set charval [ctype ord $char] 192: 193: incr sumval $charval 194: incr cnt 195: } 196: set meanval [expr $sumval / $cnt] 197: 198: set sqrt_meanval [expr int(sqrt($meanval))] 199: 200: #v6 for {set i 0} {$i < 256} {incr i} { 201: #v6 set cellval($i) 0 202: #v6 } 203: for {set i 0} {$i < $sqrt_meanval} {incr i} { 204: set cellval([expr $i + 1]) [expr $i * $sqrt_meanval * 2] 205: } 206: 207: append ret {++[->} 208: append ret [replicate + $sqrt_meanval] 209: append ret {[-} 210: for {set i 1} {$i < $sqrt_meanval} {incr i} { 211: append ret >[replicate + $i] 212: } 213: append ret [replicate < [expr $sqrt_meanval - 1]] 214: append ret {]<]} 215: 216: set cellpos 0 217: for {set i 0} {$i < [string length $str]} { incr i } { 218: set char [string index $str $i] 219: set charval [ctype ord $char] 220: 221: set mincelldiff 255 222: foreach cellcheck [lsort -integer [array names cellval]] { 223: set posdiff 0 224: #v6 set posdiff [expr abs($cellcheck - $cellpos)] 225: set checkcelldiff [expr abs($charval - $cellval($cellcheck)) + $posdiff] 226: if {$checkcelldiff < $mincelldiff} { 227: set mincelldiff $checkcelldiff 228: set newcellpos $cellcheck 229: } 230: } 231: 232: set celldiff [expr $charval - $cellval($newcellpos)] 233: 234: if {$newcellpos != $cellpos} { 235: if {$newcellpos > $cellpos} { 236: append ret [replicate > [expr $newcellpos - $cellpos]] 237: } else { 238: append ret [replicate < [expr $cellpos - $newcellpos]] 239: } 240: set cellpos $newcellpos 241: } 242: 243: 244: if {$celldiff < 0} { 245: append ret [replicate - [expr abs($celldiff)]] 246: } elseif {$celldiff > 0} { 247: append ret [replicate + [expr abs($celldiff)]] 248: } 249: append ret "." 250: set cellval($cellpos) $charval 251: } 252: 253: return $ret 254: } 255: 256: proc gen_bf_ver6 {str} { 257: set ret "" 258: 259: set cellpos 0 260: set sumval 0 261: set cnt 0 262: 263: set sumval 0 264: set cnt 0 265: for {set i 0} {$i < [string length $str]} {incr i} { 266: set char [string index $str $i] 267: set charval [ctype ord $char] 268: 269: incr sumval $charval 270: incr cnt 271: } 272: set meanval [expr $sumval / $cnt] 273: set sqrt_meanval [expr int(sqrt($meanval))] 274: 275: set x 4 276: set y 5 277: append ret [replicate + $x] 278: append ret {[->} 279: append ret [replicate + $y] 280: append ret {<]>} 281: append ret {[->+>++>+++>++++>+++++>++++++>+++++++>++++++++>+++++++++>++++++++++>+[<<]>]} 282: set cellval(0) 0 283: set cellval(1) 0 284: for {set i 1} {$i < 11} {incr i} { 285: set cellval([expr $i + 1]) [expr $x * $y * $i] 286: } 287: set cellval(12) [expr $x * $y] 288: set cellval(13) 0 289: set cellval(14) 0 290: set cellval(15) 0 291: set cellpos 1 292: 293: for {set i 0} {$i < [string length $str]} { incr i } { 294: set char [string index $str $i] 295: set charval [ctype ord $char] 296: 297: set mincelldiff 255 298: foreach cellcheck [lsort -integer [array names cellval]] { 299: set posdiff [expr abs($cellcheck - $cellpos)] 300: set checkcelldiff [expr abs($charval - $cellval($cellcheck)) + $posdiff] 301: if {$checkcelldiff < $mincelldiff} { 302: set mincelldiff $checkcelldiff 303: set newcellpos $cellcheck 304: } 305: } 306: 307: set celldiff [expr $charval - $cellval($newcellpos)] 308: 309: if {$newcellpos != $cellpos} { 310: if {$newcellpos > $cellpos} { 311: append ret [replicate > [expr $newcellpos - $cellpos]] 312: } else { 313: append ret [replicate < [expr $cellpos - $newcellpos]] 314: } 315: set cellpos $newcellpos 316: } 317: 318: 319: if {$celldiff < 0} { 320: append ret [replicate - [expr abs($celldiff)]] 321: } elseif {$celldiff > 0} { 322: append ret [replicate + [expr abs($celldiff)]] 323: } 324: append ret "." 325: set cellval($cellpos) $charval 326: } 327: 328: return $ret 329: } 330: 331: proc gen_bf_ver7 {str} { 332: set meanval 90 333: append ret {>} 334: append ret [replicate + $meanval] 335: append ret {[->+>+>+>+>+>+>+>+>+>+>+[<<]>]} 336: set cellval(0) 0 337: set cellval(1) 0 338: for {set i 1} {$i < 11} {incr i} { 339: set cellval([expr $i + 1]) $meanval 340: } 341: set cellval(12) $meanval 342: set cellval(13) 0 343: set cellval(14) 0 344: set cellval(15) 0 345: set cellpos 1 346: return [replicate 0 10000] 347: } 348: 349: # RLE 350: proc gen_bf_ver8 {str} { 351: 352: set runlength 1 353: set foundrun 0 354: set workstr "" 355: set prevval "" 356: for {set i 0} {$i <= [string length $str]} {incr i} { 357: set currval [string index $str $i] 358: if {$currval == $prevval} { 359: incr runlength 360: } else { 361: if {$runlength > 3} { 362: set foundrun 1 363: while {$runlength > 0} { 364: if {$runlength > 255} { 365: set runlength_curr 255 366: } else { 367: set runlength_curr $runlength 368: } 369: incr runlength -$runlength_curr 370: 371: set workstr "$prevval[format %c%c $runlength_curr 0]$workstr" 372: } 373: } else { 374: set workstr "$prevval$workstr" 375: } 376: 377: set runlength 1 378: } 379: set prevval $currval 380: } 381: 382: if {!$foundrun} { 383: return [replicate 0 10000] 384: } 385: 386: # Termination marker 387: set ret ">>>" 388: 389: # Set values from "workstr" 390: for {set i 0} {$i < [string length $workstr]} {incr i} { 391: set currval [string index $workstr $i] 392: append ret [replicate + [ctype ord $currval]] 393: append ret ">" 394: } 395: 396: # Perform decompression 397: append ret {+[<[.<]<[-<.>]<]} 398: 399: return $ret 400: } 401: 402: proc factor_num {num} { 403: lappend factors 1 $num 404: for {set i 1} {$i < sqrt($num)} {incr i} { 405: set div [expr $num / $i] 406: if {($div * $i) == $num} { 407: lappend factors $div $i 408: } 409: } 410: 411: set minfactorsum 513 412: foreach {factora factorb} $factors { 413: set factorsum [expr $factora + $factorb] 414: if {$factorsum < $minfactorsum} { 415: set minfactorsum $factorsum 416: set retval [list $factora $factorb] 417: } 418: } 419: 420: return $retval 421: } 422: 423: proc optimize_bf {bfcode} { 424: set orig_bfcode $bfcode 425: 426: set bfcode [string map [list {><} {} {+-} {} {-+} {} {<>} {}] $bfcode] 427: 428: set firstplus [string first + $bfcode] 429: set firstminus [string first - $bfcode] 430: 431: if {$firstplus < $firstminus || $firstminus == -1 && $firstplus != -1} { 432: 433: set pluscnt 0 434: for {set i $firstplus} {$i < [string length $bfcode]} {incr i} { 435: set char [string index $bfcode $i] 436: if {$char == "+"} { 437: incr pluscnt 438: } else { 439: break 440: } 441: } 442: 443: set sqrt_pluscnt [expr int(sqrt($pluscnt))] 444: set sqr_factora $sqrt_pluscnt 445: set sqr_factorb $sqrt_pluscnt 446: set sqr_factor_size [expr ($sqr_factora + $sqr_factorb) + ($pluscnt - ($sqr_factora * $sqr_factorb))] 447: 448: set factorlist [factor_num $pluscnt] 449: set mul_factora [lindex $factorlist 0] 450: set mul_factorb [lindex $factorlist 1] 451: set mul_factor_size [expr $mul_factora + $mul_factorb] 452: 453: if {$sqr_factor_size < $mul_factor_size} { 454: set factora $sqr_factora 455: set factorb $sqr_factorb 456: set factorsize $sqr_factor_size 457: } else { 458: set factora $mul_factora 459: set factorb $mul_factorb 460: set factorsize $mul_factor_size 461: } 462: 463: 464: set newsize [expr 6 + $factorsize] 465: if {$newsize < $pluscnt} { 466: set newstr "" 467: append newstr [replicate + $factora] 468: append newstr {[->} 469: append newstr [replicate + $factorb] 470: append newstr {<]>} 471: append newstr [replicate + [expr $pluscnt - ($factora * $factorb)]] 472: if {[string length $newstr] == $newsize} { 473: append newstr [string range $bfcode [expr $firstplus + $pluscnt] end] 474: set bfcode [string range $bfcode 0 [expr $firstplus -1]]$newstr 475: } 476: } 477: } 478: 479: if {$bfcode != $orig_bfcode} { 480: return [optimize_bf $bfcode] 481: } else { 482: return $bfcode 483: } 484: } |