Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss
APL in PS
34 views
Skip to first unread message
luser- -droog
Mar 7, 2014, 2:01:34 AM3/7/14
to
It seems appropriate to archive this here as well as
https://gist.github.com/luser-dr00g/9382217
This code attempts to build-up enough APLisms to implement
the 10-byte J program from here:
http://codegolf.stackexchange.com/questions/12103/generate-a-universal-binary-function-lookup-table
which goes:
|.|:#:i.16
Build an iota vector, convert to binary, transpose, reverse.
%!
/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
-1 16 i + #: |: |.{{==only}forall()=}forall
https://gist.github.com/luser-dr00g/9382217
This code attempts to build-up enough APLisms to implement
the 10-byte J program from here:
http://codegolf.stackexchange.com/questions/12103/generate-a-universal-binary-function-lookup-table
which goes:
|.|:#:i.16
Build an iota vector, convert to binary, transpose, reverse.
%!
/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
-1 16 i + #: |: |.{{==only}forall()=}forall
Ross Presser
Mar 7, 2014, 12:31:35 PM3/7/14
to
On Friday, March 7, 2014 2:01:34 AM UTC-5, luser- -droog wrote:
> It seems appropriate to archive this here as well as
>
> https://gist.github.com/luser-dr00g/9382217
>
> This code attempts to build-up enough APLisms to implement
*sound of brain exploding*
> It seems appropriate to archive this here as well as
>
> https://gist.github.com/luser-dr00g/9382217
>
> This code attempts to build-up enough APLisms to implement
luser- -droog
Mar 8, 2014, 2:25:15 AM3/8/14
to
"This *means* something!"
I confess I don't understand any more APL than I've written there,
and some of that's a little shaky, too.
At the very end there's a unzip/zip-array operation with that
single '*' in the middle. Somehow, it makes a multiplication
table. But without the "exch", it doesn't. But I don't know why.
Oh, wait a mom. Yes I do. That's not APL's fault. That's because,
it doesn't check the second argument if the first is not an array.
It's because I cut corners at the top of the page. :(
I'm still trying to grok the "J incunabulum", with some limited
success (and lots of helpful search results), but the real
secret, I suspect is in the 1962 volume: A Programming Language.
But annoyingly, it uses slightly different symbols and conventions
from every other version.
luser- -droog
Mar 8, 2014, 5:15:57 AM3/8/14
to
On Saturday, March 8, 2014 1:25:15 AM UTC-6, luser- -droog wrote:
> On Friday, March 7, 2014 11:31:35 AM UTC-6, Ross Presser wrote:
>
> > On Friday, March 7, 2014 2:01:34 AM UTC-5, luser- -droog wrote:
>
> > > It seems appropriate to archive this here as well as
> > >
> > > https://gist.github.com/luser-dr00g/9382217
> > >
> > > This code attempts to build-up enough APLisms to implement
> >
> > *sound of brain exploding*
>
> Richard Dreyfuss gesturing at the mashed potatoes:
> "This *means* something!"
>
> I confess I don't understand any more APL than I've written there,
> and some of that's a little shaky, too.
> At the very end there's a unzip/zip-array operation with that
> single '*' in the middle. Somehow, it makes a multiplication
> table. But without the "exch", it doesn't. But I don't know why.
>
Updated the gist with the part I'm talking about here. This is the
> On Friday, March 7, 2014 11:31:35 AM UTC-6, Ross Presser wrote:
>
> > On Friday, March 7, 2014 2:01:34 AM UTC-5, luser- -droog wrote:
>
> > > It seems appropriate to archive this here as well as
> > >
> > > https://gist.github.com/luser-dr00g/9382217
> > >
> > > This code attempts to build-up enough APLisms to implement
> >
> > *sound of brain exploding*
>
> Richard Dreyfuss gesturing at the mashed potatoes:
> "This *means* something!"
>
> I confess I don't understand any more APL than I've written there,
> and some of that's a little shaky, too.
> At the very end there's a unzip/zip-array operation with that
> single '*' in the middle. Somehow, it makes a multiplication
> table. But without the "exch", it doesn't. But I don't know why.
>
line that makes a multiplication table:
[3 1 roll{1 index * exch}forall pop]
0 new messages