Two identical strings

From Rosetta Code
Two identical strings is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
Task

Find and display   (here on this page)   positive integers, n, whose base 2 representation is the concatenation of two identical binary strings,
where   n <   1,00010       (one thousand).

For each such integer, show its decimal and binary forms.

11l

Translation of: Python
F bits(=n)
   ‘Count the amount of bits required to represent n’
   V r = 0
   L n != 0
      n >>= 1
      r++
   R r

F concat(n)
   ‘Concatenate the binary representation of n to itself’
   R n << bits(n) [|] n

V n = 1
L concat(n) <= 1000
   print(‘#.: #.’.format(concat(n), bin(concat(n))))
   n++
Output:
3: 11
10: 1010
15: 1111
36: 100100
45: 101101
54: 110110
63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

8080 Assembly

	;;;	Print positive integers whose base-2 representation
	;;;	is the concatenation of two identical binary strings,
	;;;	for 1 < n < 1000
puts:	equ	9	; CP/M syscall to print a string
	org	100h
	lxi	b,1	; Counter
loop:	mov	h,b	; HL = counter 
	mov	l,c
	call	concat	; Get current concatenated number
	lxi	d,1000	; Reached the end yet?
	call	cmp16 
	rnc		; Stop when >1000
	push	b	; Keep the counter
	push	h	; And the concatenated number
	call 	hldec	; Print decimal value
	pop	h	; Restore number
	call	hlbin	; Print binary value
	lxi	d,nl	; Print newline
	mvi	c,puts
	call	5
	pop	b	; Restore counter
	inx	b	; Increment counter
	jmp 	loop
	;;;	16-bit compare HL to DE
cmp16:	mov	a,h
	cmp	d
	rnz
	mov	a,l
	cmp	e
	ret 
	;;;	Concatenate HL with itself
concat:	push	h	; Keep a copy of HL on the stack
	mov	d,h	; DE = copy of HL
	mov	e,l
ctloop:	mov	a,d	; When DE=0, we are done
	ora	e
	jz	ctdone
	mov	a,d	; Rotate DE left
	rar
	mov	d,a
	mov	a,e
	rar	
	mov	e,a
	dad	h	; And rotate HL right (add to itself)
	jmp	ctloop
ctdone:	pop	d	; Retrieve old HL
	dad	d	; Add to shifted version (same as OR)
	ret 
	;;;	Print HL as a decimal value
hldec:	lxi	d,outbuf
	push	d	; Output pointer on the stack
	lxi	b,-10	; Divisor
decdgt:	lxi	d,-1	; Quotient
div10:	inx	d	; Divide HL by 10 using trial subtraction
	dad	b
	jc	div10
	mvi	a,'0'+10
	add	l	; L contains remainder - 10
	pop	h		; Retrieve output pointer
	dcx	h	; Store digit
	mov	m,a
	push	h
	xchg		; Continue with quotient
	mov	a,h	; If any digits left
	ora	l
	jnz	decdgt	; Find the next digits
	pop	d	; Otherwise, retrieve pointer
	mvi	c,puts	; And print result using CP/M
	jmp	5
	;;;	Print HL as a binary value
hlbin:	lxi	d,outbuf
	ora	a	; Zero the carry flag
bindgt:	mov	a,h	; Rotate HL right
	rar
	mov	h,a
	mov	a,l
	rar
	mov	l,a
	mvi	a,0	; A = '0' + carry flag (i.e. lowest bit)
	aci	'0'
	dcx	d	; Store digit
	stax	d
	mov	a,h	; Any more digits?
	ora	l
	jnz	bindgt	; If so, find next digits
	mvi	c,puts	; Otherwise, print the result
	jmp	5
	db	'***********'
outbuf:	db	9,'$'
nl:	db	13,10,'$'
Output:
3       11
10      1010
15      1111
36      100100
45      101101
54      110110
63      111111
136     10001000
153     10011001
170     10101010
187     10111011
204     11001100
221     11011101
238     11101110
255     11111111
528     1000010000
561     1000110001
594     1001010010
627     1001110011
660     1010010100
693     1010110101
726     1011010110
759     1011110111
792     1100011000
825     1100111001
858     1101011010
891     1101111011
924     1110011100
957     1110111101
990     1111011110

8086 Assembly

puts:	equ	9
	cpu	8086
	org	100h
section	.text
main:	mov	di,1		; Counter
.loop:	mov	ax,di 
	call	concat		; Concatenate current number to itself
	cmp	ax,1000
	jge	.done		; Stop when >= 1000
	mov	si,ax		; Keep a copy of AX
	call	pdec		; Print decimal value
	mov	ax,si
	call	pbin		; Print binary value
	mov	bx,nl		; Print newline
	call	pstr
	inc	di		; Next number
	jmp	.loop 
.done:	ret
	;;;	Concatenate AX to itself
concat:	mov	bx,ax		; Store a copy of AX in BP
	mov	cx,ax		; Store a copy of AX in CX
.loop:	shl	ax,1		; Shift AX left
	shr	cx,1		; Shift CX right
	jnz 	.loop		; Keep going until CX is zero
	or	ax,bx		; OR original AX with shifted AX
	ret
	;;;	Print AX as decimal
pdec:	mov	bp,10		; Divisor
	mov	bx,outbuf	; Buffer pointer
.loop:	xor	dx,dx
	div	bp
	add	dl,'0'		; Add '0' to remainder
	dec	bx		; Store digit
	mov	[bx],dl
	test	ax,ax		; Any more digits?
	jnz	.loop
	jmp	pstr		; When done, print the result
	;;;	Print AX as binary
pbin:	mov	bx,outbuf	; Buffer pointer
.loop:	shr	ax,1		; Shift AX
	mov	dl,'0'		; ASCII 0 or 1
	adc	dl,0
	dec	bx
	mov	[bx],dl		; Store digit
	test	ax,ax
	jnz	.loop
pstr:	mov	ah,puts		; When done, print the result
	mov	dx,bx
	int	21h
	ret
section	.data
nl:	db	13,10,'$'
	db	'****************'
outbuf:	db	9,'$'
Output:
3       11
10      1010
15      1111
36      100100
45      101101
54      110110
63      111111
136     10001000
153     10011001
170     10101010
187     10111011
204     11001100
221     11011101
238     11101110
255     11111111
528     1000010000
561     1000110001
594     1001010010
627     1001110011
660     1010010100
693     1010110101
726     1011010110
759     1011110111
792     1100011000
825     1100111001
858     1101011010
891     1101111011
924     1110011100
957     1110111101
990     1111011110

Action!

INT FUNC Encode(INT x CHAR ARRAY s)
  BYTE len,i
  CHAR tmp

  len=0 tmp=x
  WHILE tmp#0
  DO
    len==+1
    s(len)='0+(tmp&1)
    tmp==RSH 1
  OD
  FOR i=1 TO len RSH 1
  DO
    tmp=s(i) s(i)=s(len-i+1) s(len-i+1)=tmp
  OD
  FOR i=1 TO len
  DO
    s(i+len)=s(i)
  OD
  s(0)=len
RETURN (x LSH len+x)

PROC Main()
  CHAR ARRAY s(20)
  INT i=[1],res,count=[0]

  DO
    res=Encode(i,s)
    IF res>=1000 THEN
      EXIT
    FI
    Position((count&1)*15+2,count RSH 1+1)
    PrintF("%I: %S",res,s)
    i==+1 count==+1
  OD
RETURN
Output:

Screenshot from Atari 8-bit computer

3: 1           10: 10
15: 11         36: 100
45: 101        54: 110
63: 111        136: 1000
153: 1001      170: 1010
187: 1011      204: 1100
221: 1101      238: 1110
255: 1111      528: 10000
561: 10001     594: 10010
627: 10011     660: 10100
693: 10101     726: 10110
759: 10111     792: 11000
825: 11001     858: 11010
891: 11011     924: 11100
957: 11101     990: 11110

Ada

with Ada.Text_Io;        use Ada.Text_Io;
with Ada.Strings.Fixed;  use Ada.Strings.Fixed;

procedure Two_Identical is
   package Integer_Io is
     new Ada.Text_Io.Integer_Io (Integer);
   use Integer_Io;

   Image : String (1 .. 16);
   Pos_1, Pos_2 : Natural;
   Mid  : Natural;
begin
   for N in 1 .. 1000 loop
      Put (Image, N, Base => 2);
      Pos_1 := Index (Image, "#");
      Pos_2 := Index (Image, "#", Pos_1 + 1);
      Mid := (Pos_1 + Pos_2) / 2;
      if Image (Pos_1 + 1 .. Mid) = Image (Mid + 1 .. Pos_2 - 1) then
         Put (N, Width => 3); Put ("  "); Put (Image); New_Line;
      end if;
   end loop;
end Two_Identical;
Output:
  3             2#11#
 10           2#1010#
 15           2#1111#
 36         2#100100#
 45         2#101101#
 54         2#110110#
 63         2#111111#
136       2#10001000#
153       2#10011001#
170       2#10101010#
187       2#10111011#
204       2#11001100#
221       2#11011101#
238       2#11101110#
255       2#11111111#
528     2#1000010000#
561     2#1000110001#
594     2#1001010010#
627     2#1001110011#
660     2#1010010100#
693     2#1010110101#
726     2#1011010110#
759     2#1011110111#
792     2#1100011000#
825     2#1100111001#
858     2#1101011010#
891     2#1101111011#
924     2#1110011100#
957     2#1110111101#
990     2#1111011110#

ALGOL 68

BEGIN # show the decimal and binary representations of numbers that are of the concatenation of #
      # two identical binary strings                                                            #
    # returns a binary representation of v #
    OP TOBINSTRING = ( INT v )STRING:
       IF v = 0 THEN "0"
       ELSE
            STRING result := "";
            INT rest := v;
            WHILE rest > 0 DO
                IF ODD rest THEN "1" ELSE "0" FI +=: result;
                rest OVERAB 2
            OD;
            result
       FI # TOBINSTRING # ;
    INT power of 2 := 1;
    FOR b WHILE IF b = power of 2 THEN
                    power of 2 *:= 2
                FI;
                INT cat value = ( b * power of 2 ) + b;
                cat value < 1000
    DO
        print( ( whole( cat value, -4 ), ": ", TOBINSTRING cat value, newline ) )
    OD
END
Output:
   3: 11
  10: 1010
  15: 1111
  36: 100100
  45: 101101
  54: 110110
  63: 111111
 136: 10001000
 153: 10011001
 170: 10101010
 187: 10111011
 204: 11001100
 221: 11011101
 238: 11101110
 255: 11111111
 528: 1000010000
 561: 1000110001
 594: 1001010010
 627: 1001110011
 660: 1010010100
 693: 1010110101
 726: 1011010110
 759: 1011110111
 792: 1100011000
 825: 1100111001
 858: 1101011010
 891: 1101111011
 924: 1110011100
 957: 1110111101
 990: 1111011110

ALGOL-M

begin
    integer function concatself(n);
    integer n;
    begin
        integer shift, copy, test;
        test := n;
        shift := n;
        while test > 0 do
        begin
            test := test / 2;
            shift := shift * 2;
        end;
        concatself := shift + n;
    end;
    
    procedure writebits(n);
    integer n;
    begin
        if n>1 then writebits(n/2);
        writeon(if n-n/2*2=0 then "0" else "1");
    end;
    
    integer n, m;
    n := 1;
    m := concatself(n);
    while m < 1000 do
    begin
        write(m, ": ");
        writebits(m);
        n := n + 1;
        m := concatself(n);
    end;
end
Output:
     3: 11
    10: 1010
    15: 1111
    36: 100100
    45: 101101
    54: 110110
    63: 111111
   136: 10001000
   153: 10011001
   170: 10101010
   187: 10111011
   204: 11001100
   221: 11011101
   238: 11101110
   255: 11111111
   528: 1000010000
   561: 1000110001
   594: 1001010010
   627: 1001110011
   660: 1010010100
   693: 1010110101
   726: 1011010110
   759: 1011110111
   792: 1100011000
   825: 1100111001
   858: 1101011010
   891: 1101111011
   924: 1110011100
   957: 1110111101
   990: 1111011110

ALGOL W

Translation of: MAD
BEGIN 
    INTEGER PROCEDURE BITSP ( INTEGER VALUE BT ) ;
    BEGIN
        INTEGER BITN, BITRSL, BITIDX;
        BITN   := BT;
        BITRSL := 0;
        BITIDX := 1;
        WHILE BITN > 0 DO BEGIN
            INTEGER BITNX;
            BITNX  := BITN DIV 2;
            BITRSL := BITRSL + BITIDX*(BITN-BITNX*2);
            BITN   := BITNX;
            BITIDX := BITIDX*10
        END;
        BITRSL
    END BITSP ;

    INTEGER PROCEDURE DPLBIT ( INTEGER VALUE DVAL ) ;
    BEGIN
        INTEGER DTEMP, DSHFT;
        DTEMP := DVAL;
        DSHFT := DVAL;
        WHILE DTEMP > 0 DO BEGIN
            DSHFT := DSHFT  *  2;
            DTEMP := DTEMP DIV 2;
        END;
        DSHFT + DVAL
    END DPLBIT ;

    BEGIN
        INTEGER N;
        N := 0;
        WHILE BEGIN
              N := N + 1;
              DPLBIT(N) < 1000
        END DO WRITE( S_W := 0, I_W := 3, DPLBIT(N), ": ", I_W := 10, BITSP(DPLBIT(N)) )
    END
END.
Output:
  3:         11
 10:       1010
 15:       1111
 36:     100100
 45:     101101
 54:     110110
 63:     111111
136:   10001000
153:   10011001
170:   10101010
187:   10111011
204:   11001100
221:   11011101
238:   11101110
255:   11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

APL

Works with: Dyalog APL
(((2),⊂)(,2¯1))¨30
Output:
  3  1 1                 
 10  1 0 1 0             
 15  1 1 1 1             
 36  1 0 0 1 0 0         
 45  1 0 1 1 0 1         
 54  1 1 0 1 1 0         
 63  1 1 1 1 1 1         
136  1 0 0 0 1 0 0 0     
153  1 0 0 1 1 0 0 1     
170  1 0 1 0 1 0 1 0     
187  1 0 1 1 1 0 1 1     
204  1 1 0 0 1 1 0 0     
221  1 1 0 1 1 1 0 1     
238  1 1 1 0 1 1 1 0     
255  1 1 1 1 1 1 1 1     
528  1 0 0 0 0 1 0 0 0 0 
561  1 0 0 0 1 1 0 0 0 1 
594  1 0 0 1 0 1 0 0 1 0 
627  1 0 0 1 1 1 0 0 1 1 
660  1 0 1 0 0 1 0 1 0 0 
693  1 0 1 0 1 1 0 1 0 1 
726  1 0 1 1 0 1 0 1 1 0 
759  1 0 1 1 1 1 0 1 1 1 
792  1 1 0 0 0 1 1 0 0 0 
825  1 1 0 0 1 1 1 0 0 1 
858  1 1 0 1 0 1 1 0 1 0 
891  1 1 0 1 1 1 1 0 1 1 
924  1 1 1 0 0 1 1 1 0 0 
957  1 1 1 0 1 1 1 1 0 1 
990  1 1 1 1 0 1 1 1 1 0

AppleScript

Functional

Drawing members of the sequence from a non-finite list, up to a given limit.

------ CONCATENATION OF TWO IDENTICAL BINARY STRINGS -----

-- binaryTwin :: Int -> (Int, String)
on binaryTwin(n)
    -- A tuple of an integer m and a string s, where
    -- s is a self-concatenation of the binary
    -- represention of n, and m is the integer value of s.
    
    set b to showBinary(n)
    set s to b & b
    {readBinary(s), s}
end binaryTwin


--------------------------- TEST -------------------------
on run
    script p
        on |λ|(pair)
            1000 > item 1 of pair
        end |λ|
    end script
    
    script format
        on |λ|(pair)
            set {n, s} to pair
            
            (n as string) & " -> " & s
        end |λ|
    end script
    
    unlines(map(format, ¬
        takeWhile(p, ¬
            fmap(binaryTwin, enumFrom(1)))))
end run


------------------------- GENERIC ------------------------

-- enumFrom :: Int -> [Int]
on enumFrom(x)
    script
        property v : missing value
        on |λ|()
            if missing value is not v then
                set v to 1 + v
            else
                set v to x
            end if
            return v
        end |λ|
    end script
end enumFrom


-- fmap <$> :: (a -> b) -> Gen [a] -> Gen [b]
on fmap(f, gen)
    script
        property g : mReturn(f)
        on |λ|()
            set v to gen's |λ|()
            if v is missing value then
                v
            else
                g's |λ|(v)
            end if
        end |λ|
    end script
end fmap


-- foldr :: (a -> b -> b) -> b -> [a] -> b
on foldr(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from lng to 1 by -1
            set v to |λ|(item i of xs, v, i, xs)
        end repeat
        return v
    end tell
end foldr


-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    -- The list obtained by applying f
    -- to each element of xs.
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map


-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    -- 2nd class handler function lifted into 1st class script wrapper. 
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn


-- quotRem :: Int -> Int -> (Int, Int)
on quotRem(m, n)
    {m div n, m mod n}
end quotRem


-- readBinary :: String -> Int
on readBinary(s)
    -- The integer value of the binary string s
    script go
        on |λ|(c, en)
            set {e, n} to en
            set v to ((id of c) - 48)
            
            {2 * e, v * e + n}
        end |λ|
    end script
    
    item 2 of foldr(go, {1, 0}, s)
end readBinary


-- showBinary :: Int -> String
on showBinary(n)
    script binaryChar
        on |λ|(n)
            character id (48 + n)
        end |λ|
    end script
    showIntAtBase(2, binaryChar, n, "")
end showBinary


-- showIntAtBase :: Int -> (Int -> Char) -> Int -> String -> String
on showIntAtBase(base, toDigit, n, rs)
    script go
        property f : mReturn(toDigit)
        on |λ|(nd_, r)
            set {n, d} to nd_
            set r_ to f's |λ|(d) & r
            if n > 0 then
                |λ|(quotRem(n, base), r_)
            else
                r_
            end if
        end |λ|
    end script
    |λ|(quotRem(n, base), rs) of go
end showIntAtBase


-- takeWhile :: (a -> Bool) -> Generator [a] -> [a]
on takeWhile(p, xs)
    set ys to {}
    set v to |λ|() of xs
    tell mReturn(p)
        repeat while (|λ|(v))
            set end of ys to v
            set v to xs's |λ|()
        end repeat
    end tell
    return ys
end takeWhile


-- unlines :: [String] -> String
on unlines(xs)
    -- A single string formed by the intercalation
    -- of a list of strings with the newline character.
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set s to xs as text
    set my text item delimiters to dlm
    s
end unlines
Output:
3 -> 11
10 -> 1010
15 -> 1111
36 -> 100100
45 -> 101101
54 -> 110110
63 -> 111111
136 -> 10001000
153 -> 10011001
170 -> 10101010
187 -> 10111011
204 -> 11001100
221 -> 11011101
238 -> 11101110
255 -> 11111111
528 -> 1000010000
561 -> 1000110001
594 -> 1001010010
627 -> 1001110011
660 -> 1010010100
693 -> 1010110101
726 -> 1011010110
759 -> 1011110111
792 -> 1100011000
825 -> 1100111001
858 -> 1101011010
891 -> 1101111011
924 -> 1110011100
957 -> 1110111101
990 -> 1111011110

Idiomatic

on task(maxN)
    set startWith0 to false -- Change to true to start with 0 and "00".
    set rhv to -(startWith0 as integer) -- Start value of "right hand" string.
    script o
        property bits : {rhv}
        property output : {}
    end script
    
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to ""
    repeat
        -- Add 1 to the binary-digit list's LSD and perform any carries.
        set carry to 1
        repeat with i from (count o's bits) to 1 by -1
            set columnSum to (item i of o's bits) + carry
            set item i of o's bits to columnSum mod 2
            set carry to columnSum div 2
            if (carry = 0) then exit repeat
        end repeat
        if (carry = 1) then set beginning of o's bits to carry
        -- Add 1 to the "right-hand" value and work out the corresponding n.
        set rhv to rhv + 1
        set n to rhv * (2 ^ (count o's bits)) div 1 + rhv
        -- Unless n exceeds maxN, append it and its binary form to the output.
        if (n > maxN) then exit repeat
        set end of o's output to (n as text) & ":  " & o's bits & o's bits
    end repeat
    set AppleScript's text item delimiters to linefeed
    set o's output to o's output as text
    set AppleScript's text item delimiters to astid
    
    return o's output
end task

task(999)
Output:
"3:  11
10:  1010
15:  1111
36:  100100
45:  101101
54:  110110
63:  111111
136:  10001000
153:  10011001
170:  10101010
187:  10111011
204:  11001100
221:  11011101
238:  11101110
255:  11111111
528:  1000010000
561:  1000110001
594:  1001010010
627:  1001110011
660:  1010010100
693:  1010110101
726:  1011010110
759:  1011110111
792:  1100011000
825:  1100111001
858:  1101011010
891:  1101111011
924:  1110011100
957:  1110111101
990:  1111011110"

Arturo

loop 0..1000 'i [
    bin: as.binary i
    if even? size bin [
        half: (size bin)/2
        if equal? slice bin 0 dec half
                  slice bin half dec size bin ->
            print [pad to :string i 4 ":" bin]
    ]
]
Output:
   3 : 11 
  10 : 1010 
  15 : 1111 
  36 : 100100 
  45 : 101101 
  54 : 110110 
  63 : 111111 
 136 : 10001000 
 153 : 10011001 
 170 : 10101010 
 187 : 10111011 
 204 : 11001100 
 221 : 11011101 
 238 : 11101110 
 255 : 11111111 
 528 : 1000010000 
 561 : 1000110001 
 594 : 1001010010 
 627 : 1001110011 
 660 : 1010010100 
 693 : 1010110101 
 726 : 1011010110 
 759 : 1011110111 
 792 : 1100011000 
 825 : 1100111001 
 858 : 1101011010 
 891 : 1101111011 
 924 : 1110011100 
 957 : 1110111101 
 990 : 1111011110

AutoHotkey

n:=0
while (n++<=1000)
{
    bin := LTrim(dec2bin(n), "0")
    l := Strlen(bin)
    if (l/2 <> Floor(l/2))
        continue
    if (SubStr(bin, 1, l/2) = SubStr(bin, l/2+1))
        result .= n "`t" bin "`n"
}
MsgBox % result
return

Dec2Bin(i, s=0, c=0) {
    l := StrLen(i := Abs(i + u := i < 0))
    Loop, % Abs(s) + !s * l << 2
        b := u ^ 1 & i // (1 << c++) . b
    Return, b
}
Output:
3	11
10	1010
15	1111
36	100100
45	101101
54	110110
63	111111
136	10001000
153	10011001
170	10101010
187	10111011
204	11001100
221	11011101
238	11101110
255	11111111
528	1000010000
561	1000110001
594	1001010010
627	1001110011
660	1010010100
693	1010110101
726	1011010110
759	1011110111
792	1100011000
825	1100111001
858	1101011010
891	1101111011
924	1110011100
957	1110111101
990	1111011110

AWK

# syntax: GAWK -f TWO_IDENTICAL_STRINGS.AWK
BEGIN {
    for (i=1; i<1000; i++) {
      b = dec2bin(i)
      leng = length(b)
      if (leng % 2 == 0) {
        if (substr(b,1,leng/2) == substr(b,leng/2+1)) {
          printf("%4d %10s\n",i,b)
          count++
        }
      }
    }
    printf("count: %d\n",count)
    exit(0)
}
function dec2bin(n,  str) {
    while (n) {
      str = ((n%2 == 0) ? "0" : "1") str
      n = int(n/2)
    }
    if (str == "") {
      str = "0"
    }
    return(str)
}
Output:
   3         11
  10       1010
  15       1111
  36     100100
  45     101101
  54     110110
  63     111111
 136   10001000
 153   10011001
 170   10101010
 187   10111011
 204   11001100
 221   11011101
 238   11101110
 255   11111111
 528 1000010000
 561 1000110001
 594 1001010010
 627 1001110011
 660 1010010100
 693 1010110101
 726 1011010110
 759 1011110111
 792 1100011000
 825 1100111001
 858 1101011010
 891 1101111011
 924 1110011100
 957 1110111101
 990 1111011110
count: 30

BASIC

10 DEFINT A-Z: DIM B(15)
20 N=0
30 N=N+1
40 C=0: X=N
50 C=C+1
60 X=X\2
70 IF X>0 THEN 50
80 K=N+2^C*N
90 IF K>1000 THEN END
100 PRINT K,
110 FOR I=C*2 TO 1 STEP -1
120 B(I)=K AND 1
130 K=K\2
140 NEXT I
150 FOR I=1 TO C*2
160 PRINT USING "#";B(I);
170 NEXT I
180 PRINT
190 GOTO 30
Output:
 3            11
 10           1010
 15           1111
 36           100100
 45           101101
 54           110110
 63           111111
 136          10001000
 153          10011001
 170          10101010
 187          10111011
 204          11001100
 221          11011101
 238          11101110
 255          11111111
 528          1000010000
 561          1000110001
 594          1001010010
 627          1001110011
 660          1010010100
 693          1010110101
 726          1011010110
 759          1011110111
 792          1100011000
 825          1100111001
 858          1101011010
 891          1101111011
 924          1110011100
 957          1110111101
 990          1111011110

BASIC256

n = 1
k = 0
p = 2

while True
	if n >= p then p += p
	k = n + n * p
	if k < 1000 then print k; " = "; tobinary(k) else end
	n += 1
end while

QBasic

Works with: QBasic version 1.1
Works with: QuickBasic version 4.5
FUNCTION tobin$ (d)
    s$ = ""
    DO WHILE d <> 0
       r = d MOD 2
       s$ = STR$(r) + s$
       d = d \ 2
    LOOP
    tobin$ = s$
END FUNCTION

k = 0 : n = 1 : p = 2
DO
   IF n >= p THEN p = p + p
   k = n + n * p
   IF k < 1000 THEN
      PRINT k; " = "; tobin$(k)
   ELSE
      EXIT DO
   END IF
   n = n + 1
LOOP

PureBasic

OpenConsole()
n.i = 1
k.i = 0
p.i= 2

While #True
  If n >= p 
    p + p
  EndIf
  k = n + n * p
  If k < 1000 
    PrintN(Str(k) + " = " + Bin(k))
  Else 
    Break	  
  EndIf
  n + 1
Wend

Input()
CloseConsole()

True BASIC

FUNCTION tobin$(d)
    LET s$ = ""
    DO WHILE d <> 0
       LET r = REMAINDER(ROUND(d),2)
       LET s$ = STR$(r) & s$
       LET d = IP(ROUND(d)/2)
    LOOP
    LET tobin$ = s$
END FUNCTION

LET n = 1
LET k = 0
LET p = 2
DO
   IF n >= p THEN LET p = p+p
   LET k = n+n*p
   IF k < 1000 THEN
      PRINT k; " = "; tobin$(k)
   ELSE
      EXIT DO
   END IF
   LET n = n+1
LOOP
END

BCPL

get "libhdr"

let bitlength(n) = n=0 -> 0, 1 + bitlength(n >> 1)
let concat(n,m) = (n << bitlength(n)) | m;

let writebits(n) be
$(  if n>1 then writebits(n >> 1)
    wrch('0' + (n & 1))
$)

let start() be
$(  let n = 1 and conc = concat(n,n)
    while conc < 1000 do
    $(  writef("%I4: ", conc)
        writebits(conc)
        wrch('*N')
        n := n + 1 
        conc := concat(n,n)
    $)
$)
Output:
   3: 11
  10: 1010
  15: 1111
  36: 100100
  45: 101101
  54: 110110
  63: 111111
 136: 10001000
 153: 10011001
 170: 10101010
 187: 10111011
 204: 11001100
 221: 11011101
 238: 11101110
 255: 11111111
 528: 1000010000
 561: 1000110001
 594: 1001010010
 627: 1001110011
 660: 1010010100
 693: 1010110101
 726: 1011010110
 759: 1011110111
 792: 1100011000
 825: 1100111001
 858: 1101011010
 891: 1101111011
 924: 1110011100
 957: 1110111101
 990: 1111011110

Befunge

1>:::>:#v_++:91+v
>^   /  >\vv**::<
     ^2\*2<>`#@_v
 v_v#!:<\+19\0.:<
 $ :   ^ /2<
+v<>2%68*+\^
1:^
$!,
^_^
Output:
3 11
10 1010
15 1111
36 100100
45 101101
54 110110
63 111111
136 10001000
153 10011001
170 10101010
187 10111011
204 11001100
221 11011101
238 11101110
255 11111111
528 1000010000
561 1000110001
594 1001010010
627 1001110011
660 1010010100
693 1010110101
726 1011010110
759 1011110111
792 1100011000
825 1100111001
858 1101011010
891 1101111011
924 1110011100
957 1110111101
990 1111011110

C

#include <stdio.h>
#include <stdint.h>

uint8_t bit_length(uint32_t n) {
    uint8_t r;
    for (r=0; n; r++) n >>= 1;
    return r;
}

uint32_t concat_bits(uint32_t n) {
    return (n << bit_length(n)) | n;
}

char *bits(uint32_t n) {
    static char buf[33];
    char *ptr = &buf[33];
    *--ptr = 0;
    do {
        *--ptr = '0' + (n & 1);
    } while (n >>= 1);
    return ptr;
}

int main() {
    uint32_t n, r;
    for (n=1; (r = concat_bits(n)) < 1000; n++) {
        printf("%d: %s\n", r, bits(r));
    }
    return 0;
}
Output:
3: 11
10: 1010
15: 1111
36: 100100
45: 101101
54: 110110
63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

C#

Translation of: Visual Basic .NET
using System; using static System.Console;
class Program { static void Main() { int c = 0, lmt = 1000;
    for (int n = 1, p = 2, k; n <= lmt; n++)
      if ((k = n + n * (p += n >= p ? p : 0)) > lmt) break;
      else Console.Write("{0,3} ({1,-10})  {2}", k,
          Convert.ToString(k, 2), ++c % 5 == 0 ? "\n" : "");
    Write("\nFound {0} numbers whose base 2 representation is the " +
      "concatenation of two identical binary strings.", c); } }
Output:

Same as Visual Basic. NET

C++

#include <iostream>
#include <string>

// Given the base 2 representation of a number n, transform it into the base 2
// representation of n + 1.
void base2_increment(std::string& s) {
    size_t z = s.rfind('0');
    if (z != std::string::npos) {
        s[z] = '1';
        size_t count = s.size() - (z + 1);
        s.replace(z + 1, count, count, '0');
    } else {
        s.assign(s.size() + 1, '0');
        s[0] = '1';
    }
}

int main() {
    std::cout << "Decimal\tBinary\n";
    std::string s("1");
    for (unsigned int n = 1; ; ++n) {
        unsigned int i = n + (n << s.size());
        if (i >= 1000)
            break;
        std::cout << i << '\t' << s << s << '\n';
        base2_increment(s);
    }
}
Output:
Decimal	Binary
3	11
10	1010
15	1111
36	100100
45	101101
54	110110
63	111111
136	10001000
153	10011001
170	10101010
187	10111011
204	11001100
221	11011101
238	11101110
255	11111111
528	1000010000
561	1000110001
594	1001010010
627	1001110011
660	1010010100
693	1010110101
726	1011010110
759	1011110111
792	1100011000
825	1100111001
858	1101011010
891	1101111011
924	1110011100
957	1110111101
990	1111011110

CLU

nth_ident = proc (n: int) returns (int)
    h: int := n
    l: int := n
    while l>0 do h, l := h*2, l/2 end 
    return(h + n)
end nth_ident 

bits = proc (n: int) returns (string)
    p: string := ""
    if n>1 then p := bits(n/2) end
    return(p || int$unparse(n//2))
end bits

start_up = proc ()
    po: stream := stream$primary_output()
    n: int := 0
    while true do
        n := n+1
        ident: int := nth_ident(n)
        if ident>=1000 then break end
        stream$putright(po, int$unparse(ident), 3)
        stream$putl(po, ": " || bits(ident))
    end
end start_up
Output:
  3: 11
 10: 1010
 15: 1111
 36: 100100
 45: 101101
 54: 110110
 63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

COBOL

       IDENTIFICATION DIVISION.
       PROGRAM-ID.  IDENTICAL-STRINGS.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 VARIABLES.
          03 INPUT-NUMBER            PIC 9(4).
          03 BINARY-REPRESENTATION   PIC 9(10).
          03 BIT                     REDEFINES BINARY-REPRESENTATION,
                                     PIC 9 OCCURS 10 TIMES.
          03 FIRST-SET-BIT           PIC 99.
          03 CURRENT-BIT             PIC 99.
          03 SECOND-BIT              PIC 99.
          03 BIT-VALUE               PIC 9(4).
          03 OUTPUT-NUMBER           PIC 9(4) VALUE ZERO.
          03 REMAINING-BITS          PIC 9(4)V9.
          03 FILLER                  REDEFINES REMAINING-BITS.
             05 REST                 PIC 9(4).
             05 FILLER               PIC 9.
                88 BIT-IS-SET        VALUE 5.

       01 OUTPUT-FORMAT.
          03 DECIMAL-OUTPUT          PIC Z(3)9.
          03 BINARY-OUTPUT           PIC Z(9)9.

       PROCEDURE DIVISION.
       BEGIN.
           PERFORM IDENTICAL-STRING
               VARYING INPUT-NUMBER FROM 1 BY 1
               UNTIL OUTPUT-NUMBER IS GREATER THAN 1000.
           STOP RUN.

       IDENTICAL-STRING.
           MOVE ZERO TO BINARY-REPRESENTATION.
           MOVE 10 TO CURRENT-BIT.
           MOVE INPUT-NUMBER TO REMAINING-BITS.
           PERFORM EXTRACT-BIT UNTIL REMAINING-BITS EQUAL ZERO.
           MOVE CURRENT-BIT TO FIRST-SET-BIT.
           MOVE 10 TO SECOND-BIT.
           PERFORM COPY-BIT UNTIL SECOND-BIT IS EQUAL TO FIRST-SET-BIT.
           MOVE ZERO TO OUTPUT-NUMBER.
           IF CURRENT-BIT IS EQUAL TO ZERO, MOVE 1 TO CURRENT-BIT.
           PERFORM INSERT-BIT
               VARYING CURRENT-BIT FROM CURRENT-BIT BY 1
               UNTIL CURRENT-BIT IS GREATER THAN 10.
           MOVE OUTPUT-NUMBER TO DECIMAL-OUTPUT.
           MOVE BINARY-REPRESENTATION TO BINARY-OUTPUT.
           IF OUTPUT-NUMBER IS LESS THAN 1000,
               DISPLAY DECIMAL-OUTPUT ": " BINARY-OUTPUT.

       EXTRACT-BIT.
           DIVIDE 2 INTO REMAINING-BITS.
           IF BIT-IS-SET, MOVE 1 TO BIT(CURRENT-BIT).
           SUBTRACT 1 FROM CURRENT-BIT.
           MOVE REST TO REMAINING-BITS.

       COPY-BIT.
           MOVE BIT(SECOND-BIT) TO BIT(CURRENT-BIT).
           SUBTRACT 1 FROM SECOND-BIT.
           SUBTRACT 1 FROM CURRENT-BIT.

       INSERT-BIT.
           COMPUTE BIT-VALUE = 2 ** (10 - CURRENT-BIT)
           MULTIPLY BIT(CURRENT-BIT) BY BIT-VALUE.
           ADD BIT-VALUE TO OUTPUT-NUMBER.
Output:
   3:         11
  10:       1010
  15:       1111
  36:     100100
  45:     101101
  54:     110110
  63:     111111
 136:   10001000
 153:   10011001
 170:   10101010
 187:   10111011
 204:   11001100
 221:   11011101
 238:   11101110
 255:   11111111
 528: 1000010000
 561: 1000110001
 594: 1001010010
 627: 1001110011
 660: 1010010100
 693: 1010110101
 726: 1011010110
 759: 1011110111
 792: 1100011000
 825: 1100111001
 858: 1101011010
 891: 1101111011
 924: 1110011100
 957: 1110111101
 990: 1111011110

Cowgol

include "cowgol.coh";

sub bitLength(n: uint32): (l: uint8) is
    l := 0;
    while n != 0 loop
        n := n >> 1;
        l := l + 1;
    end loop;
end sub;

sub concatBits(n: uint32): (r: uint32) is
    r := (n << bitLength(n)) | n;
end sub;

sub printBits(n: uint32) is
    var buf: uint8[33];
    var ptr := &buf[32];
    [ptr] := 0;
    loop
        ptr := @prev ptr;
        [ptr] := '0' + (n as uint8 & 1);
        n := n >> 1;
        if n == 0 then break; end if;
    end loop;
    print(ptr);
end sub;

var n: uint32 := 1;
loop
    var r := concatBits(n);
    if r > 1000 then break; end if;
    print_i32(r);
    print(": ");
    printBits(r);
    print_nl();
    n := n + 1;
end loop;
Output:
3: 11
10: 1010
15: 1111
36: 100100
45: 101101
54: 110110
63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

Crystal

Translation of: Ruby
(0..1000).each do |i|
  bin = i.to_s(2)
  if bin.size.even?
    half = bin.size // 2
    if bin[0..half-1] == bin[half..]
      print "%3d: %10s\n" % [i, bin]
    end
  end
end
Output:
  3:         11
 10:       1010
 15:       1111
 36:     100100
 45:     101101
 54:     110110
 63:     111111
136:   10001000
153:   10011001
170:   10101010
187:   10111011
204:   11001100
221:   11011101
238:   11101110
255:   11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

Delphi

Works with: Delphi version 6.0


function IntToBinStr(IValue: Int64) : string;
{Convert integer to binary string, with no leading zero}
var I: integer;
begin
Result:='';
I:=IntPower2(32-1);
while I <> 0 do
	begin
	if (IValue and I)<>0 then Result:=Result + '1'
	else if Length(Result)>0 then Result:=Result + '0';
	I:=I shr 1;
	end;
if Result='' then Result:='0';
end;


procedure IdenticalBinaryStrings(Memo: TMemo);
var S,S1,S2: string;
var Len,I: integer;
begin
for I:=2 to 1000-1 do
	begin
	{Get binary String}
	S:=IntToBinStr(I);
	{Only look at string evenly divisible by 2}
	Len:=Length(S);
	if (Len and 1)=0 then
		begin
		{Split string into equal pieces}
		S1:=LeftStr(S,Len div 2);
		S2:=RightStr(S,Len div 2);
		{Each half should be the same}
		if S1=S2 then Memo.Lines.Add(IntToStr(I)+': '+S);
		end;
	end;
end;
Output:
3: 11
10: 1010
15: 1111
36: 100100
45: 101101
54: 110110
63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

Elapsed Time: 58.641 ms.


Draco

proc nonrec concat_self(word n) word:
    word rslt, k;
    k := n;
    rslt := n;
    while k ~= 0 do
        k := k >> 1;
        rslt := rslt << 1
    od;
    rslt | n
corp

proc nonrec main() void:
    word n, conc;
    n := 1;
    while
        conc := concat_self(n);
        conc < 1000
    do
        writeln(conc:3, ": ", conc:b:10);
        n := n + 1
    od
corp
Output:
  3:         11
 10:       1010
 15:       1111
 36:     100100
 45:     101101
 54:     110110
 63:     111111
136:   10001000
153:   10011001
170:   10101010
187:   10111011
204:   11001100
221:   11011101
238:   11101110
255:   11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

EasyLang

Translation of: BASIC256
func$ tobin k .
   if k > 0
      return tobin (k div 2) & k mod 2
   .
.
p = 2
repeat
   n += 1
   if n >= p
      p += p
   .
   k = n + n * p
   until k >= 1000
   print k & ": " & tobin k
.

F#

// Nigel Galloway. April 5th., 2021
let fN g=let rec fN g=function n when n<2->(char(n+48))::g |n->fN((char(n%2+48))::g)(n/2) in fN [] g|>Array.ofList|>System.String
Seq.unfold(fun(n,g,l)->Some((n<<<l)+n,if n=g-1 then (n+1,g*2,l+1) else (n+1,g,l)))(1,2,1)|>Seq.takeWhile((>)1000)|>Seq.iter(fun g->printfn "%3d %s" g (fN g))
Output:
  3 11
 10 1010
 15 1111
 36 100100
 45 101101
 54 110110
 63 111111
136 10001000
153 10011001
170 10101010
187 10111011
204 11001100
221 11011101
238 11101110
255 11111111
528 1000010000
561 1000110001
594 1001010010
627 1001110011
660 1010010100
693 1010110101
726 1011010110
759 1011110111
792 1100011000
825 1100111001
858 1101011010
891 1101111011
924 1110011100
957 1110111101
990 1111011110

Factor

Works with: Factor version 0.99 2021-02-05
USING: formatting kernel lists lists.lazy math math.parser
sequences ;

1 lfrom [ >bin dup append bin> ] lmap-lazy [ 1000 < ] lwhile
[ dup "%d %b\n" printf ] leach
Output:
3 11
10 1010
15 1111
36 100100
45 101101
54 110110
63 111111
136 10001000
153 10011001
170 10101010
187 10111011
204 11001100
221 11011101
238 11101110
255 11111111
528 1000010000
561 1000110001
594 1001010010
627 1001110011
660 1010010100
693 1010110101
726 1011010110
759 1011110111
792 1100011000
825 1100111001
858 1101011010
891 1101111011
924 1110011100
957 1110111101
990 1111011110

FALSE

1[$$$[$][2/\2*\]#%|$1000>~][
    $.": "
    0\10\[$1&'0+\2/$][]#%
    [$][,]#%
    1+
]#%%
Output:
3: 11
10: 1010
15: 1111
36: 100100
45: 101101
54: 110110
63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

FOCAL

01.10 S N=0
01.20 S N=N+1
01.30 D 3
01.40 I (K-1000)1.5;Q
01.50 T %3,K,": "
01.60 D 4
01.70 G 1.2
 
02.10 S BC=0;S BT=N
02.20 S BC=BC+1
02.30 S BT=FITR(BT/2)
02.40 I (-BT)2.2

03.10 D 2;S I=BC;S BT=N
03.20 S BX=FITR(BT/2)
03.30 S I=I-1
03.40 S B(I)=BT-BX*2
03.50 S BT=BX
03.60 I (-I)3.2,3.2
03.70 F I=0,BC-1;S B(BC+I)=B(I)
03.80 S BC=BC*2;S K=0
03.90 F I=0,BC-1;S K=K*2+B(I)

04.10 F I=0,BC-1;D 4.3
04.20 T !;R
04.30 I (B(I))4.4,4.5,4.4
04.40 T "1"
04.50 T "0"
Output:
=   3: 11
=  10: 1010
=  15: 1111
=  36: 100100
=  45: 101101
=  54: 110110
=  63: 111111
= 136: 10001000
= 153: 10011001
= 170: 10101010
= 187: 10111011
= 204: 11001100
= 221: 11011101
= 238: 11101110
= 255: 11111111
= 528: 1000010000
= 561: 1000110001
= 594: 1001010010
= 627: 1001110011
= 660: 1010010100
= 693: 1010110101
= 726: 1011010110
= 759: 1011110111
= 792: 1100011000
= 825: 1100111001
= 858: 1101011010
= 891: 1101111011
= 924: 1110011100
= 957: 1110111101
= 990: 1111011110

Forth

: concat-self
    dup dup
    begin dup while
        1 rshift
        swap 1 lshift swap 
    repeat
    drop or
;

: print-bits
    0 swap
    begin
        dup 1 and '0 +
        swap 1 rshift 
    dup 0= until drop
    begin dup while emit repeat drop
;

: to1000
    1 
    begin dup concat-self dup 1000 < while
        dup . 9 emit print-bits cr
        1+
    repeat
    2drop
;

to1000 bye
Output:
3       11
10      1010
15      1111
36      100100
45      101101
54      110110
63      111111
136     10001000
153     10011001
170     10101010
187     10111011
204     11001100
221     11011101
238     11101110
255     11111111
528     1000010000
561     1000110001
594     1001010010
627     1001110011
660     1010010100
693     1010110101
726     1011010110
759     1011110111
792     1100011000
825     1100111001
858     1101011010
891     1101111011
924     1110011100
957     1110111101
990     1111011110

Fortran

      program IdentStr
          implicit none
          integer n, concat, bits
          
          n = 1
  100     if (concat(n) .lt. 1000) then
              write (*,'(I3,2X,I11)') concat(n), bits(concat(n))
              n = n + 1
              goto 100
          end if
          stop
      end

C     Concatenate binary representation of number with itself      
      integer function concat(num)
          integer num, sl, sr
          sl = num
          sr = num
  100     if (sr .gt. 0) then
              sl = sl * 2
              sr = sr / 2
              goto 100
          end if
          concat = num + sl
      end

C     Calculate binary representation of number
      integer function bits(num)
          integer num, n, bx
          n = num
          bits = 0
          bx = 1
  100     if (n .gt. 0) then
              bits = bits + bx * mod(n,2)
              bx = bx * 10
              n = n / 2
              goto 100
          end if
      end
Output:
  3           11
 10         1010
 15         1111
 36       100100
 45       101101
 54       110110
 63       111111
136     10001000
153     10011001
170     10101010
187     10111011
204     11001100
221     11011101
238     11101110
255     11111111
528   1000010000
561   1000110001
594   1001010010
627   1001110011
660   1010010100
693   1010110101
726   1011010110
759   1011110111
792   1100011000
825   1100111001
858   1101011010
891   1101111011
924   1110011100
957   1110111101
990   1111011110

FreeBASIC

dim as uinteger n=1, k=0
do
    k = n + 2*n*2^int(log(n)/log(2))
    if k<1000 then print k, bin(k) else end
    n=n+1
loop
Output:
3             11
10            1010
15            1111
36            100100
45            101101
54            110110
63            111111
136           10001000
153           10011001
170           10101010
187           10111011
204           11001100
221           11011101
238           11101110
255           11111111
528           1000010000
561           1000110001
594           1001010010
627           1001110011
660           1010010100
693           1010110101
726           1011010110
759           1011110111
792           1100011000
825           1100111001
858           1101011010
891           1101111011
924           1110011100
957           1110111101
990           1111011110

Alternate

No log() function required.

dim as uinteger n = 1, k = 0, p = 2
do
    if n >= p then p = p + p
    k = n + n * p
    if k < 1000 then print k, bin(k) else end
    n = n + 1
loop
Output:

Same as log() version.

Frink

for n = 1 to 999
    if base2[n] =~ %r/^(\d+)\1$/
        println["$n\t" + base2[n]]
Output:
3	11
10	1010
15	1111
36	100100
45	101101
54	110110
63	111111
136	10001000
153	10011001
170	10101010
187	10111011
204	11001100
221	11011101
238	11101110
255	11111111
528	1000010000
561	1000110001
594	1001010010
627	1001110011
660	1010010100
693	1010110101
726	1011010110
759	1011110111
792	1100011000
825	1100111001
858	1101011010
891	1101111011
924	1110011100
957	1110111101
990	1111011110

FutureBasic

defstr byte

NSUInteger n = 1, k = 0, p = 2

while (1)
if n >= p then p += p
k = n + n * p
if k < 1000 then printf @"%4lu   %@", k, bin(k) else exit while
n++
wend

HandleEvents
Output:
   3   00000011
  10   00001010
  15   00001111
  36   00100100
  45   00101101
  54   00110110
  63   00111111
 136   10001000
 153   10011001
 170   10101010
 187   10111011
 204   11001100
 221   11011101
 238   11101110
 255   11111111
 528   00010000
 561   00110001
 594   01010010
 627   01110011
 660   10010100
 693   10110101
 726   11010110
 759   11110111
 792   00011000
 825   00111001
 858   01011010
 891   01111011
 924   10011100
 957   10111101
 990   11011110
 

Go

Translation of: Wren
package main

import (
    "fmt"
    "strconv"
)

func main() {
    i := int64(1)
    for {
        b2 := strconv.FormatInt(i, 2)
        b2 += b2
        d, _ := strconv.ParseInt(b2, 2, 64)
        if d >= 1000 {
            break
        }
        fmt.Printf("%3d : %s\n", d, b2)
        i++
    }
    fmt.Println("\nFound", i-1, "numbers.")
}
Output:
  3 : 11
 10 : 1010
 15 : 1111
 36 : 100100
 45 : 101101
 54 : 110110
 63 : 111111
136 : 10001000
153 : 10011001
170 : 10101010
187 : 10111011
204 : 11001100
221 : 11011101
238 : 11101110
255 : 11111111
528 : 1000010000
561 : 1000110001
594 : 1001010010
627 : 1001110011
660 : 1010010100
693 : 1010110101
726 : 1011010110
759 : 1011110111
792 : 1100011000
825 : 1100111001
858 : 1101011010
891 : 1101111011
924 : 1110011100
957 : 1110111101
990 : 1111011110

Found 30 numbers.

Haskell

Data.Bits

import Control.Monad (join)
import Data.Bits
  ( countLeadingZeros,
    finiteBitSize,
    shift,
    (.|.)
  )
import Text.Printf (printf)

-- Find the amount of bits required to represent a number
nBits :: Int -> Int
nBits = (-) . finiteBitSize <*> countLeadingZeros

-- Concatenate the bits of a number to itself
concatSelf :: Int -> Int
concatSelf = (.|.) =<< shift <*> nBits

-- Integers whose base-2 representation is the concatenation
-- of two identical binary strings
identStrInts :: [Int]
identStrInts = map concatSelf [1 ..]

main :: IO ()
main =
  putStr $
    unlines $
      map (join $ printf "%d: %b") to1000
  where
    to1000 = takeWhile (<= 1000) identStrInts
Output:
3: 11
10: 1010
15: 1111
36: 100100
45: 101101
54: 110110
63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

Data.Char

As an alternative to Data.Bits, we could also express this in terms of Data.Char

import Control.Monad (join)
import Data.Char (digitToInt, intToDigit)
import Numeric (showIntAtBase)


------ CONCATENATION OF TWO IDENTICAL BINARY STRINGS -----

binaryTwin :: Int -> (Int, String)
binaryTwin = ((,) =<< readBinary) . join (<>) showBinary

--------------------------- TEST -------------------------
main :: IO ()
main =
  mapM_ print $
    takeWhile ((1000 >) . fst) $
      binaryTwin <$> [1 ..]

------------------------- GENERIC ------------------------

showBinary :: Int -> String
showBinary = flip (showIntAtBase 2 intToDigit) []

readBinary :: String -> Int
readBinary s =
  snd $
    foldr
      (\c (e, n) -> (2 * e, digitToInt c * e + n))
      (1, 0)
      s
(3,"11")
(10,"1010")
(15,"1111")
(36,"100100")
(45,"101101")
(54,"110110")
(63,"111111")
(136,"10001000")
(153,"10011001")
(170,"10101010")
(187,"10111011")
(204,"11001100")
(221,"11011101")
(238,"11101110")
(255,"11111111")
(528,"1000010000")
(561,"1000110001")
(594,"1001010010")
(627,"1001110011")
(660,"1010010100")
(693,"1010110101")
(726,"1011010110")
(759,"1011110111")
(792,"1100011000")
(825,"1100111001")
(858,"1101011010")
(891,"1101111011")
(924,"1110011100")
(957,"1110111101")
(990,"1111011110")

J

(":,': ',":@#:)@(,~&.#:)"0 (>:i.30)
Output:
3: 1 1
10: 1 0 1 0
15: 1 1 1 1
36: 1 0 0 1 0 0
45: 1 0 1 1 0 1
54: 1 1 0 1 1 0
63: 1 1 1 1 1 1
136: 1 0 0 0 1 0 0 0
153: 1 0 0 1 1 0 0 1
170: 1 0 1 0 1 0 1 0
187: 1 0 1 1 1 0 1 1
204: 1 1 0 0 1 1 0 0
221: 1 1 0 1 1 1 0 1
238: 1 1 1 0 1 1 1 0
255: 1 1 1 1 1 1 1 1
528: 1 0 0 0 0 1 0 0 0 0
561: 1 0 0 0 1 1 0 0 0 1
594: 1 0 0 1 0 1 0 0 1 0
627: 1 0 0 1 1 1 0 0 1 1
660: 1 0 1 0 0 1 0 1 0 0
693: 1 0 1 0 1 1 0 1 0 1
726: 1 0 1 1 0 1 0 1 1 0
759: 1 0 1 1 1 1 0 1 1 1
792: 1 1 0 0 0 1 1 0 0 0
825: 1 1 0 0 1 1 1 0 0 1
858: 1 1 0 1 0 1 1 0 1 0
891: 1 1 0 1 1 1 1 0 1 1
924: 1 1 1 0 0 1 1 1 0 0
957: 1 1 1 0 1 1 1 1 0 1
990: 1 1 1 1 0 1 1 1 1 0

Java

public class TwoIdenticalStrings {
    public static void main(String[] args) {
        System.out.println("Decimal Binary");
        for (int i = 0; i < 1_000; i++) {
            String binStr = Integer.toBinaryString(i);
            if (binStr.length() % 2 == 0) {
                int len = binStr.length() / 2;
                if (binStr.substring(0, len).equals(binStr.substring(len))) {
                    System.out.printf("%7d %s%n", i, binStr);
                }
            }
        }
    }
}
Output:
Decimal Binary
      3 11
     10 1010
     15 1111
     36 100100
     45 101101
     54 110110
     63 111111
    136 10001000
    153 10011001
    170 10101010
    187 10111011
    204 11001100
    221 11011101
    238 11101110
    255 11111111
    528 1000010000
    561 1000110001
    594 1001010010
    627 1001110011
    660 1010010100
    693 1010110101
    726 1011010110
    759 1011110111
    792 1100011000
    825 1100111001
    858 1101011010
    891 1101111011
    924 1110011100
    957 1110111101
    990 1111011110

jq

Works with: jq

Works with gojq, the Go implementation of jq

def binary_digits:
  if . == 0 then 0
  else [recurse( if . == 0 then empty else ./2 | floor end ) % 2 | tostring]
    | reverse
    | .[1:] # remove the leading 0
    | join("")
  end ;

range(1;1000)
| . as $i
| binary_digits
| select(length % 2 == 0)
| (length/2) as $half
| select(.[$half:] == .[:$half])
| [$i, .]
Output:
[3,"11"]
[10,"1010"]
[15,"1111"]
[36,"100100"]
[45,"101101"]
[54,"110110"]
[63,"111111"]
[136,"10001000"]
[153,"10011001"]
[170,"10101010"]
[187,"10111011"]
[204,"11001100"]
[221,"11011101"]
[238,"11101110"]
[255,"11111111"]
[528,"1000010000"]
[561,"1000110001"]
[594,"1001010010"]
[627,"1001110011"]
[660,"1010010100"]
[693,"1010110101"]
[726,"1011010110"]
[759,"1011110111"]
[792,"1100011000"]
[825,"1100111001"]
[858,"1101011010"]
[891,"1101111011"]
[924,"1110011100"]
[957,"1110111101"]
[990,"1111011110"]

Julia

function twoidenticalstringsinbase(base, maxnum, verbose=true)
    found = Int[]
    for i in 1:maxnum
        dig = digits(i; base)
        k = length(dig)
        iseven(k) && dig[begin:begin+k÷2-1] == dig[begin+k÷2:end] && push!(found, i)
    end
    if verbose
        println("\nDecimal  Base $base")
        for n in found
            println(rpad(n, 9), string(n, base=base))
        end
    end
    return found
end

twoidenticalstringsinbase(2, 999)
twoidenticalstringsinbase(16, 999)
Output:
Decimal  Base 2
3        11
10       1010
15       1111
36       100100
45       101101
54       110110
63       111111
136      10001000
153      10011001
170      10101010
187      10111011
204      11001100
221      11011101
238      11101110
255      11111111
528      1000010000
561      1000110001
594      1001010010
627      1001110011
660      1010010100
693      1010110101
726      1011010110
759      1011110111
792      1100011000
825      1100111001
858      1101011010
891      1101111011
924      1110011100
957      1110111101
990      1111011110

Decimal  Base 16
17       11
34       22
51       33
68       44
85       55
102      66
119      77
136      88
153      99
170      aa
187      bb
204      cc
221      dd
238      ee
255      ff

Generator version

function twoidenticalstringsinbase(base, mx, verbose = true)
    gen = filter(x -> x < mx,
        reduce(vcat, [[i * (base^d + 1) for i in base^(d-1):base^d-1] for d in 1:ndigits(mx; base) ÷ 2]))
    if verbose
        println("\nDecimal  Base $base")
        foreach(n-> println(rpad(n, 9), string(n, base = base)), gen)
    end
    return gen
end

twoidenticalstringsinbase(2, 999)
twoidenticalstringsinbase(16, 999)
Output:
Same as filter version above.

Liberty BASIC

maxNumber = 1000
maxN = Int(Len(DecToBin$(maxNumber))/ 2)
Print "Value","    Binary"
'Since 1 is obviously not applicable,
'just count to ((2^maxN) - 2); Using "- 2" because
'we know that ((2^5) - 1) = 1023 which is > 1000
For i = 1 To ((2^maxN) - 2)
    bin$ = DecToBin$(i)
    'Let's format the output nicely
    Print (((2^Len(bin$))*i) + i),Space$((maxN * 2) - Len(bin$;bin$));bin$;bin$
Next i
End

Function DecToBin$(decNum)
    While decNum
        DecToBin$ = (decNum Mod 2);DecToBin$
        decNum = Int(decNum/ 2)
    Wend
    If (DecToBin$ = "") Then DecToBin$ = "0"
End Function
Output:
Value             Binary
3                     11
10                  1010
15                  1111
36                100100
45                101101
54                110110
63                111111
136             10001000
153             10011001
170             10101010
187             10111011
204             11001100
221             11011101
238             11101110
255             11111111
528           1000010000
561           1000110001
594           1001010010
627           1001110011
660           1010010100
693           1010110101
726           1011010110
759           1011110111
792           1100011000
825           1100111001
858           1101011010
891           1101111011
924           1110011100
957           1110111101
990           1111011110

MACRO-11

        .TITLE  IDNSTR
        .MCALL  .TTYOUT,.EXIT
IDNSTR::CLR     R4
        BR      2$
1$:     MOV     R3,R0
        JSR     PC,PRDEC
        MOV     R3,R0
        JSR     PC,PRBIN
2$:     INC     R4
        JSR     PC,IDENT
        CMP     R3,#^D1000
        BLT     1$
        .EXIT

        ; LET R3 BE R4'TH IDENTICAL NUMBER
IDENT:  MOV     R4,R3
        MOV     R4,R2
1$:     ASL     R3
        ASR     R2
        BNE     1$
        BIS     R4,R3
        RTS     PC

        ; PRINT NUMBER IN R0 AS DECIMAL
PRDEC:  MOV     #4$,R1
1$:     MOV     #-1,R2
2$:     INC     R2
        SUB     #12,R0
        BCC     2$
        ADD     #72,R0
        MOVB    R0,-(R1)
        MOV     R2,R0
        BNE     1$
3$:     MOVB    (R1)+,R0
        .TTYOUT
        BNE     3$
        RTS     PC
        .ASCII  /...../
4$:     .BYTE   11,0
        .EVEN

        ; PRINT NUMBER IN R0 AS BINARY
PRBIN:  MOV     #3$,R1
1$:     MOV     #60,R2
        ASR     R0
        ADC     R2
        MOVB    R2,-(R1)
        TST     R0
        BNE     1$
2$:     MOVB    (R1)+,R0
        .TTYOUT
        BNE     2$
        RTS     PC
        .BLKB   20
3$:     .BYTE   15,12,0
        .END    IDNSTR
Output:
3       11
10      1010
15      1111
36      100100
45      101101
54      110110
63      111111
136     10001000
153     10011001
170     10101010
187     10111011
204     11001100
221     11011101
238     11101110
255     11111111
528     1000010000
561     1000110001
594     1001010010
627     1001110011
660     1010010100
693     1010110101
726     1011010110
759     1011110111
792     1100011000
825     1100111001
858     1101011010
891     1101111011
924     1110011100
957     1110111101
990     1111011110

MAD

            NORMAL MODE IS INTEGER
            
            INTERNAL FUNCTION(BT)
            ENTRY TO BITS.
            BITN = BT
            BITRSL = 0
            BITIDX = 1
GETBIT      WHENEVER BITN.G.0
                BITNX = BITN/2
                BITRSL = BITRSL + BITIDX*(BITN-BITNX*2)
                BITN = BITNX
                BITIDX = BITIDX*10
                TRANSFER TO GETBIT
            END OF CONDITIONAL
            FUNCTION RETURN BITRSL
            END OF FUNCTION
            
            INTERNAL FUNCTION(DVAL)
            ENTRY TO DPLBIT.
            DTEMP = DVAL
            DSHFT = DVAL
DSTEP       WHENEVER DTEMP.G.0
                DSHFT = DSHFT * 2
                DTEMP = DTEMP / 2
                TRANSFER TO DSTEP
            END OF CONDITIONAL
            FUNCTION RETURN DSHFT + DVAL
            END OF FUNCTION
            
            THROUGH NUM, FOR N=1, 1, DPLBIT.(N).GE.1000
NUM         PRINT FORMAT NFMT, DPLBIT.(N), BITS.(DPLBIT.(N))

            VECTOR VALUES NFMT = $I3,2H: ,I10*$
            END OF PROGRAM
Output:
  3:         11
 10:       1010
 15:       1111
 36:     100100
 45:     101101
 54:     110110
 63:     111111
136:   10001000
153:   10011001
170:   10101010
187:   10111011
204:   11001100
221:   11011101
238:   11101110
255:   11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

Mathematica/Wolfram Language

max = 1000;
maxbin = Ceiling[Ceiling[Log2[max]]/2];
s = Table[
   id = IntegerDigits[i, 2];
   s = Join[id, id];
   {FromDigits[s, 2], StringJoin[ToString /@ s]}
   ,
   {i, 2^maxbin - 1}
   ];
Select[s, First/*LessThan[1000]] // Grid
Output:
3	11
10	1010
15	1111
36	100100
45	101101
54	110110
63	111111
136	10001000
153	10011001
170	10101010
187	10111011
204	11001100
221	11011101
238	11101110
255	11111111
528	1000010000
561	1000110001
594	1001010010
627	1001110011
660	1010010100
693	1010110101
726	1011010110
759	1011110111
792	1100011000
825	1100111001
858	1101011010
891	1101111011
924	1110011100
957	1110111101
990	1111011110

Miranda

main :: [sys_message]
main = [Stdout (lay (map display (takewhile (< 1000) identicals)))]
       where display n = shownum n ++ ": " ++ bits n

bits :: num->[char]
bits = bits' []
       where bits' acc 0 = acc
             bits' acc n = bits' (decode (48 + n mod 2) : acc) (n div 2)

identicals :: [num]
identicals = map identical [1..]

identical :: num->num
identical n = n + n * 2^size n

size :: num->num
size 0 = 0
size n = 1 + size (n div 2)
Output:
3: 11
10: 1010
15: 1111
36: 100100
45: 101101
54: 110110
63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

Modula-2

MODULE IdenticalStrings;
FROM InOut IMPORT WriteString, WriteCard, WriteLn;

VAR n: CARDINAL;

PROCEDURE identical(n: CARDINAL): CARDINAL;
    VAR shiftL, shiftR: CARDINAL;
BEGIN
    shiftL := n;
    shiftR := n;
    WHILE shiftR > 0 DO
        shiftL := shiftL * 2;
        shiftR := shiftR DIV 2;
    END;
    RETURN shiftL + n;
END identical;

PROCEDURE WriteBits(n: CARDINAL);
BEGIN
    IF n>1 THEN WriteBits(n DIV 2); END;
    WriteCard(n MOD 2, 1);
END WriteBits;

BEGIN
    n := 1;
    WHILE identical(n) < 1000 DO
        WriteCard(identical(n), 3);
        WriteString(": ");
        WriteBits(identical(n));
        WriteLn;
        INC(n);
    END;
END IdenticalStrings.
Output:
  3: 11
 10: 1010
 15: 1111
 36: 100100
 45: 101101
 54: 110110
 63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

Nim

import strformat

func isConcat(s: string): bool =
  if (s.len and 1) != 0: return false
  let half = s.len shr 1
  result = s[0..<half] == s[half..^1]

for n in 0..999:
  let b = &"{n:b}"
  if b.isConcat: echo &"{n:3} {b}"
Output:
  3 11
 10 1010
 15 1111
 36 100100
 45 101101
 54 110110
 63 111111
136 10001000
153 10011001
170 10101010
187 10111011
204 11001100
221 11011101
238 11101110
255 11111111
528 1000010000
561 1000110001
594 1001010010
627 1001110011
660 1010010100
693 1010110101
726 1011010110
759 1011110111
792 1100011000
825 1100111001
858 1101011010
891 1101111011
924 1110011100
957 1110111101
990 1111011110

OCaml

let rec bin_of_int = function
  | n when n < 2 -> string_of_int n
  | n -> Printf.sprintf "%s%u" (bin_of_int (n lsr 1)) (n land 1)

let seq_task =
  let rec next n l m () =
    if n = l
    then next n (l + l) (succ (l + l)) ()
    else Seq.Cons (n * m, next (succ n) l m)
  in next 1 2 3

let () =
  let show n = Printf.printf "%u: %s\n" n (bin_of_int n) in
  seq_task |> Seq.take_while ((>) 1000) |> Seq.iter show
Output:
3: 11
10: 1010
15: 1111
36: 100100
45: 101101
54: 110110
63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

Pascal

Works with: Turbo Pascal
program IdenticalStrings;
const
    LIMIT = 1000;
var
    n: Integer;

function BitLength(n: Integer): Integer;
    var count: Integer;
    begin
        count := 0;
        while n > 0 do
        begin
            n := n shr 1;
            count := count + 1;
        end;
        BitLength := count;
    end;

function Concat(n: Integer): Integer;
    begin
        Concat := n shl BitLength(n) or n;
    end;

procedure WriteBits(n: Integer);
    var bit: Integer;
    begin
        bit := 1 shl (BitLength(n)-1);
        while bit > 0 do
        begin
            if (bit and n) <> 0 then Write('1')
            else Write('0');
            bit := bit shr 1;
        end;
   end;

begin
   n := 1;
   while Concat(n) < LIMIT do
   begin
       Write(Concat(n));
       Write(': ');
       WriteBits(Concat(n));
       WriteLn;
       n := n + 1;
   end;
end.
Output:
3: 11
10: 1010
15: 1111
36: 100100
45: 101101
54: 110110
63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

PL/I

identstr: procedure options(main);
    bitLength: procedure(nn) returns(fixed);
        declare (n, nn, r) fixed;
        r = 0;
        do n = nn repeat(n / 2) while(n > 0);
            r = r + 1;
        end;
        return(r);
    end bitLength;
    
    concat: procedure(nn, m) returns(fixed);
        declare (i, steps, nn, n, m) fixed;
        steps = bitLength(m);
        n = nn;
        do i=1 to steps;
            n = n * 2;
        end;
        return(n + m);
    end concat;
    
    printBits: procedure(nn);
        declare (nn, n) fixed, bits char(16) varying;
        bits = '';
        do n = nn repeat(n / 2) while(n > 0);
            if mod(n,2) = 0 then
                bits = '0' || bits;
            else
                bits = '1' || bits;
        end;
        put list(bits);
    end printBits;

    declare n fixed;
    do n=1 repeat(n+1) while(concat(n,n) < 1000);
        put skip list(concat(n,n));
        call printBits(concat(n,n));
    end;
end identstr;
Output:
        3 11
       10 1010
       15 1111
       36 100100
       45 101101
       54 110110
       63 111111
      136 10001000
      153 10011001
      170 10101010
      187 10111011
      204 11001100
      221 11011101
      238 11101110
      255 11111111
      528 1000010000
      561 1000110001
      594 1001010010
      627 1001110011
      660 1010010100
      693 1010110101
      726 1011010110
      759 1011110111
      792 1100011000
      825 1100111001
      858 1101011010
      891 1101111011
      924 1110011100
      957 1110111101
      990 1111011110

PL/M

100H:

/* BINARY CONCATENATION OF A NUMBER WITH ITSELF */
CONCAT$SELF: PROCEDURE (I) ADDRESS;
    DECLARE (I,J,K) ADDRESS;
    J = I;
    K = I;
    DO WHILE J > 0;
        J = SHR(J,1);
        K = SHL(K,1);
    END;
    RETURN I OR K;
END CONCAT$SELF;

/* CP/M BDOS CALL */
BDOS: PROCEDURE (FN, ARG);
    DECLARE FN BYTE, ARG ADDRESS;
    GO TO 5;
END BDOS;

/* PRINT STRING */
PRINT: PROCEDURE (STR);
    DECLARE STR ADDRESS;
    CALL BDOS(9, STR);
END PRINT;

/* PRINT NUMBER IN GIVEN BASE (MAX 10) */
PRINT$BASE: PROCEDURE (BASE, N);
    DECLARE S (17) BYTE INITIAL ('................$');
    DECLARE N ADDRESS, BASE BYTE;
    DECLARE P ADDRESS, C BASED P BYTE;
    P = .S(16);
DIGIT:
    P = P - 1;
    C = N MOD BASE + '0';
    N = N / BASE;
    IF N > 0 THEN GO TO DIGIT;
    CALL PRINT(P);
END PRINT$BASE;

DECLARE N ADDRESS INITIAL (1);
DECLARE C ADDRESS;
DO WHILE (C := CONCAT$SELF(N)) < 1000;
    CALL PRINT$BASE(10, C);
    CALL PRINT(.(9,'$'));
    CALL PRINT$BASE(2, C);
    CALL PRINT(.(13,10,'$'));
    N = N + 1;
END;

CALL BDOS(0,0);
EOF
Output:
3       11
10      1010
15      1111
36      100100
45      101101
54      110110
63      111111
136     10001000
153     10011001
170     10101010
187     10111011
204     11001100
221     11011101
238     11101110
255     11111111
528     1000010000
561     1000110001
594     1001010010
627     1001110011
660     1010010100
693     1010110101
726     1011010110
759     1011110111
792     1100011000
825     1100111001
858     1101011010
891     1101111011
924     1110011100
957     1110111101
990     1111011110

Python

Python: Procedural

def bits(n):
    """Count the amount of bits required to represent n"""
    r = 0
    while n:
        n >>= 1
        r += 1
    return r
    
def concat(n):
    """Concatenate the binary representation of n to itself"""
    return n << bits(n) | n
    
n = 1
while concat(n) <= 1000:
    print("{0}: {0:b}".format(concat(n)))
    n += 1
Output:
3: 11
10: 1010
15: 1111
36: 100100
45: 101101
54: 110110
63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

Python: Functional

A variant composed from pure functions, as an alternative to using mutable variables and a loop.

Values are drawn, up to a limit, from a non-finite list.

'''Two identical strings'''

from itertools import count, takewhile


# binaryTwin :: Int -> (Int, String)
def binaryTwin(n):
    '''A tuple of an integer m and a string s, where
       s is a self-concatenation of the binary
       represention of n, and m is the integer value of s.
    '''
    s = bin(n)[2:] * 2
    return int(s, 2), s


# ------------------------- TEST -------------------------
def main():
    '''Numbers defined by duplicated binary sequences,
       up to a limit of decimal 1000.
    '''
    print(
        '\n'.join([
            repr(pair) for pair
            in takewhile(
                lambda x: 1000 > x[0],
                map(binaryTwin, count(1))
            )
        ])
    )


# MAIN ---
if __name__ == '__main__':
    main()
Output:
(3, '11')
(10, '1010')
(15, '1111')
(36, '100100')
(45, '101101')
(54, '110110')
(63, '111111')
(136, '10001000')
(153, '10011001')
(170, '10101010')
(187, '10111011')
(204, '11001100')
(221, '11011101')
(238, '11101110')
(255, '11111111')
(528, '1000010000')
(561, '1000110001')
(594, '1001010010')
(627, '1001110011')
(660, '1010010100')
(693, '1010110101')
(726, '1011010110')
(759, '1011110111')
(792, '1100011000')
(825, '1100111001')
(858, '1101011010')
(891, '1101111011')
(924, '1110011100')
(957, '1110111101')
(990, '1111011110')

Perl

#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Two_identical_strings
use warnings;

while( 1 )
  {
  my $binary = ( sprintf "%b", ++$- ) x 2;
  (my $decimal = oct "b$binary") >= 1000 and last;
  printf "%4d  %s\n", $decimal, $binary;
  }
Output:
   3  11
  10  1010
  15  1111
  36  100100
  45  101101
  54  110110
  63  111111
 136  10001000
 153  10011001
 170  10101010
 187  10111011
 204  11001100
 221  11011101
 238  11101110
 255  11111111
 528  1000010000
 561  1000110001
 594  1001010010
 627  1001110011
 660  1010010100
 693  1010110101
 726  1011010110
 759  1011110111
 792  1100011000
 825  1100111001
 858  1101011010
 891  1101111011
 924  1110011100
 957  1110111101
 990  1111011110

Phix

integer n = 1
sequence res = {}
while true do
    string binary = sprintf("%b%b",n)
    integer decimal = to_number(binary,0,2)
    if decimal>1000 then exit end if
    res &= {sprintf("%-4d %-10s",{decimal,binary})}
    n += 1
end while
printf(1,"Found %d numbers:\n%s\n",{n-1,join_by(res,5,6)})
Output:
Found 30 numbers:
3    11           54   110110       187  10111011     528  1000010000   693  1010110101   858  1101011010
10   1010         63   111111       204  11001100     561  1000110001   726  1011010110   891  1101111011
15   1111         136  10001000     221  11011101     594  1001010010   759  1011110111   924  1110011100
36   100100       153  10011001     238  11101110     627  1001110011   792  1100011000   957  1110111101
45   101101       170  10101010     255  11111111     660  1010010100   825  1100111001   990  1111011110

Picat

main =>
  bp.length(_L,I), 
  I > 0,
  B = to_binary_string(I),
  BB = B++B,
  parse_radix_string(BB,2) = Dec,
  ( Dec < 1000 -> printf("%4w %10w\n",Dec,BB), fail ; true),
  nl.
Output:
   3         11
  10       1010
  15       1111
  36     100100
  45     101101
  54     110110
  63     111111
 136   10001000
 153   10011001
 170   10101010
 187   10111011
 204   11001100
 221   11011101
 238   11101110
 255   11111111
 528 1000010000
 561 1000110001
 594 1001010010
 627 1001110011
 660 1010010100
 693 1010110101
 726 1011010110
 759 1011110111
 792 1100011000
 825 1100111001
 858 1101011010
 891 1101111011
 924 1110011100
 957 1110111101
 990 1111011110

Prolog

Works with: SWI Prolog
main:-
    writeln('Decimal\tBinary'),
    main(1, 1000).

main(N, Limit):-
    format(string(Binary), '~2r', N),
    string_length(Binary, Length),
    I is N + (N << Length),
    I < Limit,
    !,
    writef('%w\t%w%w\n', [I, Binary, Binary]),
    N1 is N + 1,
    main(N1, Limit).
main(_, _).
Output:
Decimal	Binary
3	11
10	1010
15	1111
36	100100
45	101101
54	110110
63	111111
136	10001000
153	10011001
170	10101010
187	10111011
204	11001100
221	11011101
238	11101110
255	11111111
528	1000010000
561	1000110001
594	1001010010
627	1001110011
660	1010010100
693	1010110101
726	1011010110
759	1011110111
792	1100011000
825	1100111001
858	1101011010
891	1101111011
924	1110011100
957	1110111101
990	1111011110

Quackery

  [ 2 base put
    number$ dup size 2 / split = 
    base release ]               is 2identical ( n --> b )

  1000 times
    [ i^ 2identical if
        [ i^ echo sp
          2 base put
          i^ echo cr
          base release ] ]
Output:
3 11
10 1010
15 1111
36 100100
45 101101
54 110110
63 111111
136 10001000
153 10011001
170 10101010
187 10111011
204 11001100
221 11011101
238 11101110
255 11111111
528 1000010000
561 1000110001
594 1001010010
627 1001110011
660 1010010100
693 1010110101
726 1011010110
759 1011110111
792 1100011000
825 1100111001
858 1101011010
891 1101111011
924 1110011100
957 1110111101
990 1111011110

Raku

my @cat = (1..*).map: { :2([~] .base(2) xx 2) };
say "{+$_} matching numbers\n{.batch(5)».map({$_ ~ .base(2).fmt('(%s)')})».fmt('%15s').join: "\n"}\n"
    given @cat[^(@cat.first: * > 1000, :k)];
Output:
30 matching numbers
          3(11)        10(1010)        15(1111)      36(100100)      45(101101)
     54(110110)      63(111111)   136(10001000)   153(10011001)   170(10101010)
  187(10111011)   204(11001100)   221(11011101)   238(11101110)   255(11111111)
528(1000010000) 561(1000110001) 594(1001010010) 627(1001110011) 660(1010010100)
693(1010110101) 726(1011010110) 759(1011110111) 792(1100011000) 825(1100111001)
858(1101011010) 891(1101111011) 924(1110011100) 957(1110111101) 990(1111011110)

REXX

/*REXX                                                                                                                    
 * program finds/displays decimal numbers                                                                                 
 * whose binary version is a doubled literal.                                                                             
 */
numeric digits 20        /*ensure 'nuff dec. digs for conversion*/
do i=1 to 1000
  b= x2b( d2x(i) ) + 0  /*find binary values that can be split.*/
  L= length(b)
  if L//2  then iterate /*get length of binary;  if odd, skip. */
  if left(b, L%2)\==right(b, L%2)  then iterate /*Left half ≡ right half?*/
  say right(i, 4)':'   right(b, 12)      /*display number in dec and bin */
end   /*i*/            /*stick a fork in it,  we're all done. */
*/
output   (shown at three-quarter size.)
   3:           11
  10:         1010
  15:         1111
  36:       100100
  45:       101101
  54:       110110
  63:       111111
 136:     10001000
 153:     10011001
 170:     10101010
 187:     10111011
 204:     11001100
 221:     11011101
 238:     11101110
 255:     11111111
 528:   1000010000
 561:   1000110001
 594:   1001010010
 627:   1001110011
 660:   1010010100
 693:   1010110101
 726:   1011010110
 759:   1011110111
 792:   1100011000
 825:   1100111001
 858:   1101011010
 891:   1101111011
 924:   1110011100
 957:   1110111101
 990:   1111011110

with formatting

/*REXX program finds/displays decimal numbers whose binary version is a doubled literal.*/
numeric digits 100                               /*ensure hangling of larger integers.  */
parse arg hi cols .                              /*obtain optional argument from the CL.*/
if   hi=='' |   hi==","  then   hi= 1000         /* "      "         "   "   "     "    */
if cols=='' | cols==","  then cols=    4         /* "      "         "   "   "     "    */
w= 20                                            /*width of a number in any column.     */
title= ' decimal integers whose binary version is a doubled binary literal, N  < '   ,
                                                                       commas(hi)
if cols>0  then say ' index │'center(title,   1 + cols*(w+1)     )
if cols>0  then say '───────┼'center(""   ,   1 + cols*(w+1), '─')
#= 0;                   idx= 1                   /*initialize # of integers and index.  */
$=                                               /*a list of  nice  primes  (so far).   */
     do j=1  for hi-1;  b= x2b( d2x(j) ) + 0     /*find binary values that can be split.*/
     L= length(b);      h= L % 2                 /*obtain length of the binary value.   */
     if L//2                      then iterate   /*Can binary version be split? No, skip*/
     if left(b, h)\==right(b, h)  then iterate   /*Left half match right half?   "    " */
     #= # + 1                                    /*bump the number of integers found.   */
     if cols<=0                   then iterate   /*Build the list  (to be shown later)? */
     c= commas(j) || '(' || b")"                 /*maybe add commas, add binary version.*/
     $= $  right(c, max(w, length(c) ) )         /*add a nice prime ──► list, allow big#*/
     if #//cols\==0               then iterate   /*have we populated a line of output?  */
     say center(idx, 7)'│'  substr($, 2);   $=   /*display what we have so far  (cols). */
     idx= idx + cols                             /*bump the  index  count for the output*/
     end   /*j*/

if $\==''  then say center(idx, 7)"│"  substr($, 2)  /*possible display residual output.*/
if cols>0  then say '───────┴'center(""   ,   1 + cols*(w+1), '─')
say
say 'Found '       commas(#)         title
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg ?;  do jc=length(?)-3  to 1  by -3; ?=insert(',', ?, jc); end;  return ?
output   when using the default inputs:
 index │    decimal integers whose binary version is a doubled binary literal, N  <  1,000
───────┼─────────────────────────────────────────────────────────────────────────────────────
   1   │                3(11)             10(1010)             15(1111)           36(100100)
   5   │           45(101101)           54(110110)           63(111111)        136(10001000)
   9   │        153(10011001)        170(10101010)        187(10111011)        204(11001100)
  13   │        221(11011101)        238(11101110)        255(11111111)      528(1000010000)
  17   │      561(1000110001)      594(1001010010)      627(1001110011)      660(1010010100)
  21   │      693(1010110101)      726(1011010110)      759(1011110111)      792(1100011000)
  25   │      825(1100111001)      858(1101011010)      891(1101111011)      924(1110011100)
  29   │      957(1110111101)      990(1111011110)
───────┴─────────────────────────────────────────────────────────────────────────────────────

Found  30  decimal integers whose binary version is a doubled binary literal, N  <  1,000

Ring

load "stdlib.ring"
 
decList = [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
baseList = ["0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F"]
 
see "working..." + nl
see "Numbers whose base 2 representation is the juxtaposition of two identical strings:" + nl
 
row = 0
limit1 = 1000
 
for n = 1 to limit1
    bin = decimaltobase(n,2)
    ln = len(bin)
    if ln & 1 = 0
       if left(bin,ln/2) = right(bin,ln/2)
          row++
          see sfl(n, 3) + " (" + sfrs(bin, 10) + ")  "
          if row % 5 = 0 see nl ok
       ok
     ok
next
 
? nl + "Found " + row + " numbers whose base 2 representation is the juxtaposition of two identical strings"
? "done..."
 
func decimaltobase(nr,base)
     binList = [] 
     binary = 0
     remainder = 1
     while(nr != 0)
          remainder = nr % base
          ind = find(decList,remainder)
          rem = baseList[ind]
          add(binList,rem)
          nr = floor(nr/base) 
     end
     binlist = reverse(binList)
     binList = list2str(binList)
     binList = substr(binList,nl,"")  
     return binList
 
# a very plain string formatter, intended to even up columnar outputs
def sfrs x, y
    l = len(x)
    x += "            "
    if l > y y = l ok
    return substr(x, 1, y)
 
# a very plain string formatter, intended to even up columnar outputs
def sfl x, y
    s = string(x) l = len(s)
    if l > y y = l ok
    return substr("          ", 11 - y + l) + s
Output:
working...
Numbers whose base 2 representation is the juxtaposition of two identical strings:
  3 (11        )   10 (1010      )   15 (1111      )   36 (100100    )   45 (101101    )
 54 (110110    )   63 (111111    )  136 (10001000  )  153 (10011001  )  170 (10101010  )
187 (10111011  )  204 (11001100  )  221 (11011101  )  238 (11101110  )  255 (11111111  )
528 (1000010000)  561 (1000110001)  594 (1001010010)  627 (1001110011)  660 (1010010100)
693 (1010110101)  726 (1011010110)  759 (1011110111)  792 (1100011000)  825 (1100111001)
858 (1101011010)  891 (1101111011)  924 (1110011100)  957 (1110111101)  990 (1111011110)

Found 30 numbers whose base 2 representation is the juxtaposition of two identical strings
done...

RPL

Slow version

Binary versions of numbers from 1 to 999 are converted into strings to check the half-half identity.

Works with: Halcyon Calc version 4.2.8
≪ R→B →STR 3 OVER SIZE 1 - SUB 
   IF DUP SIZE 2 MOD THEN DROP 0 
   ELSE 
      1 OVER SIZE 2 / SUB 
      LAST SWAP DROP 1 + OVER SIZE SUB == 
   END 
≫ ‘TWIN?' STO

≪ BIN { } 1 999 FOR n 
     IF n TWIN? 
     THEN n →STR "=" + 
          n R→B →STR 2 OVER SIZE 1 - SUB + + END NEXT 
≫ 'TASK' STO
Output:
1: { "3= 11" "10= 1010" "15= 1111" "36= 100100" "45= 101101" "54= 110110" "63= 111111" "136= 10001000" "153= 10011001" "170= 10101010" "187= 10111011" "204= 11001100" "221= 11011101" "238= 11101110" "255= 11111111" "528= 1000010000" "561= 1000110001" "594= 1001010010" "627= 1001110011" "660= 1010010100" "693= 1010110101" "726= 1011010110" "759= 1011110111" "792= 1100011000" "825= 1100111001" "858= 1101011010" "891= 1101111011" "924= 1110011100" "957= 1110111101" "990= 1111011110" }

Runs on an HP-28S in 130 seconds.

Optimized version

Translation of: FreeBASIC

40% of the code is dedicated to the display of the results.

Works with: Halcyon Calc version 4.2.8
RPL code Comment
 ≪ BIN { }
   2 1  
   DO 
     IF DUP2 ≤ THEN OVER ROT + SWAP END
     DUP2 * OVER +
     4 ROLL OVER DUP →STR "=" + 
     SWAP R→B →STR 2 OVER SIZE 1 - SUB + + 4 ROLLD
     SWAP 1 +
   UNTIL SWAP 1000 ≥ END DROP2
≫ 'TASK' STO
TASK (  -- { "results" } ) 
n = 1, p = 2
do
 if n >= p then p = p + p
   k = n + n * p
   print "k= ";
   print "bin(k)"  
   n = n + 1
loop until k ≥ 1000

Runs on an HP-28S in 6 seconds.

Ruby

Translation of: C
for i in 0 .. 1000
    bin = i.to_s(2)
    if bin.length % 2 == 0 then
        half = bin.length / 2
        if bin[0..half-1] == bin[half..] then
            print "%3d: %10s\n" % [i, bin]
        end
    end
end
Output:
  3:         11
 10:       1010
 15:       1111
 36:     100100
 45:     101101
 54:     110110
 63:     111111
136:   10001000
153:   10011001
170:   10101010
187:   10111011
204:   11001100
221:   11011101
238:   11101110
255:   11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

SETL

program identical_strings;
    loop init i := 0; doing n := ident(i +:= 1); while n<1000 do
        print(lpad(str n, 4) + lpad(binary(n), 15));
    end loop;

    proc ident(n);
        ns := n;
        loop init t := n; doing t div:= 2; until t = 0 do
            ns *:= 2;
        end loop;
        return ns + n;
    end proc;

    proc binary(n);
        return {[0,""]}(n) ? binary(n div 2) + str (n mod 2);
    end proc;
end program;
Output:
   3             11
  10           1010
  15           1111
  36         100100
  45         101101
  54         110110
  63         111111
 136       10001000
 153       10011001
 170       10101010
 187       10111011
 204       11001100
 221       11011101
 238       11101110
 255       11111111
 528     1000010000
 561     1000110001
 594     1001010010
 627     1001110011
 660     1010010100
 693     1010110101
 726     1011010110
 759     1011110111
 792     1100011000
 825     1100111001
 858     1101011010
 891     1101111011
 924     1110011100
 957     1110111101
 990     1111011110

Snobol

        define("bits(n)")                   :(bits_end)
bits    bits = gt(n,0) remdr(n,2) bits      :f(return)    
        n = n / 2                           :(bits)
bits_end

        define("concat(n)m")                :(concat_end)
concat  concat = n
        m = n
c_loop  m = gt(m,0) m / 2                   :f(c_done)
        concat = concat * 2                 :(c_loop)
c_done  concat = concat + n                 :(return)
concat_end 
         
        n = 0
loop    n = n + 1
        m = concat(n)
        output = lt(m,1000) m ": " bits(m)  :s(loop)
end
Output:
3: 11
10: 1010
15: 1111
36: 100100
45: 101101
54: 110110
63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

Swift

print("Decimal\tBinary")
var n = 1
while (true) {
    let binary = String(n, radix: 2)
    let i = n + (n << binary.count)
    if i >= 1000 {
        break
    }
    print("\(i)\t\(binary)\(binary)")
    n += 1
}
Output:
Decimal	Binary
3	11
10	1010
15	1111
36	100100
45	101101
54	110110
63	111111
136	10001000
153	10011001
170	10101010
187	10111011
204	11001100
221	11011101
238	11101110
255	11111111
528	1000010000
561	1000110001
594	1001010010
627	1001110011
660	1010010100
693	1010110101
726	1011010110
759	1011110111
792	1100011000
825	1100111001
858	1101011010
891	1101111011
924	1110011100
957	1110111101
990	1111011110

Visual Basic .NET

Translation of: FreeBASIC
Based on the Alternate version.
Imports System.Console
Module Module1
  Sub Main()
    Dim p, c, k, lmt as integer : p = 2 : lmt = 1000
    For n As Integer = 1 to lmt
      p += If(n >= p, p, 0) : k = n + n * p
      If k > lmt Then Exit For Else c += 1
      Write("{0,3} ({1,-10})  {2}", k, Convert.ToString( k, 2),
          If(c Mod 5 = 0, vbLf, ""))
    Next : WriteLine(vbLf + "Found {0} numbers whose base 2 representation is the concatenation of two identical binary strings.", c)
  End Sub
End Module
Output:
  3 (11        )   10 (1010      )   15 (1111      )   36 (100100    )   45 (101101    )  
 54 (110110    )   63 (111111    )  136 (10001000  )  153 (10011001  )  170 (10101010  )  
187 (10111011  )  204 (11001100  )  221 (11011101  )  238 (11101110  )  255 (11111111  )  
528 (1000010000)  561 (1000110001)  594 (1001010010)  627 (1001110011)  660 (1010010100)  
693 (1010110101)  726 (1011010110)  759 (1011110111)  792 (1100011000)  825 (1100111001)  
858 (1101011010)  891 (1101111011)  924 (1110011100)  957 (1110111101)  990 (1111011110)  

Found 30 numbers whose base 2 representation is the concatenation of two identical binary strings.

V (Vlang)

Translation of: Go
import strconv
 
fn main() {
    mut i := i64(1)
    for {
        mut b2 := '${i:b}'
        b2 += b2
        d := strconv.parse_int(b2,2,16) ?
        if d >= 1000 {
            break
        }
        println("$d : $b2")
        i++
    }
    println("\nFound ${i-1} numbers.")
}
Output:
3 : 11
10 : 1010
15 : 1111
36 : 100100
45 : 101101
54 : 110110
63 : 111111
136 : 10001000
153 : 10011001
170 : 10101010
187 : 10111011
204 : 11001100
221 : 11011101
238 : 11101110
255 : 11111111
528 : 1000010000
561 : 1000110001
594 : 1001010010
627 : 1001110011
660 : 1010010100
693 : 1010110101
726 : 1011010110
759 : 1011110111
792 : 1100011000
825 : 1100111001
858 : 1101011010
891 : 1101111011
924 : 1110011100
957 : 1110111101
990 : 1111011110

Found 30 numbers.

Wren

Library: Wren-fmt
import "./fmt" for Conv, Fmt

var i = 1
while(true) {
    var b2 = Conv.itoa(i, 2)
    b2 = b2 + b2
    var d = Conv.atoi(b2, 2)
    if (d >= 1000) break
    Fmt.print("$3d : $s", d, b2)
    i = i + 1
}
System.print("\nFound %(i-1) numbers.")
Output:
  3 : 11
 10 : 1010
 15 : 1111
 36 : 100100
 45 : 101101
 54 : 110110
 63 : 111111
136 : 10001000
153 : 10011001
170 : 10101010
187 : 10111011
204 : 11001100
221 : 11011101
238 : 11101110
255 : 11111111
528 : 1000010000
561 : 1000110001
594 : 1001010010
627 : 1001110011
660 : 1010010100
693 : 1010110101
726 : 1011010110
759 : 1011110111
792 : 1100011000
825 : 1100111001
858 : 1101011010
891 : 1101111011
924 : 1110011100
957 : 1110111101
990 : 1111011110

Found 30 numbers.

XPL0

proc BinOut(N);         \Output N in binary
int  N, Rem;
[Rem:= N&1;
N:= N>>1;
if N then BinOut(N);
ChOut(0, Rem+^0);
];

int H, N, M;
[for H:= 1 to 31 do
    [N:= H;  M:= H;
    while M do
        [N:= N<<1;  M:= M>>1];
    N:= N+H;
    if N < 1000 then
        [IntOut(0, N);
        Text(0, ": ");
        BinOut(N);
        CrLf(0);
        ];
    ];
]
Output:
3: 11
10: 1010
15: 1111
36: 100100
45: 101101
54: 110110
63: 111111
136: 10001000
153: 10011001
170: 10101010
187: 10111011
204: 11001100
221: 11011101
238: 11101110
255: 11111111
528: 1000010000
561: 1000110001
594: 1001010010
627: 1001110011
660: 1010010100
693: 1010110101
726: 1011010110
759: 1011110111
792: 1100011000
825: 1100111001
858: 1101011010
891: 1101111011
924: 1110011100
957: 1110111101
990: 1111011110

Yabasic

// Rosetta Code problem: http://rosettacode.org/wiki/Two_identical_strings
// by Galileo, 04/2022

for n = 1 to 1000
    n$ = bin$(n)
    if not mod(len(n$), 2) then
        k = len(n$) / 2
        if left$(n$, k) = right$(n$, k) print n, " = ", n$
    endif
next
Output:
3 = 11
10 = 1010
15 = 1111
36 = 100100
45 = 101101
54 = 110110
63 = 111111
136 = 10001000
153 = 10011001
170 = 10101010
187 = 10111011
204 = 11001100
221 = 11011101
238 = 11101110
255 = 11111111
528 = 1000010000
561 = 1000110001
594 = 1001010010
627 = 1001110011
660 = 1010010100
693 = 1010110101
726 = 1011010110
759 = 1011110111
792 = 1100011000
825 = 1100111001
858 = 1101011010
891 = 1101111011
924 = 1110011100
957 = 1110111101
990 = 1111011110
---Program done, press RETURN---