Commonmark migration

Source Link

edited Jun 17, 2020 at 9:04

1

#Mathematica, 343 bytes, 2573 characters

Mathematica, 343 bytes, 2573 characters

B=BitXor;t[a_]:={Mod[2a,256],⌊a/2⌋,a~B~1,a~B~128,0};w[a_,b_]:=Position[t@a,b][[1,1]];f=FindShortestPath[Graph[0~Range~255,e=Join@@Table[a#&/@({}⋃t@a),{a,m=c=0,255}],EdgeWeight(w@@#&/@e)],All,All];o="";u[a_,b_]:=(Do[o=o<>ToString[m=1-m],{If[a==b,6,a~w~f[a,b][[2]]]}];m=1-m);While[c~u~y;c!=y,c=f[c,y][[2]]]~Do~{y,ToCharacterCode@i};o

This is my first code competition. This program should generate the shortest possible program for any string. It effectively calculates a lookup table given the current state of the accumulator and the goal byte to find the shortest sequence of the five operations to get from any one to another, carrying the accumulator over characters and taking advantage of the size difference between instructions. Uses Mathematica 8's Graph infrastructure for calculating shortest paths (alternatives being to roll one's own or just embed the 256 x 256 table of instructions).

Ungolfed version (the first i = "..." line is also present, but not counted in the golfed version since it is the input):

i = "This is a string, meant to test the effectiveness of your program. Here are some special characters to make matters interesting: Æ Ø ß. How meta! :D";
B = BitXor;
t[a_] := {Mod[2 a, 256], Quotient[a, 2], B[a, 1], B[a, 128], 0}
w[a_, b_] := Position[t[a], b][[1, 1]]
g = Graph[Range[0, 255], 
  e = Join @@ Table[DirectedEdge[a, #] & /@ Union@t@a, {a, 0, 255}], 
  EdgeWeight -> (w @@ # & /@ e)];
f = FindShortestPath[g, All, All]; c = m = 0; o = "";
u[a_, b_] := (Do[
   o = o <> ToString[m = 1 - m], {If[a == b, 6, w[a, f[a, b][[2]]]]}];
   m = 1 - m);
Do[While[u[c, y]; c != y, c = f[c, y][[2]]], {y, ToCharacterCode[i]}];
o

Output:

10111101111011110101000010110010101101101010000010110010110010010101101111110101001011001011001001010111110100110100110110101001000000101011101001101101010000000101011011101110111110111011010100110010000101011001101110111010100100001000001001010110011011101110101000010001000011011010100110100110010101111111001101010010001000010001000010010101101110111101101010011001000010010101100110010001000100010101110111101010000001101010010110010110010110010101100100010000110110101000000000110010101101001101001101001101010001000001011001001010110100110110101001100100001010111111001010110100110100110100110101000011010100100000101100100101011011111010100110100110100110110101001101110101001010110010001001010111011111101110110101000100001000010101111001001010110100110010001010111101111011010100010001000010110010101111011111001001010110100110110101001010110111111010100100010000100010001000100101011111011101111001010110010000001010110111011101110111110110101001101001101001101010010001000010010101100110111011101010000001010111010011010011010100110111010100110100110100110110101000001000100001101101010000010001010110111111101101010011010011010011011010100110111110011010100000000110010101100101100101011010011011010100101100101011110010010101101111101010001011001001010110100110010001010111100100101011011111010100100010001000001000100101011001011001011001001010110010001001010110111011110110101001000001010110111011101111101110110101001101110101001101111100100101011101111110111011010100001000001001010111011111110110101001101001101001101010000000110010101100100001011001001010111101111101010000010110010010101101001100100010101101111111011010100110111011010100010000100001010111011111010011011010100101100101011011010100100000010101101001101001101001101010011011101111001001010111111111001101010010001000010001000010010101101111101101010011001101111011101101010000010000100101011011111010100100010000100010000100101011011111011010100101100110010000101011010100010000010110010010101101001101010010010101101111110101001011001011001001010110011011101110101000100001010111011111010011011010100101100101011110010010101101001101101010011001000010101111001001010110011011101110101000010001000011011010100001000101011111110010101100100010001011010100110111111010100010110011010011010010101111110011010100100001000100010001000100101101010001100100101011111111001101010011010011010100110111011101111010011011010100101100101011111111100110101001000100001000100001001010110111011110110101001011001100100001010111111010011011010100001100101011011010100100010001000010001010111110111101010

#Mathematica, 343 bytes, 2573 characters

B=BitXor;t[a_]:={Mod[2a,256],⌊a/2⌋,a~B~1,a~B~128,0};w[a_,b_]:=Position[t@a,b][[1,1]];f=FindShortestPath[Graph[0~Range~255,e=Join@@Table[a#&/@({}⋃t@a),{a,m=c=0,255}],EdgeWeight(w@@#&/@e)],All,All];o="";u[a_,b_]:=(Do[o=o<>ToString[m=1-m],{If[a==b,6,a~w~f[a,b][[2]]]}];m=1-m);While[c~u~y;c!=y,c=f[c,y][[2]]]~Do~{y,ToCharacterCode@i};o

This is my first code competition. This program should generate the shortest possible program for any string. It effectively calculates a lookup table given the current state of the accumulator and the goal byte to find the shortest sequence of the five operations to get from any one to another, carrying the accumulator over characters and taking advantage of the size difference between instructions. Uses Mathematica 8's Graph infrastructure for calculating shortest paths (alternatives being to roll one's own or just embed the 256 x 256 table of instructions).

Ungolfed version (the first i = "..." line is also present, but not counted in the golfed version since it is the input):

i = "This is a string, meant to test the effectiveness of your program. Here are some special characters to make matters interesting: Æ Ø ß. How meta! :D";
B = BitXor;
t[a_] := {Mod[2 a, 256], Quotient[a, 2], B[a, 1], B[a, 128], 0}
w[a_, b_] := Position[t[a], b][[1, 1]]
g = Graph[Range[0, 255], 
  e = Join @@ Table[DirectedEdge[a, #] & /@ Union@t@a, {a, 0, 255}], 
  EdgeWeight -> (w @@ # & /@ e)];
f = FindShortestPath[g, All, All]; c = m = 0; o = "";
u[a_, b_] := (Do[
   o = o <> ToString[m = 1 - m], {If[a == b, 6, w[a, f[a, b][[2]]]]}];
   m = 1 - m);
Do[While[u[c, y]; c != y, c = f[c, y][[2]]], {y, ToCharacterCode[i]}];
o

Output:

10111101111011110101000010110010101101101010000010110010110010010101101111110101001011001011001001010111110100110100110110101001000000101011101001101101010000000101011011101110111110111011010100110010000101011001101110111010100100001000001001010110011011101110101000010001000011011010100110100110010101111111001101010010001000010001000010010101101110111101101010011001000010010101100110010001000100010101110111101010000001101010010110010110010110010101100100010000110110101000000000110010101101001101001101001101010001000001011001001010110100110110101001100100001010111111001010110100110100110100110101000011010100100000101100100101011011111010100110100110100110110101001101110101001010110010001001010111011111101110110101000100001000010101111001001010110100110010001010111101111011010100010001000010110010101111011111001001010110100110110101001010110111111010100100010000100010001000100101011111011101111001010110010000001010110111011101110111110110101001101001101001101010010001000010010101100110111011101010000001010111010011010011010100110111010100110100110100110110101000001000100001101101010000010001010110111111101101010011010011010011011010100110111110011010100000000110010101100101100101011010011011010100101100101011110010010101101111101010001011001001010110100110010001010111100100101011011111010100100010001000001000100101011001011001011001001010110010001001010110111011110110101001000001010110111011101111101110110101001101110101001101111100100101011101111110111011010100001000001001010111011111110110101001101001101001101010000000110010101100100001011001001010111101111101010000010110010010101101001100100010101101111111011010100110111011010100010000100001010111011111010011011010100101100101011011010100100000010101101001101001101001101010011011101111001001010111111111001101010010001000010001000010010101101111101101010011001101111011101101010000010000100101011011111010100100010000100010000100101011011111011010100101100110010000101011010100010000010110010010101101001101010010010101101111110101001011001011001001010110011011101110101000100001010111011111010011011010100101100101011110010010101101001101101010011001000010101111001001010110011011101110101000010001000011011010100001000101011111110010101100100010001011010100110111111010100010110011010011010010101111110011010100100001000100010001000100101101010001100100101011111111001101010011010011010100110111011101111010011011010100101100101011111111100110101001000100001000100001001010110111011110110101001011001100100001010111111010011011010100001100101011011010100100010001000010001010111110111101010

Mathematica, 343 bytes, 2573 characters

B=BitXor;t[a_]:={Mod[2a,256],⌊a/2⌋,a~B~1,a~B~128,0};w[a_,b_]:=Position[t@a,b][[1,1]];f=FindShortestPath[Graph[0~Range~255,e=Join@@Table[a#&/@({}⋃t@a),{a,m=c=0,255}],EdgeWeight(w@@#&/@e)],All,All];o="";u[a_,b_]:=(Do[o=o<>ToString[m=1-m],{If[a==b,6,a~w~f[a,b][[2]]]}];m=1-m);While[c~u~y;c!=y,c=f[c,y][[2]]]~Do~{y,ToCharacterCode@i};o

This is my first code competition. This program should generate the shortest possible program for any string. It effectively calculates a lookup table given the current state of the accumulator and the goal byte to find the shortest sequence of the five operations to get from any one to another, carrying the accumulator over characters and taking advantage of the size difference between instructions. Uses Mathematica 8's Graph infrastructure for calculating shortest paths (alternatives being to roll one's own or just embed the 256 x 256 table of instructions).

Ungolfed version (the first i = "..." line is also present, but not counted in the golfed version since it is the input):

i = "This is a string, meant to test the effectiveness of your program. Here are some special characters to make matters interesting: Æ Ø ß. How meta! :D";
B = BitXor;
t[a_] := {Mod[2 a, 256], Quotient[a, 2], B[a, 1], B[a, 128], 0}
w[a_, b_] := Position[t[a], b][[1, 1]]
g = Graph[Range[0, 255], 
  e = Join @@ Table[DirectedEdge[a, #] & /@ Union@t@a, {a, 0, 255}], 
  EdgeWeight -> (w @@ # & /@ e)];
f = FindShortestPath[g, All, All]; c = m = 0; o = "";
u[a_, b_] := (Do[
   o = o <> ToString[m = 1 - m], {If[a == b, 6, w[a, f[a, b][[2]]]]}];
   m = 1 - m);
Do[While[u[c, y]; c != y, c = f[c, y][[2]]], {y, ToCharacterCode[i]}];
o

Output:

10111101111011110101000010110010101101101010000010110010110010010101101111110101001011001011001001010111110100110100110110101001000000101011101001101101010000000101011011101110111110111011010100110010000101011001101110111010100100001000001001010110011011101110101000010001000011011010100110100110010101111111001101010010001000010001000010010101101110111101101010011001000010010101100110010001000100010101110111101010000001101010010110010110010110010101100100010000110110101000000000110010101101001101001101001101010001000001011001001010110100110110101001100100001010111111001010110100110100110100110101000011010100100000101100100101011011111010100110100110100110110101001101110101001010110010001001010111011111101110110101000100001000010101111001001010110100110010001010111101111011010100010001000010110010101111011111001001010110100110110101001010110111111010100100010000100010001000100101011111011101111001010110010000001010110111011101110111110110101001101001101001101010010001000010010101100110111011101010000001010111010011010011010100110111010100110100110100110110101000001000100001101101010000010001010110111111101101010011010011010011011010100110111110011010100000000110010101100101100101011010011011010100101100101011110010010101101111101010001011001001010110100110010001010111100100101011011111010100100010001000001000100101011001011001011001001010110010001001010110111011110110101001000001010110111011101111101110110101001101110101001101111100100101011101111110111011010100001000001001010111011111110110101001101001101001101010000000110010101100100001011001001010111101111101010000010110010010101101001100100010101101111111011010100110111011010100010000100001010111011111010011011010100101100101011011010100100000010101101001101001101001101010011011101111001001010111111111001101010010001000010001000010010101101111101101010011001101111011101101010000010000100101011011111010100100010000100010000100101011011111011010100101100110010000101011010100010000010110010010101101001101010010010101101111110101001011001011001001010110011011101110101000100001010111011111010011011010100101100101011110010010101101001101101010011001000010101111001001010110011011101110101000010001000011011010100001000101011111110010101100100010001011010100110111111010100010110011010011010010101111110011010100100001000100010001000100101101010001100100101011111111001101010011010011010100110111011101111010011011010100101100101011111111100110101001000100001000100001001010110111011110110101001011001100100001010111111010011011010100001100101011011010100100010001000010001010111110111101010

golfing

Source Link

edited Nov 20, 2015 at 12:46

Mario Carneiro

408
3
8

#Mathematica, 375343 bytes, 2573 characters

B=BitXor;t[a_]:={Mod[2a,256],Quotient[a,2],B[a,1]⌊a/2⌋,B[aa~B~1,128]a~B~128,0};w[a_,b_]:=Position[t@a,b][[1,1]];g=Graph[Range[0,255],e=Join@@Table[DirectedEdge[a1]];f=FindShortestPath[Graph[0~Range~255,#]&e=Join@@Table[a#&/@Union@t@a@({}⋃t@a),{a,0m=c=0,255}],EdgeWeight->EdgeWeight(w@@#&/@e)];f=FindShortestPath[g],All,All];m=c=0;o="";u[a_All];o="";u[a_,b_]:=(Do[o=o<>ToString[m=1-m],{If[a==b,6,w[a,f[aa~w~f[a,b][[2]]]]b][[2]]]}];m=1-m);Do[While[c;While[c~u~y;c!=y,u[c,y];c=f[c,y][[2]]];u[c,c]c=f[c,y][[2]]]~Do~{y,ToCharacterCode@i}];o;o

This is my first code competition. This program should generate the shortest possible program for any string. It effectively calculates a lookup table given the current state of the accumulator and the goal byte to find the shortest sequence of the five operations to get from any one to another, carrying the accumulator over characters and taking advantage of the size difference between instructions. Uses Mathematica 8's Graph infrastructure for calculating shortest paths (alternatives being to roll one's own or just embed the 256 x 256 table of instructions).

Ungolfed version (the first i = "..." line is also present, but not counted in the golfed version since it is the input):

i = "This is a string, meant to test the effectiveness of your program. Here are some special characters to make matters interesting: Æ Ø ß. How meta! :D";
B = BitXor;
t[a_] := {Mod[2 a, 256], Quotient[a, 2], B[a, 1], B[a, 128], 0}
w[a_, b_] := Position[t[a], b][[1, 1]]
g = Graph[Range[0, 255], 
  e = Join @@ Table[DirectedEdge[a, #] & /@ Union@t@a, {a, 0, 255}], 
  EdgeWeight -> (w @@ # & /@ e)]; f = FindShortestPath[g, All, All];
f = FindShortestPath[g, All, All]; c = m = 0; o = "";
u[a_, b_] := (Do[
   o = o <> ToString[m = 1 - m], {If[a == b, 6, w[a, f[a, b][[2]]]]}];
   m = 1 - m);
Do[While[c != y, u[cDo[While[u[c, y]; c != f[cy, y][[2]]];c 
 = u[cf[c, c]y][[2]]], {y, ToCharacterCode[i]}];
o

Output:

10111101111011110101000010110010101101101010000010110010110010010101101111110101001011001011001001010111110100110100110110101001000000101011101001101101010000000101011011101110111110111011010100110010000101011001101110111010100100001000001001010110011011101110101000010001000011011010100110100110010101111111001101010010001000010001000010010101101110111101101010011001000010010101100110010001000100010101110111101010000001101010010110010110010110010101100100010000110110101000000000110010101101001101001101001101010001000001011001001010110100110110101001100100001010111111001010110100110100110100110101000011010100100000101100100101011011111010100110100110100110110101001101110101001010110010001001010111011111101110110101000100001000010101111001001010110100110010001010111101111011010100010001000010110010101111011111001001010110100110110101001010110111111010100100010000100010001000100101011111011101111001010110010000001010110111011101110111110110101001101001101001101010010001000010010101100110111011101010000001010111010011010011010100110111010100110100110100110110101000001000100001101101010000010001010110111111101101010011010011010011011010100110111110011010100000000110010101100101100101011010011011010100101100101011110010010101101111101010001011001001010110100110010001010111100100101011011111010100100010001000001000100101011001011001011001001010110010001001010110111011110110101001000001010110111011101111101110110101001101110101001101111100100101011101111110111011010100001000001001010111011111110110101001101001101001101010000000110010101100100001011001001010111101111101010000010110010010101101001100100010101101111111011010100110111011010100010000100001010111011111010011011010100101100101011011010100100000010101101001101001101001101010011011101111001001010111111111001101010010001000010001000010010101101111101101010011001101111011101101010000010000100101011011111010100100010000100010000100101011011111011010100101100110010000101011010100010000010110010010101101001101010010010101101111110101001011001011001001010110011011101110101000100001010111011111010011011010100101100101011110010010101101001101101010011001000010101111001001010110011011101110101000010001000011011010100001000101011111110010101100100010001011010100110111111010100010110011010011010010101111110011010100100001000100010001000100101101010001100100101011111111001101010011010011010100110111011101111010011011010100101100101011111111100110101001000100001000100001001010110111011110110101001011001100100001010111111010011011010100001100101011011010100100010001000010001010111110111101010

#Mathematica, 375 bytes, 2573 characters

B=BitXor;t[a_]:={Mod[2a,256],Quotient[a,2],B[a,1],B[a,128],0};w[a_,b_]:=Position[t@a,b][[1,1]];g=Graph[Range[0,255],e=Join@@Table[DirectedEdge[a,#]&/@Union@t@a,{a,0,255}],EdgeWeight->(w@@#&/@e)];f=FindShortestPath[g,All,All];m=c=0;o="";u[a_,b_]:=(Do[o=o<>ToString[m=1-m],{If[a==b,6,w[a,f[a,b][[2]]]]}];m=1-m);Do[While[c!=y,u[c,y];c=f[c,y][[2]]];u[c,c],{y,ToCharacterCode@i}];o

This is my first code competition. This program should generate the shortest possible program for any string. It effectively calculates a lookup table given the current state of the accumulator and the goal byte to find the shortest sequence of the five operations to get from any one to another, carrying the accumulator over characters and taking advantage of the size difference between instructions. Uses Mathematica 8's Graph infrastructure for calculating shortest paths (alternatives being to roll one's own or just embed the 256 x 256 table of instructions).

Ungolfed version (the first i = "..." line is also present, but not counted in the golfed version since it is the input):

i = "This is a string, meant to test the effectiveness of your program. Here are some special characters to make matters interesting: Æ Ø ß. How meta! :D";
B = BitXor;
t[a_] := {Mod[2 a, 256], Quotient[a, 2], B[a, 1], B[a, 128], 0}
w[a_, b_] := Position[t[a], b][[1, 1]]
g = Graph[Range[0, 255], 
  e = Join @@ Table[DirectedEdge[a, #] & /@ Union@t@a, {a, 0, 255}], 
  EdgeWeight -> (w @@ # & /@ e)]; f = FindShortestPath[g, All, All];
f = FindShortestPath[g, All, All]; c = m = 0; o = "";
u[a_, b_] := (Do[
   o = o <> ToString[m = 1 - m], {If[a == b, 6, w[a, f[a, b][[2]]]]}];
   m = 1 - m);
Do[While[c != y, u[c, y]; c = f[c, y][[2]]]; 
  u[c, c], {y, ToCharacterCode[i]}];
o

Output:

10111101111011110101000010110010101101101010000010110010110010010101101111110101001011001011001001010111110100110100110110101001000000101011101001101101010000000101011011101110111110111011010100110010000101011001101110111010100100001000001001010110011011101110101000010001000011011010100110100110010101111111001101010010001000010001000010010101101110111101101010011001000010010101100110010001000100010101110111101010000001101010010110010110010110010101100100010000110110101000000000110010101101001101001101001101010001000001011001001010110100110110101001100100001010111111001010110100110100110100110101000011010100100000101100100101011011111010100110100110100110110101001101110101001010110010001001010111011111101110110101000100001000010101111001001010110100110010001010111101111011010100010001000010110010101111011111001001010110100110110101001010110111111010100100010000100010001000100101011111011101111001010110010000001010110111011101110111110110101001101001101001101010010001000010010101100110111011101010000001010111010011010011010100110111010100110100110100110110101000001000100001101101010000010001010110111111101101010011010011010011011010100110111110011010100000000110010101100101100101011010011011010100101100101011110010010101101111101010001011001001010110100110010001010111100100101011011111010100100010001000001000100101011001011001011001001010110010001001010110111011110110101001000001010110111011101111101110110101001101110101001101111100100101011101111110111011010100001000001001010111011111110110101001101001101001101010000000110010101100100001011001001010111101111101010000010110010010101101001100100010101101111111011010100110111011010100010000100001010111011111010011011010100101100101011011010100100000010101101001101001101001101010011011101111001001010111111111001101010010001000010001000010010101101111101101010011001101111011101101010000010000100101011011111010100100010000100010000100101011011111011010100101100110010000101011010100010000010110010010101101001101010010010101101111110101001011001011001001010110011011101110101000100001010111011111010011011010100101100101011110010010101101001101101010011001000010101111001001010110011011101110101000010001000011011010100001000101011111110010101100100010001011010100110111111010100010110011010011010010101111110011010100100001000100010001000100101101010001100100101011111111001101010011010011010100110111011101111010011011010100101100101011111111100110101001000100001000100001001010110111011110110101001011001100100001010111111010011011010100001100101011011010100100010001000010001010111110111101010

#Mathematica, 343 bytes, 2573 characters

B=BitXor;t[a_]:={Mod[2a,256],⌊a/2⌋,a~B~1,a~B~128,0};w[a_,b_]:=Position[t@a,b][[1,1]];f=FindShortestPath[Graph[0~Range~255,e=Join@@Table[a#&/@({}⋃t@a),{a,m=c=0,255}],EdgeWeight(w@@#&/@e)],All,All];o="";u[a_,b_]:=(Do[o=o<>ToString[m=1-m],{If[a==b,6,a~w~f[a,b][[2]]]}];m=1-m);While[c~u~y;c!=y,c=f[c,y][[2]]]~Do~{y,ToCharacterCode@i};o

This is my first code competition. This program should generate the shortest possible program for any string. It effectively calculates a lookup table given the current state of the accumulator and the goal byte to find the shortest sequence of the five operations to get from any one to another, carrying the accumulator over characters and taking advantage of the size difference between instructions. Uses Mathematica 8's Graph infrastructure for calculating shortest paths (alternatives being to roll one's own or just embed the 256 x 256 table of instructions).

Ungolfed version (the first i = "..." line is also present, but not counted in the golfed version since it is the input):

i = "This is a string, meant to test the effectiveness of your program. Here are some special characters to make matters interesting: Æ Ø ß. How meta! :D";
B = BitXor;
t[a_] := {Mod[2 a, 256], Quotient[a, 2], B[a, 1], B[a, 128], 0}
w[a_, b_] := Position[t[a], b][[1, 1]]
g = Graph[Range[0, 255], 
  e = Join @@ Table[DirectedEdge[a, #] & /@ Union@t@a, {a, 0, 255}], 
  EdgeWeight -> (w @@ # & /@ e)];
f = FindShortestPath[g, All, All]; c = m = 0; o = "";
u[a_, b_] := (Do[
   o = o <> ToString[m = 1 - m], {If[a == b, 6, w[a, f[a, b][[2]]]]}];
   m = 1 - m);
Do[While[u[c, y]; c != y, c = f[c, y][[2]]], {y, ToCharacterCode[i]}];
o

Output:

10111101111011110101000010110010101101101010000010110010110010010101101111110101001011001011001001010111110100110100110110101001000000101011101001101101010000000101011011101110111110111011010100110010000101011001101110111010100100001000001001010110011011101110101000010001000011011010100110100110010101111111001101010010001000010001000010010101101110111101101010011001000010010101100110010001000100010101110111101010000001101010010110010110010110010101100100010000110110101000000000110010101101001101001101001101010001000001011001001010110100110110101001100100001010111111001010110100110100110100110101000011010100100000101100100101011011111010100110100110100110110101001101110101001010110010001001010111011111101110110101000100001000010101111001001010110100110010001010111101111011010100010001000010110010101111011111001001010110100110110101001010110111111010100100010000100010001000100101011111011101111001010110010000001010110111011101110111110110101001101001101001101010010001000010010101100110111011101010000001010111010011010011010100110111010100110100110100110110101000001000100001101101010000010001010110111111101101010011010011010011011010100110111110011010100000000110010101100101100101011010011011010100101100101011110010010101101111101010001011001001010110100110010001010111100100101011011111010100100010001000001000100101011001011001011001001010110010001001010110111011110110101001000001010110111011101111101110110101001101110101001101111100100101011101111110111011010100001000001001010111011111110110101001101001101001101010000000110010101100100001011001001010111101111101010000010110010010101101001100100010101101111111011010100110111011010100010000100001010111011111010011011010100101100101011011010100100000010101101001101001101001101010011011101111001001010111111111001101010010001000010001000010010101101111101101010011001101111011101101010000010000100101011011111010100100010000100010000100101011011111011010100101100110010000101011010100010000010110010010101101001101010010010101101111110101001011001011001001010110011011101110101000100001010111011111010011011010100101100101011110010010101101001101101010011001000010101111001001010110011011101110101000010001000011011010100001000101011111110010101100100010001011010100110111111010100010110011010011010010101111110011010100100001000100010001000100101101010001100100101011111111001101010011010011010100110111011101111010011011010100101100101011111111100110101001000100001000100001001010110111011110110101001011001100100001010111111010011011010100001100101011011010100100010001000010001010111110111101010

deleted 157 characters in body

Source Link

edited Nov 20, 2015 at 11:38

Mario Carneiro

408
3
8

#Mathematica, 382375 bytes, 27652573 characters

B=BitXor;t[a_]:={Mod[2a,256],Quotient[a,2],B[a,1],B[a,128],0};w[a_,b_]:=Position[t@a,b][[1,1]];g=Graph[Range[0,255],Flatten@Table[Property[DirectedEdge[a,#],EdgeWeight->w[ae=Join@@Table[DirectedEdge[a,#]]&#]&/@Union@t@a,{a,0,255}]];f=FindShortestPath[g],EdgeWeight->(w@@#&/@e)];f=FindShortestPath[g,All,All];c=m=0;o="";u[a_All];m=c=0;o="";u[a_,b_]:=(Do[o=o<>ToString[m=1-m],{If[a==b,6,w[a,f[a,b][[2]]]]}];m=1-m);Do[While[c!=y,u[c,y];c=f[c,y][[2]]];u[c,c],{y,ToCharacterCode@i}];o

This is my first code competition. This program should generate the shortest possible program for any string. It effectively calculates a lookup table given the current state of the accumulator and the goal byte to find the shortest sequence of the five operations to get from any one to another, carrying the accumulator over characters and taking advantage of the size difference between instructions. Uses Mathematica 8's Graph infrastructure for calculating shortest paths (alternatives being to roll one's own or just embed the 256 x 256 table of instructions).

Ungolfed version (the first i = "..." line is also present, but not counted in the golfed version since it is the input):

i = "This is a string, meant to test the effectiveness of your program. Here are some special characters to make matters interesting: Æ Ø ß. How meta! :D";
B = BitXor;
t[a_] := {Mod[2 a, 256], Quotient[a, 2], B[a, 1], B[a, 128], 0}
w[a_, b_] := Position[t[a], b][[1, 1]]
g = Graph[Range[0, 255], 
  e Flatten@Table[
= Join @@ Table[DirectedEdge[a, #] & Property[DirectedEdge[a/@ Union@t@a, #]{a, 0, 255}], 
  EdgeWeight -> w[a,(w #]]@@ # & /@ 
    e)]; f Union@t[a],= {aFindShortestPath[g, 0All, 255}]];All];
f = FindShortestPath[g, All, All]; c = m = 0; o = "";
u[a_, b_] := (Do[
   o = o <> ToString[m = 1 - m], {If[a == b, 6, w[a, f[a, b][[2]]]]}];
   m = 1 - m);
Do[While[c != y, u[c, y]; c = f[c, y][[2]]]; 
 u[c, c], {y, ToCharacterCode[i]}];
o

Output:

1010011001011001101001101010000101100101011011010100010000101100101100101011010110100110010101101001101001101101010001000010110010110010101101011010011001010110111010011010100010110010010101100101100101100101100100101011001101111010100110010001000101011011110111110110101001100100010001010110011010011010011011010100110100110010101101011010011001010110100110100110010110010110010101101110111101101010011001000010010101101001100101100101100101011101111010100000101101010010110010110010110010101100101100101100100101011010110100110010101101001101001101001101010001000010001011001010110100110110101001100100001010111110100101011010011010011010011010100010110101001000010001011001010110111110101001101001101001101101010011011101010010101100100010010101100110010110010110010101110111101111010100010010110101001011001101110101000010000100101011010011001011001011001010111101111011010010101101001101101010010101101011010011001010110100110100110011011101110110101001100101100101100101011010110100110010101110100110100110100110110101001101001101001101010010110011011101101010011001000100010101111110101000101100101100101011001000101011001011001011001001010110011010011010011011010100101100100101011001000010010110101001101001101001101101010011011110100110101001010010110011010100110100110101001011001001010110100110101000100101101010010000010101101110100110101001011001101110101000100101101010010000010101100101100101100101100100101011001011001011001001010110010001001010110111011110110101001000001010110010110010110010110010010101100100010101100100001001011010100110011010011010011010100001000001001010110101101001101001101101010011010011010011010100101001011001101010011011101110100110101000010000010101111011101001101010010110011011101010011011110110100101011001000100101011101111011110101000100001000101100101011010011010100100101011010110100110010101101001101001101001101010011010011010011011010100101001011001101010010110010110011010011010011010100100000100101011001011001101001101001101010000010000100101011011111010100101100101100110100110100110101001000001001010110100110011011110101001010111011110111010011010100101100101011011010100101001011001101010010110010110010010101100110111011101010001000010101110111101110100110101001011001010111011010010101101001101101010011001000010101110110100101011001101110111010100110010110010110010010101111011101010010100101100110101001101110111010010101101011010011001010111010011001011001011010100101001011001101010001011001011001011001101001101001001010110100110110101001010010110011010100110100110101001011001011001101001101001101101010010110010101101011010011001010110100110100110010110010110010101101110111101101010010110011001000010101101011010011010011011010100010110010101101101010010110010110010110011010100000100001010110111101111011110101000010110010101101101010000010110010110010010101101111110101001011001011001001010111110100110100110110101001000000101011101001101101010000000101011011101110111110111011010100110010000101011001101110111010100100001000001001010110011011101110101000010001000011011010100110100110010101111111001101010010001000010001000010010101101110111101101010011001000010010101100110010001000100010101110111101010000001101010010110010110010110010101100100010000110110101000000000110010101101001101001101001101010001000001011001001010110100110110101001100100001010111111001010110100110100110100110101000011010100100000101100100101011011111010100110100110100110110101001101110101001010110010001001010111011111101110110101000100001000010101111001001010110100110010001010111101111011010100010001000010110010101111011111001001010110100110110101001010110111111010100100010000100010001000100101011111011101111001010110010000001010110111011101110111110110101001101001101001101010010001000010010101100110111011101010000001010111010011010011010100110111010100110100110100110110101000001000100001101101010000010001010110111111101101010011010011010011011010100110111110011010100000000110010101100101100101011010011011010100101100101011110010010101101111101010001011001001010110100110010001010111100100101011011111010100100010001000001000100101011001011001011001001010110010001001010110111011110110101001000001010110111011101111101110110101001101110101001101111100100101011101111110111011010100001000001001010111011111110110101001101001101001101010000000110010101100100001011001001010111101111101010000010110010010101101001100100010101101111111011010100110111011010100010000100001010111011111010011011010100101100101011011010100100000010101101001101001101001101010011011101111001001010111111111001101010010001000010001000010010101101111101101010011001101111011101101010000010000100101011011111010100100010000100010000100101011011111011010100101100110010000101011010100010000010110010010101101001101010010010101101111110101001011001011001001010110011011101110101000100001010111011111010011011010100101100101011110010010101101001101101010011001000010101111001001010110011011101110101000010001000011011010100001000101011111110010101100100010001011010100110111111010100010110011010011010010101111110011010100100001000100010001000100101101010001100100101011111111001101010011010011010100110111011101111010011011010100101100101011111111100110101001000100001000100001001010110111011110110101001011001100100001010111111010011011010100001100101011011010100100010001000010001010111110111101010

#Mathematica, 382 bytes, 2765 characters

B=BitXor;t[a_]:={Mod[2a,256],Quotient[a,2],B[a,1],B[a,128],0};w[a_,b_]:=Position[t@a,b][[1,1]];g=Graph[Range[0,255],Flatten@Table[Property[DirectedEdge[a,#],EdgeWeight->w[a,#]]&/@Union@t@a,{a,0,255}]];f=FindShortestPath[g,All,All];c=m=0;o="";u[a_,b_]:=(Do[o=o<>ToString[m=1-m],{If[a==b,6,w[a,f[a,b][[2]]]]}];m=1-m);Do[While[c!=y,u[c,y];c=f[c,y][[2]]];u[c,c],{y,ToCharacterCode@i}];o

This is my first code competition. This program should generate the shortest possible program for any string. It effectively calculates a lookup table given the current state of the accumulator and the goal byte to find the shortest sequence of the five operations to get from any one to another, carrying the accumulator over characters and taking advantage of the size difference between instructions. Uses Mathematica 8's Graph infrastructure for calculating shortest paths (alternatives being to roll one's own or just embed the 256 x 256 table of instructions).

Ungolfed version (the first i = "..." line is also present, but not counted in the golfed version since it is the input):

i = "This is a string, meant to test the effectiveness of your program. Here are some special characters to make matters interesting: Æ Ø ß. How meta! :D";
B = BitXor;
t[a_] := {Mod[2 a, 256], Quotient[a, 2], B[a, 1], B[a, 128], 0}
w[a_, b_] := Position[t[a], b][[1, 1]]
g = Graph[Range[0, 255], 
   Flatten@Table[
     Property[DirectedEdge[a, #], EdgeWeight -> w[a, #]] & /@ 
      Union@t[a], {a, 0, 255}]];
f = FindShortestPath[g, All, All]; c = m = 0; o = "";
u[a_, b_] := (Do[
   o = o <> ToString[m = 1 - m], {If[a == b, 6, w[a, f[a, b][[2]]]]}];
   m = 1 - m);
Do[While[c != y, u[c, y]; c = f[c, y][[2]]]; 
 u[c, c], {y, ToCharacterCode[i]}];
o

Output:

10100110010110011010011010100001011001010110110101000100001011001011001010110101101001100101011010011010011011010100010000101100101100101011010110100110010101101110100110101000101100100101011001011001011001011001001010110011011110101001100100010001010110111101111101101010011001000100010101100110100110100110110101001101001100101011010110100110010101101001101001100101100101100101011011101111011010100110010000100101011010011001011001011001010111011110101000001011010100101100101100101100101011001011001011001001010110101101001100101011010011010011010011010100010000100010110010101101001101101010011001000010101111101001010110100110100110100110101000101101010010000100010110010101101111101010011010011010011011010100110111010100101011001000100101011001100101100101100101011101111011110101000100101101010010110011011101010000100001001010110100110010110010110010101111011110110100101011010011011010100101011010110100110010101101001101001100110111011101101010011001011001011001010110101101001100101011101001101001101001101101010011010011010011010100101100110111011010100110010001000101011111101010001011001011001010110010001010110010110010110010010101100110100110100110110101001011001001010110010000100101101010011010011010011011010100110111101001101010010100101100110101001101001101010010110010010101101001101010001001011010100100000101011011101001101010010110011011101010001001011010100100000101011001011001011001011001001010110010110010110010010101100100010010101101110111101101010010000010101100101100101100101100100101011001000101011001000010010110101001100110100110100110101000010000010010101101011010011010011011010100110100110100110101001010010110011010100110111011101001101010000100000101011110111010011010100101100110111010100110111101101001010110010001001010111011110111101010001000010001011001010110100110101001001010110101101001100101011010011010011010011010100110100110100110110101001010010110011010100101100101100110100110100110101001000001001010110010110011010011010011010100000100001001010110111110101001011001011001101001101001101010010000010010101101001100110111101010010101110111101110100110101001011001010110110101001010010110011010100101100101100100101011001101110111010100010000101011101111011101001101010010110010101110110100101011010011011010100110010000101011101101001010110011011101110101001100101100101100100101011110111010100101001011001101010011011101110100101011010110100110010101110100110010110010110101001010010110011010100010110010110010110011010011010010010101101001101101010010100101100110101001101001101010010110010110011010011010011011010100101100101011010110100110010101101001101001100101100101100101011011101111011010100101100110010000101011010110100110100110110101000101100101011011010100101100101100101100110101000001000010101

#Mathematica, 375 bytes, 2573 characters

B=BitXor;t[a_]:={Mod[2a,256],Quotient[a,2],B[a,1],B[a,128],0};w[a_,b_]:=Position[t@a,b][[1,1]];g=Graph[Range[0,255],e=Join@@Table[DirectedEdge[a,#]&/@Union@t@a,{a,0,255}],EdgeWeight->(w@@#&/@e)];f=FindShortestPath[g,All,All];m=c=0;o="";u[a_,b_]:=(Do[o=o<>ToString[m=1-m],{If[a==b,6,w[a,f[a,b][[2]]]]}];m=1-m);Do[While[c!=y,u[c,y];c=f[c,y][[2]]];u[c,c],{y,ToCharacterCode@i}];o

This is my first code competition. This program should generate the shortest possible program for any string. It effectively calculates a lookup table given the current state of the accumulator and the goal byte to find the shortest sequence of the five operations to get from any one to another, carrying the accumulator over characters and taking advantage of the size difference between instructions. Uses Mathematica 8's Graph infrastructure for calculating shortest paths (alternatives being to roll one's own or just embed the 256 x 256 table of instructions).

Ungolfed version (the first i = "..." line is also present, but not counted in the golfed version since it is the input):

i = "This is a string, meant to test the effectiveness of your program. Here are some special characters to make matters interesting: Æ Ø ß. How meta! :D";
B = BitXor;
t[a_] := {Mod[2 a, 256], Quotient[a, 2], B[a, 1], B[a, 128], 0}
w[a_, b_] := Position[t[a], b][[1, 1]]
g = Graph[Range[0, 255], 
  e = Join @@ Table[DirectedEdge[a, #] & /@ Union@t@a, {a, 0, 255}], 
  EdgeWeight -> (w @@ # & /@ e)]; f = FindShortestPath[g, All, All];
f = FindShortestPath[g, All, All]; c = m = 0; o = "";
u[a_, b_] := (Do[
   o = o <> ToString[m = 1 - m], {If[a == b, 6, w[a, f[a, b][[2]]]]}];
   m = 1 - m);
Do[While[c != y, u[c, y]; c = f[c, y][[2]]]; 
 u[c, c], {y, ToCharacterCode[i]}];
o

Output:

10111101111011110101000010110010101101101010000010110010110010010101101111110101001011001011001001010111110100110100110110101001000000101011101001101101010000000101011011101110111110111011010100110010000101011001101110111010100100001000001001010110011011101110101000010001000011011010100110100110010101111111001101010010001000010001000010010101101110111101101010011001000010010101100110010001000100010101110111101010000001101010010110010110010110010101100100010000110110101000000000110010101101001101001101001101010001000001011001001010110100110110101001100100001010111111001010110100110100110100110101000011010100100000101100100101011011111010100110100110100110110101001101110101001010110010001001010111011111101110110101000100001000010101111001001010110100110010001010111101111011010100010001000010110010101111011111001001010110100110110101001010110111111010100100010000100010001000100101011111011101111001010110010000001010110111011101110111110110101001101001101001101010010001000010010101100110111011101010000001010111010011010011010100110111010100110100110100110110101000001000100001101101010000010001010110111111101101010011010011010011011010100110111110011010100000000110010101100101100101011010011011010100101100101011110010010101101111101010001011001001010110100110010001010111100100101011011111010100100010001000001000100101011001011001011001001010110010001001010110111011110110101001000001010110111011101111101110110101001101110101001101111100100101011101111110111011010100001000001001010111011111110110101001101001101001101010000000110010101100100001011001001010111101111101010000010110010010101101001100100010101101111111011010100110111011010100010000100001010111011111010011011010100101100101011011010100100000010101101001101001101001101010011011101111001001010111111111001101010010001000010001000010010101101111101101010011001101111011101101010000010000100101011011111010100100010000100010000100101011011111011010100101100110010000101011010100010000010110010010101101001101010010010101101111110101001011001011001001010110011011101110101000100001010111011111010011011010100101100101011110010010101101001101101010011001000010101111001001010110011011101110101000010001000011011010100001000101011111110010101100100010001011010100110111111010100010110011010011010010101111110011010100100001000100010001000100101101010001100100101011111111001101010011010011010100110111011101111010011011010100101100101011111111100110101001000100001000100001001010110111011110110101001011001100100001010111111010011011010100001100101011011010100100010001000010001010111110111101010

added 552 characters in body

Source Link

edited Nov 20, 2015 at 11:03

Mario Carneiro

408
3
8

Loading

added 552 characters in body

Source Link

edited Nov 20, 2015 at 10:50

Mario Carneiro

408
3
8

Loading

Source Link

created Nov 20, 2015 at 10:41

Mario Carneiro

408
3
8

Loading

Stack Exchange Network

Return to Answer

Mathematica, 343 bytes, 2573 characters

Mathematica, 343 bytes, 2573 characters