Skip to content

Instantly share code, notes, and snippets.

@luser-dr00g

luser-dr00g/apl.ps

Last active August 29, 2015 13:57
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save luser-dr00g/9382217 to your computer and use it in GitHub Desktop.
Save luser-dr00g/9382217 to your computer and use it in GitHub Desktop.
Download ZIP
APL-like calculations in Postscript. Intended to help (me, a human) interpret the J and APL answers to http://codegolf.stackexchange.com/questions/12103/generate-a-universal-binary-function-lookup-table
Raw
apl.ps
/i{[1 1 4 3 roll {} for ]}def
%10 i == %[1 2 3 4 5 6 7 8 9 10]
/+{
dup type /arraytype eq { % ? []
1 index type /arraytype eq { % [] []
2 copy length exch length ne {
2 copy length exch length exch lt { exch } if % now nA > nB
2 copy length exch length exch sub % A B nA-nB
[ 3 2 roll % A nA-nB [ B
{} forall % A nA-nB [ ... Bn
counttomark 2 add -1 roll % A [ ... Bn nA-nB
{0} repeat % A [ ... Bn 0^nA-nB
]
} if
[ 3 1 roll % [ [] []
0 1 3 index length 1 sub { % [ ... A B i
2 copy get % [ ... A B i B_i
3 index 2 index get % [ ... A B i B_i A_i
+ % [ ... A B i B_i+A_i
4 1 roll pop % [ ... B_i+A_i A B
} for % [ ... B_i+A_i A B
pop pop
]
}{ % s []
[ 3 1 roll % [ s []
{ % [ ... s A_i
1 index add % [ ... s A_i+s
exch % [ ... A_i+s s
} forall
pop % [ ... A_i+s
]
} ifelse
}{ % ? s
add
} ifelse
}def
/*{
dup type /arraytype eq { % ? []
1 index type /arraytype eq { % [] []
2 copy length exch length ne {
2 copy length exch length exch lt { exch } if % now nA > nB
2 copy length exch length exch sub % A B nA-nB
[ 3 2 roll % A nA-nB [ B
{} forall % A nA-nB [ ... Bn
counttomark 2 add -1 roll % A [ ... Bn nA-nB
{0} repeat % A [ ... Bn 0^nA-nB
]
} if
[ 3 1 roll % [ [] []
0 1 3 index length 1 sub { % [ ... A B i
2 copy get % [ ... A B i B_i
3 index 2 index get % [ ... A B i B_i A_i
* % [ ... A B i B_i+A_i
4 1 roll pop % [ ... B_i+A_i A B
} for % [ ... B_i+A_i A B
pop pop
]
}{ % s []
[ 3 1 roll % [ s []
{ % [ ... s A_i
1 index mul % [ ... s A_i+s
exch % [ ... A_i+s s
} forall
pop % [ ... A_i+s
]
} ifelse
}{ % ? s
mul
} ifelse
}def
%5 i 10 i + ==
%-1 16 i +
%==
/@{ %order reversal
[ exch
dup length 1 sub -1 0 { % [ ... A i
2 copy get % [ ... A i A_i
3 1 roll pop % [ ... A_i A
} for % [ ... A_i A
pop
]
}def
%10 i @ ==
/,{ %compression [] []
1 index xcheck { % {} []
[ 3 1 roll % [ {A} B
{ % [ ... {A} B_i
2 copy exch % [ ... {A} B_i B_i {A}
exec { % [ ... {A} B_i
exch % [ ... B_i {A}
}{
pop % [ ... {A}
} ifelse
} forall
pop
]
}{
[ 3 1 roll % [ A B
exch % [ B A
0 1 2 index length 1 sub % [ B A 0 1 nA-1
{ % [ ... B A i
2 copy get % [ ... B A i A_i
%pstack()=
0 ne { % [ ... B A i
2 index exch get % [ ... B A B_i
3 1 roll % [ ... B_i B A
}{
pop % [ ... B A
} ifelse
} for
pop pop
]
} ifelse
}def
%[0 1 0 1] 10 i , ==
%{2 mod 0 eq} 10 i , ==
%{2 mod 1 eq} 10 i , ==
/+,{ %plus over
[ exch % [ A
0 exch { % [ 0 A_i
+
} forall
]
}def
/*,{ %mul over
[ exch % [ A
1 exch { % [ 1 A_i
mul
} forall
]
}def
/^{ %exp s A
[ 3 1 roll % [ s A
{ % [ ... s A_i
2 copy exp % [ ... s A_i s^A_i
3 1 roll pop % [ ... s^A_i s
} forall
pop
]
}def
%10 i +, ==
%0 1 10 { i +, == } for
%10 i *, ==
%0 1 10 { i *, == } for
/P{ %polynomial C x
1 index length i -1 exch + ^ * +,
}def
%[4 6 3 0 5] 2 P ==
/#:{ % to binary
dup 0 exch { 2 copy lt {exch} if pop } forall % A maxA
ln 3 ln div ceiling cvi % A maxdigitA
[ 3 1 roll % [ A m
exch % [ m A
{ % [ ... m A_i
[ exch % [ ... m [ A_i
2 index -1 0 { % [ ... m [ ... A_i m'
2 copy % [ ... m [ ... A_i m' A_i m'
neg bitshift 1 and % [ ... m [ ... A_i m' A_i>>-m'
exch pop exch % [ ... m [ ... A_i>>-m' A_i
} for
pop
] % [ ... m []
exch % [ ... [] m
}forall
pop % [ ... []
]
}def
%-1 8 i + #: ==
%-1 16 i + #: {==}forall
/|:{ % transpose A
<< /ind 2 index length 1 sub >> begin
[ exch % [ A
0 1 2 index 0 get length 1 sub % [ A 0 1 nA-1
{ % [ ... A i
[ 3 1 roll % [ ... [ A i
0 1 ind { % [ ... [ ... A i j
3 copy % [ ... [ ... A i j A i j
exch % [ ... [ ... A i j A j i
3 1 roll % [ ... [ ... A i j i A j
get exch get % [ ... [ ... A i j A_j_i
4 1 roll pop % [ ... [ ... A_j_i A i
} for
pop % [ ... [ ... A_j_i A
counttomark 1 add 1 roll % [ ... A [ ... A_j_i
] exch % [ ... [] A
} for
pop % [ ... []
] % [ ... [] ]
end
}def
%-1 16 i + #: |: {==}forall
/|.{ %reverse A
[ exch % [ A
dup length 1 sub -1 0 { % [ A i
2 copy get 3 1 roll pop % [ ... A_i A
} for
pop
]
}def
/2|{ %remainder after dividing by two
dup type /arraytype eq {
[ exch
{
2|
} forall
]
}{
cvi 2 mod
}ifelse
}def
/op{ %apply unary proc to array A proc
1 index type /arraytype eq {
[ 3 1 roll % [ A proc
exch % [ proc A
{ % [ ... proc A_i
1 index op % [ ... proc A_i'
exch % [ ... A_i' proc
}forall
pop
]
}{
exec
} ifelse
}def
%-1 16 i + #: |: |.{{==only}forall()=}forall
-1 16 i + % [0 .. 15]
2 -1 4 i + ^ % [0 .. 15] [2^0 2^1 2^2 2^3]
%[exch{1 exch div}forall] %dup == % [0 .. 15] [1/2^0 1/2^1 1/2^2 1/2^3]
{1 exch div}op dup ==
[3 1 roll{1 index * exch}forall pop] %dup ==
%exch *
dup ==
% [[0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0]
% [0.0 0.5 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5 5.0 5.5 6.0 6.5 7.0 7.5]
% [0.0 0.25 0.5 0.75 1.0 1.25 1.5 1.75 2.0 2.25 2.5 2.75 3.0 3.25 3.5 3.75]
% [0.0 0.125 0.25 0.375 0.5 0.625 0.75 0.875 1.0 1.125 1.25 1.375 1.5 1.625 1.75 1.875]]
2| % 2-reduce
{{==only}forall()=}forall %print without spaces
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment