Narcissist: Difference between revisions

From Rosetta Code
Content added Content deleted
m (→‎{{header|REXX}}: removed superfluous blank lines. -- ~~~~)
m (→‎{{header|Perl 6}}: Use nested quoting delimiters.)
Line 137: Line 137:
=={{header|Perl 6}}==
=={{header|Perl 6}}==


For the narcissist to work you must be very careful with whitespace. The presented version works if it is stored as a file of exactly one line terminated by a (Unix) newline character.
For the narcissist to work you must be very careful with whitespace. The presented version works if it is stored as a file of exactly one line terminated by a newline character.


Note: The code can be simplified as soon as Perl 6 implementations support nested quoting delimiters properly (i.e. q{ ...{...}...}).
Note how the code takes advantage of Perl 6's ability to nest quoting delimiters.


<lang perl6>my $self=q|say slurp() eq ('my $self=q'~124.chr~$self~124.chr~'; eval($self);'~10.chr)|; eval($self);
<lang perl6>my $self=q{say slurp() eq 'my $self=q{'~$self~'}; eval($self);'~10.chr ?? 'Beautiful!' !! 'Not my type.'}; eval($self);
</lang>
</lang>


{{out}}
{{out}}
<pre>$ rakudo narcissist.pl <narcissist.pl
<pre>$ rakudo narcissist.pl <narcissist.pl
Beautiful!
True
$ rakudo narcissist.pl <any-other-input.txt
$ rakudo narcissist.pl <any-other-input.pl
Not my type.
False
</pre>
</pre>



Revision as of 18:22, 18 October 2012

Task
Narcissist
You are encouraged to solve this task according to the task description, using any language you may know.

Quoting from the Esolangs wiki page:

A narcissist (or Narcissus program) is the decision-problem version of a quine.

A quine, when run, takes no input, but produces a copy of its own source code at its output. In contrast, a narcissist reads a string of symbols from its input, and produces no output except a "1" or "accept" if that string matches its own source code, or a "0" or "reject" if it does not.

For concreteness, in this task we shall assume that symbol = character. The narcissist should be able to cope with any finite input, whatever its length. Any form of output is allowed, as long as the program always halts, and "accept", "reject" and "not yet finished" are distinguishable.

Ada

Works with: Ada 2005

Took code from Quine, has to be in one line (could be done pretty printed, too, but not as simple).

<lang Ada>with Ada.Text_IO;procedure Self is Q:Character:='"';A:String:="with Ada.Text_IO;procedure Self is Q:Character:=;A:String:=;B:String:=A(1..49)&Q&A(50..61)&Q&A&Q&A(62..A'Last);C:String:=Ada.Text_IO.Get_Line;begin Ada.Text_IO.Put_Line(Boolean'Image(B=C));end Self;";B:String:=A(1..49)&Q&A(50..61)&Q&A&Q&A(62..A'Last);C:String:=Ada.Text_IO.Get_Line;begin Ada.Text_IO.Put_Line(Boolean'Image(B=C));end Self;</lang>

ALGOL 68

Works with: ALGOL 68 version Revision 1 - no extensions to language used
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny

<lang algol68>STRINGs="STRINGs="";print(readstring=2*s[:9]+2*s[9:])";print(readstring=2*s[:9]+2*s[9:])</lang> Output: T or F depending on input.

C

Based upon the quine. Reads until EOF or newline from stdin, and writes "1" or "0" to stdout. <lang c>extern void*stdin;main(){ char*p = "extern void*stdin;main(){ char*p = %c%s%c,a[300],b[300];sprintf(a,p,34,p,34);fgets(b,300,stdin);putchar(48+!strcmp(a,b)); }",a[300],b[300];sprintf(a,p,34,p,34);fgets(b,300,stdin);putchar(48+!strcmp(a,b)); }</lang>

Common Lisp

Only checks the first line of stdin: <lang lisp>#1=(PRINT (EQUAL (WRITE-TO-STRING '#1# :CIRCLE 1) (READ-LINE *STANDARD-INPUT*)))</lang>

Forth

<lang forth>: narcissist [ source ] sliteral compare 0= ;</lang>

Go

This version reads until EOF and expects a newline at the end of the input. If this is being checked from a file, make sure that the file has exactly one newline at the end of it.

<lang go>package main; import "os"; import "fmt"; import "bytes"; import "io/ioutil"; func main() {ios := "os"; ifmt := "fmt"; ibytes := "bytes"; iioutil := "io/ioutil"; zero := "Reject"; one := "Accept"; x := "package main; import %q; import %q; import %q; import %q; func main() {ios := %q; ifmt := %q; ibytes := %q; iioutil := %q; zero := %q; one := %q; x := %q; s := fmt.Sprintf(x, ios, ifmt, ibytes, iioutil, ios, ifmt, ibytes, iioutil, zero, one, x); in, _ := ioutil.ReadAll(os.Stdin); if bytes.Equal(in, []byte(s)) {fmt.Println(one);} else {fmt.Println(zero);};}\n"; s := fmt.Sprintf(x, ios, ifmt, ibytes, iioutil, ios, ifmt, ibytes, iioutil, zero, one, x); in, _ := ioutil.ReadAll(os.Stdin); if bytes.Equal(in, []byte(s)) {fmt.Println(one);} else {fmt.Println(zero);};}</lang> A version respecting the 80 character line limit: <lang go>package main

import (

   "bytes"
   "fmt"
   "io/ioutil"
   "os"

)

func main() {

   s := fmt.Sprintf("%s%c%s%c\n", x, 0x60, x, 0x60)
   in, _ := ioutil.ReadAll(os.Stdin)
   if bytes.Equal(in, []byte(s)) {
       fmt.Println("Accept")
   } else {
       fmt.Println("Reject")
   }

}

var x = `package main

import (

   "bytes"
   "fmt"
   "io/ioutil"
   "os"

)

func main() {

   s := fmt.Sprintf("%s%c%s%c\n", x, 0x60, x, 0x60)
   in, _ := ioutil.ReadAll(os.Stdin)
   if bytes.Equal(in, []byte(s)) {
       fmt.Println("Accept")
   } else {
       fmt.Println("Reject")
   }

}

var x = `</lang>

Icon and Unicon

Translation of: Go

Since we can't put a link statement and program on a single line, we implement a simplified inline sprintf so we don't have to deal with all the double quotes or substrings and offsets. If we'd needed to write multiple procedures on a line it can be done Semi-colons in the language intro <lang Icon>procedure main();yes:="Accept";no:="Reject";pat:="procedure main();yes:=$;no:=$;pat:=$;a:=[yes,no,pat];narc:=char(0)[0:0];pat?{while narc||:=tab(find(char(36))) do{narc||:=image(get(a));move(1)};narc||:=tab(0)};write(if read()==narc then yes else no);end";a:=[yes,no,pat];narc:=char(0)[0:0];pat?{while narc||:=tab(find(char(36))) do{narc||:=image(get(a));move(1)};narc||:=tab(0)};write(if read()==narc then yes else no);end</lang>

Example:

./narcissist.exe < narcissist.icn
Accept

Actually, this version recognizes all files where the first line is the Narcissist.

J

<lang j>#!/j602/bin/jconsole main=:3 : 0

 self=: '#!/j602/bin/jconsole',LF,'main=:',(5!:5<'main'),LF,'main,LF
 echo  self -: stdin

) main</lang>

Example use:

<lang>$ ./narcissist.ijs <narcissist.ijs 1

  </lang>

Note that this assumes a suitable os command line.


Alternative solution: <lang j> narcissist=.(-:,~,2#{:)&'(-:,~,2#{:)&</lang>

Example use: <lang j> (-:,~,2#{:)&'(-:,~,2#{:)& '(-:,~,2#{:)' 0

  (-:,~,2#{:)&'(-:,~,2#{:)& '(-:,~,2#{:)&(-:,~,2#{:)&''

1</lang>

JavaScript

Works with: SpiderMonkey version 1.7.0

Based upon one of the quines. Outputs 'true' if source is equal to inputted line (newline terminated), 'false' otherwise. <lang javascript>var code='var q=String.fromCharCode(39);print("var code=" + q + code + q + "; eval(code)" == readline())'; eval(code)</lang>

Liberty BASIC

NOTE: You have to manually type in ALL of the code since the Input statement will not successfully input data from a paste event even though it will show up in the MainWin.

<lang lb>

s$ = "s$ = Input a$ : Print (a$ = Left$(s$, 5) + chr$(34) + s$ + chr$(34) + Mid$(s$, 14, 3) + Mid$(s$, 6, 100)) + Mid$(s$, 23, 3)" : Input a$ : Print (a$ = Left$(s$, 5) + chr$(34) + s$ + chr$(34) + Mid$(s$, 14, 3) + Mid$(s$, 6, 100))
</lang>

Perl

<lang perl># this is file narc.pl print do { local $/; open 0, $0 or die $!; <0> } eq <> ? "accept" : "reject"</lang> Run: <lang>perl narc.pl < narc.pl</lang>

Perl 6

For the narcissist to work you must be very careful with whitespace. The presented version works if it is stored as a file of exactly one line terminated by a newline character.

Note how the code takes advantage of Perl 6's ability to nest quoting delimiters.

<lang perl6>my $self=q{say slurp() eq 'my $self=q{'~$self~'}; eval($self);'~10.chr ?? 'Beautiful!' !! 'Not my type.'}; eval($self); </lang>

Output:
$ rakudo narcissist.pl <narcissist.pl 
Beautiful!
$ rakudo narcissist.pl <any-other-input.pl 
Not my type.

PicoLisp

<lang PicoLisp>(de narcissist (Str)

  (= Str (str narcissist)) )</lang>

Output:

: (narcissist "(Str) (= Str (str narcissist))")
-> T

Python

For Python 2.x: <lang Python> import sys with open(sys.argv[0]) as quine:

   code = raw_input("Enter source code: ")
   if code == quine.read():
       print("Accept")
   else:
       print("Reject")

</lang>

REXX

version 1

(returns 1 or 0) <lang rexx>/*REXX*/ say arg(1)=sourceline(1)</lang>

version 2

(returns accept or reject) <lang rexx>/*REXX*/ say word('reject accept',1+(arg(1)=sourceline(1)))</lang>

Ruby

Translation of the C version. <lang ruby>s = "s = %s%s%s; puts(gets.chomp == (s %% [34.chr, s, 34.chr]) ? 'accept' : 'reject')"; puts(gets.chomp == (s % [34.chr, s, 34.chr]) ? 'accept' : 'reject')</lang> Output:

$ ruby narcissist.rb < narcissist.rb
accept

Tcl

With the use of explicit reflexive introspection: <lang tcl>apply {{} {puts [expr {[gets stdin] eq [info level 0]}]}}</lang> Without such commands, using pure generation of strings and lists: <lang tcl>apply {s {puts [expr {[gets stdin]eq[list {*}$s $s]}]}} {apply {s {puts [expr {[gets stdin]eq[list {*}$s $s]}]}}}</lang>

TXR

<lang txr>@(bind my64 "QChuZXh0IDphcmdzKQpAZmlsZW5hbWUKQChuZXh0IGAhc2VkIC1uIC1lICcyLCRwJyBAZmlsZW5hbWUgfCBiYXNlNjRgKQpAKGZyZWVmb3JtICIiKQpAaW42NApAKG5leHQgYEBmaWxlbmFtZWApCkBmaXJzdGxpbmUKQChjYXNlcykKQCAgKGJpbmQgZmlyc3RsaW5lIGBAQChiaW5kIG15NjQgIkBteTY0IilgKQpAICAoYmluZCBpbjY0IG15NjQpCkAgIChiaW5kIHJlc3VsdCAiMSIpCkAob3IpCkAgIChiaW5kIHJlc3VsdCAiMCIpCkAoZW5kKQpAKG91dHB1dCkKQHJlc3VsdApAKGVuZCkK") @(next :args) @filename @(next `!sed -n -e '2,$p' @filename | base64`) @(freeform "") @in64 @(next `@filename`) @firstline @(cases) @ (bind firstline `@@(bind my64 "@my64")`) @ (bind in64 my64) @ (bind result "1") @(or) @ (bind result "0") @(end) @(output) @result @(end)</lang>

How to run, showing self-acceptance:

$ txr narcissist.txr narcissist.txr
1

Informal proof.

We consider what happens if we make an alteration to the code and feed it to the original.

Changing any character of narcissist.txr can be divided into two cases.

  • Case 1: modification is done to line 1. This difference be caught by the @(bind firstline ...) directive later down in the query, causing a matching failure. The first line is verified to have exactly the form that it does, with the given base 64 string embedded.
  • Case 2: modification is done in some other line. This difference will be caught by @(bind in64 my64) because a modification to the data after the first line changes the base 64 string that is computed from that data, making in64 not equivalent to my64, leading to a match failure.

These cases are an exhaustive partitioning of the possibilities; there are no ways to modify the data which do not land into one of these cases.

Nothing in the query calls for any iteration or recursion. Termination depends on the base64 and sed utilities munching through the input, which presumably process an input of size N in O(N) steps. On that note, we could limit how many lines of the input are passed to base64 by using sed -n -e '2,20p'.