Exactly three adjacent 3 in lists

From Rosetta Code
Exactly three adjacent 3 in lists 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

Given 5 lists of ints:
list[1] = [9,3,3,3,2,1,7,8,5]
list[2] = [5,2,9,3,3,7,8,4,1]
list[3] = [1,4,3,6,7,3,8,3,2]
list[4] = [1,2,3,4,5,6,7,8,9]
list[5] = [4,6,8,7,2,3,3,3,1]

For each list, print 'true' if the list contains exactly three '3's that form a consecutive subsequence, otherwise print 'false'.

11l

V lists = [[9,3,3,3,2,1,7,8,5],
           [5,2,9,3,3,7,8,4,1],
           [1,4,3,6,7,3,8,3,2],
           [1,2,3,4,5,6,7,8,9],
           [4,6,8,7,2,3,3,3,1]]

L(l) lists
   print(l, end' ‘ -> ’)
   L(i) 0 .< l.len - 2
      I l[i] == l[i + 1] == l[i + 2] == 3
         print(‘True’)
         L.break
   L.was_no_break
      print(‘False’)
Output:
[9, 3, 3, 3, 2, 1, 7, 8, 5] -> True
[5, 2, 9, 3, 3, 7, 8, 4, 1] -> False
[1, 4, 3, 6, 7, 3, 8, 3, 2] -> False
[1, 2, 3, 4, 5, 6, 7, 8, 9] -> False
[4, 6, 8, 7, 2, 3, 3, 3, 1] -> True

8080 Assembly

	org	100h
	jmp	demo
	;;;	See if the list at [HL] with length DE has three 
	;;;	consecutive 3s.
	;;;	Returns with zero flag set if the list as three 3s,
	;;;	clear if not.
three3:	lxi	b,3		; B = threes seen, C holds a 3
t_loop:	mov	a,m		; Get next element
	inx	h
	cmp	c		; A three?
	jz	three
	mov	a,b		; Not a three, not part of sequence
	cmp	c		; So we must have seen either three 3s,
	jz	t_next
	ora	a		; or none at all
	rnz 
t_next:	dcx	d		; Are we at the end yet?
	mov	a,d
	ora	e
	rz
	jmp	t_loop		; If not, keep going
three:	inr	b		; A three - count it	
	mov	a,c		; But see if we don't have too many 3s	
	cmp	b
	rc			; If too many 3s, stop
	jmp	t_next
	;;;	Test the given lists and print "true" or "false"
demo:	lxi	h,lists		; List pointer
d_loop:	mov	e,m		; Load pointer to next list
	inx	h
	mov	d,m
	inx	h
	mov	a,d		; If at the end, stop 
	ora	e 
	rz
	push	h		; Otherwise, keep the pointer
	xchg
	lxi	d,9		; The lists are all of length 9
	call	three3		; See if the list matches
	mvi	c,9		; CP/M 'puts'
	lxi	d,true		; Print true or false
	jz	d_prn
	lxi	d,false
d_prn:	call	5
	pop	h		; Get the list pointer back
	jmp 	d_loop		; Next list
true:	db	"true $"
false:	db	"false $"
	;;;	Lists
lists:	dw	list1,list2,list3,list4,list5,0
list1: 	db	9,3,3,3,2,1,7,8,5
list2:	db	5,2,9,3,3,7,8,4,1
list3:	db	1,4,3,6,7,3,8,3,2
list4:	db	1,2,3,4,5,6,7,8,9
list5:	db	4,6,8,7,2,3,3,3,1
Output:
true false false false true

Ada

with Ada.Text_Io;  use Ada.Text_Io;

procedure Exactly_3 is

   type List_Type is array (Positive range <>) of Integer;

   function Has_3_Consecutive (List : List_Type) return Boolean is
      Conseq : constant Natural := 3;
      Match  : constant Integer := 3;
      Count  : Natural := 0;
   begin
      for Element of List loop
         if Element = Match then
            Count := Count + 1;
         else
            if Count = Conseq then
               return True;
            else
               Count := 0;
            end if;
         end if;
      end loop;
      return (Count = Conseq);
   end Has_3_Consecutive;

   procedure Put (List : List_Type) is
   begin
      Put ("[");
      for Element of List loop
         Put (Integer'Image (Element));
         Put (" ");
      end loop;
      Put ("]");
   end Put;

   procedure Test (List : List_Type) is
      Result : constant Boolean := Has_3_Consecutive (List);
   begin
      Put (List);
      Put (" -> ");
      Put (Boolean'Image (Result));
      New_Line;
   end Test;

begin
   Test ((9,3,3,3,2,1,7,8,5));
   Test ((5,2,9,3,3,7,8,4,1));
   Test ((1,4,3,6,7,3,8,3,2));
   Test ((1,2,3,4,5,6,7,8,9));
   Test ((4,6,8,7,2,3,3,3,1));

   Test ((4,6,8,7,2,3,3,3,3)); -- Four tailing
   Test ((4,6,8,7,2,1,3,3,3)); -- Three tailing
   Test ((1,3,3,3,3,4,5,8,9));

   Test ((3,3,3,3));
   Test ((3,3,3));
   Test ((3,3));
   Test ((1 => 3));        -- One element
   Test ((1 .. 0 => <>));  -- No elements
end Exactly_3;
Output:
[ 9  3  3  3  2  1  7  8  5 ] -> TRUE
[ 5  2  9  3  3  7  8  4  1 ] -> FALSE
[ 1  4  3  6  7  3  8  3  2 ] -> FALSE
[ 1  2  3  4  5  6  7  8  9 ] -> FALSE
[ 4  6  8  7  2  3  3  3  1 ] -> TRUE
[ 4  6  8  7  2  3  3  3  3 ] -> FALSE
[ 4  6  8  7  2  1  3  3  3 ] -> TRUE
[ 1  3  3  3  3  4  5  8  9 ] -> FALSE
[ 3  3  3  3 ] -> FALSE
[ 3  3  3 ] -> TRUE
[ 3  3 ] -> FALSE
[ 3 ] -> FALSE
[] -> FALSE

ALGOL 68

Including the extra test cases from the Raku and Wren samples.

BEGIN # test lists contain exactly 3 threes and that they are adjacent #
    []INT   list1 = ( 9, 3, 3, 3, 2, 1, 7, 8, 5 ); # task test case  #
    []INT   list2 = ( 5, 2, 9, 3, 3, 7, 8, 4, 1 ); #   "    "    "   #
    []INT   list3 = ( 1, 4, 3, 6, 7, 3, 8, 3, 2 ); #   "    "    "   #
    []INT   list4 = ( 1, 2, 3, 4, 5, 6, 7, 8, 9 ); #   "    "    "   #
    []INT   list5 = ( 4, 6, 8, 7, 2, 3, 3, 3, 1 ); #   "    "    "   #
    []INT   list6 = ( 3, 3, 3, 1, 2, 4, 5, 1, 3 ); # additional test from the Raku/Wren sample #
    []INT   list7 = ( 0, 3, 3, 3, 3, 7, 2, 2, 6 ); # additional test from the Raku/Wren sample #
    []INT   list8 = ( 3, 3, 3, 3, 3, 4, 4, 4, 4 ); # additional test from the Raku/Wren sample #
    [][]INT lists = ( list1, list2, list3, list4, list5, list6, list7, list8 );
    FOR l pos FROM LWB lists TO UPB lists DO
        []INT list       = lists[ l pos ];
        INT   threes    := 0;  # number of threes in the list #
        INT   three pos := 0;  # position of the last three in the list #
        BOOL  list ok   := FALSE;
        FOR e pos FROM LWB list TO UPB list DO
            IF list[ e pos ] = 3 THEN
                threes   +:= 1;
                three pos := e pos
            FI
        OD;
        IF threes = 3 THEN
            # exactly 3 threes - check they are adjacent #
            list ok := ( list[ three pos - 1 ] = 3 AND list[ three pos - 2 ] = 3 )
        FI;
        # show the result #
        print( ( "[" ) );
        FOR e pos FROM LWB list TO UPB list DO
            print( ( " ", whole( list[ e pos ], 0 ) ) )
        OD;
        print( ( " ] -> ", IF list ok THEN "true" ELSE "false" FI, newline ) )
    OD
END
Output:
[ 9 3 3 3 2 1 7 8 5 ] -> true
[ 5 2 9 3 3 7 8 4 1 ] -> false
[ 1 4 3 6 7 3 8 3 2 ] -> false
[ 1 2 3 4 5 6 7 8 9 ] -> false
[ 4 6 8 7 2 3 3 3 1 ] -> true
[ 3 3 3 1 2 4 5 1 3 ] -> false
[ 0 3 3 3 3 7 2 2 6 ] -> false
[ 3 3 3 3 3 4 4 4 4 ] -> false

AppleScript

------- EXACTLY N INSTANCES OF N AND ALL CONTIGUOUS ------

-- nnPeers :: Int -> [Int] -> Bool
on nnPeers(n)
    script p
        on |λ|(x)
            n = x
        end |λ|
    end script
    
    script notP
        on |λ|(x)
            n  x
        end |λ|
    end script
    
    script
        on |λ|(xs)
            set {contiguous, residue} to ¬
                span(p, dropWhile(notP, xs))
            
            n = length of contiguous and ¬
                all(notP, residue)
        end |λ|
    end script
end nnPeers


--------------------------- TEST -------------------------
on run
    set xs to [¬
        [9, 3, 3, 3, 2, 1, 7, 8, 5], ¬
        [5, 2, 9, 3, 3, 7, 8, 4, 1], ¬
        [1, 4, 3, 6, 7, 3, 8, 3, 2], ¬
        [1, 2, 3, 4, 5, 6, 7, 8, 9], ¬
        [4, 6, 8, 7, 2, 3, 3, 3, 1]]
    
    set p to nnPeers(3)
    
    script test
        on |λ|(x)
            showList(x) & " -> " & p's |λ|(x)
        end |λ|
    end script
    
    unlines(map(test, xs))
end run


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

-- all :: (a -> Bool) -> [a] -> Bool
on all(p, xs)
    -- True if p holds for every value in xs
    tell mReturn(p)
        set lng to length of xs
        repeat with i from 1 to lng
            if not |λ|(item i of xs, i, xs) then return false
        end repeat
        true
    end tell
end all


-- dropWhile :: (a -> Bool) -> [a] -> [a]
-- dropWhile :: (Char -> Bool) -> String -> String
on dropWhile(p, xs)
    set lng to length of xs
    set i to 1
    tell mReturn(p)
        repeat while i  lng and |λ|(item i of xs)
            set i to i + 1
        end repeat
    end tell
    items i thru -1 of xs
end dropWhile


-- intercalate :: String -> [String] -> String
on intercalate(delim, xs)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, delim}
    set s to xs as text
    set my text item delimiters to dlm
    s
end intercalate


-- 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


-- showList :: [a] -> String
on showList(xs)
    "[" & intercalate(", ", map(my str, xs)) & "]"
end showList


-- span :: (a -> Bool) -> [a] -> ([a], [a])
on span(p, xs)
    -- The longest (possibly empty) prefix of xs
    -- that contains only elements satisfying p,
    -- tupled with the remainder of xs.
    -- span(p, xs) eq (takeWhile(p, xs), dropWhile(p, xs)) 
    script go
        property mp : mReturn(p)
        on |λ|(vs)
            if {}  vs then
                set x to item 1 of vs
                if |λ|(x) of mp then
                    set {ys, zs} to |λ|(rest of vs)
                    {{x} & ys, zs}
                else
                    {{}, vs}
                end if
            else
                {{}, {}}
            end if
        end |λ|
    end script
    |λ|(xs) of go
end span


-- str :: a -> String
on str(x)
    x as string
end str


-- 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:
[9, 3, 3, 3, 2, 1, 7, 8, 5] -> true
[5, 2, 9, 3, 3, 7, 8, 4, 1] -> false
[1, 4, 3, 6, 7, 3, 8, 3, 2] -> false
[1, 2, 3, 4, 5, 6, 7, 8, 9] -> false
[4, 6, 8, 7, 2, 3, 3, 3, 1] -> true

AutoHotkey

lists := [[9, 3, 3, 3, 2, 1, 7, 8, 5]
        , [5, 2, 9, 3, 3, 7, 8, 4, 1]
        , [1, 4, 3, 6, 7, 3, 8, 3, 2]
        , [1, 2, 3, 4, 5, 6, 7, 8, 9]
        , [4, 6, 8, 7, 2, 3, 3, 3, 1]]

L := []
for i, list in lists
{
    c := cnsctv := 0
    for j, v in list
    {
        cnsctv := (list[j] = 3 && list[j+1] = 3 && list[j+2] = 3) ? true : cnsctv
        c += (v = 3) ? 1 : 0
        L[i] .= (L[i] ? ", " : "" ) . v 
    }
    result .= "[" L[i] "] : " (cnsctv && c=3 ? "true" : "false") "`n"
}
MsgBox % result
Output:
[9, 3, 3, 3, 2, 1, 7, 8, 5] : true
[5, 2, 9, 3, 3, 7, 8, 4, 1] : false
[1, 4, 3, 6, 7, 3, 8, 3, 2] : false
[1, 2, 3, 4, 5, 6, 7, 8, 9] : false
[4, 6, 8, 7, 2, 3, 3, 3, 1] : true

AWK

# syntax: GAWK -f EXACTLY_THREE_ADJACENT_3_IN_LISTS.AWK
BEGIN {
    list[++n] = "9,3,3,3,2,1,7,8,5"
    list[++n] = "5,2,9,3,3,7,8,4,1"
    list[++n] = "1,4,3,6,7,3,8,3,2"
    list[++n] = "1,2,3,4,5,6,7,8,9"
    list[++n] = "4,6,8,7,2,3,3,3,1"
    for (i=1; i<=n; i++) {
      tmp = "," list[i] ","
      printf("%s %s\n",sub(/,3,3,3,/,"",tmp)?"T":"F",list[i])
    }
    exit(0)
}
Output:
T 9,3,3,3,2,1,7,8,5
F 5,2,9,3,3,7,8,4,1
F 1,4,3,6,7,3,8,3,2
F 1,2,3,4,5,6,7,8,9
T 4,6,8,7,2,3,3,3,1

BASIC

Applesoft BASIC

The GW-BASIC solution works without any changes.

BASIC256

arraybase 1
dim list(5, 9)
list = {{9,3,3,3,2,1,7,8,5}, {5,2,9,3,3,7,8,4,1},{1,4,3,6,7,3,8,3,2}, {1,2,3,4,5,6,7,8,9},{4,6,8,7,2,3,3,3,1}}

for i = 1 to list[?][]
	go = false
	pass = true
	c = 0
	for j = 1 to list[][?]
		if list[i, j] = 3 then
			c+=1
			go = true
		else
			if go = true and c <> 3 then pass = false
			go = false
		end if
	next j
	print i; "   ";
	if c = 3 and pass then print "true" else print "false"
next i
Output:
Similar to FreeBASIC entry.

Chipmunk Basic

Works with: Chipmunk Basic version 3.6.4
100 cls
110 data 9,3,3,3,2,1,7,8,5
120 data 5,2,9,3,3,7,8,4,1
130 data 1,4,3,6,7,3,8,3,2
140 data 1,2,3,4,5,6,7,8,9
150 data 4,6,8,7,2,3,3,3,1
160 dim lista(5,9)
170 for i = 1 to ubound(lista)
180  for j = 1 to ubound(lista,2)
190   read lista(i,j)
200  next j
210 next i
220 for i = 1 to ubound(lista)
230  go = false
240  pass = true
250  c = 0
260  for j = 1 to ubound(lista,2)
270   if lista(i,j) = 3 then
280    c = c+1
290    go = true
300   else
310    if go = true and c <> 3 then pass = false
320    go = false
330   endif
340  next j
350  print i;"   ";
360  if c = 3 and pass then print "True" else print "False"
370 next i
380 end
Output:
Similar to FreeBASIC entry.

GW-BASIC

Works with: Applesoft BASIC
Works with: Chipmunk Basic
Works with: PC-BASIC version any
Works with: QBasic
Works with: Quite BASIC
100 CLS : rem  100 HOME for Applesoft BASIC
110 LET f = 0
115 LET t = 1
120 DATA 9,3,3,3,2,1,7,8,5
130 DATA 5,2,9,3,3,7,8,4,1
140 DATA 1,4,3,6,7,3,8,3,2
150 DATA 1,2,3,4,5,6,7,8,9
160 DATA 4,6,8,7,2,3,3,3,1
170 DIM l(5,9)
180 FOR i = 1 TO 5
190  FOR j = 1 TO 9
200   READ l(i,j)
210  NEXT j
220 NEXT i
230 FOR i = 1 TO 5
240  LET g = f
250  LET p = t
260  LET c = 0
270  FOR j = t TO 9
280   IF l(i,j) = 3 THEN LET c = c+1 
281   IF l(i,j) = 3 THEN LET g = t
282   IF l(i,j) <> 3 THEN GOSUB 340
283   IF l(i,j) <> 3 THEN LET g = f
290  NEXT j
300  PRINT i; "   ";
310  IF c = 3 AND p = t THEN PRINT "true"
315  IF c <> 3 OR p <> t THEN PRINT "false"
320 NEXT i
330 END
340 IF g = t AND c <> 3 THEN LET p = f
350 RETURN
Output:
Similar to FreeBASIC entry.

Minimal BASIC

Works with: QBasic
Works with: QuickBasic
Works with: Applesoft BASIC
Works with: BASICA
Works with: Chipmunk Basic
Works with: GW-BASIC
Works with: MSX BASIC version any
Translation of: Chipmunk Basic
100 LET F = 0
110 LET T = 1
120 DATA 9,3,3,3,2,1,7,8,5
130 DATA 5,2,9,3,3,7,8,4,1
140 DATA 1,4,3,6,7,3,8,3,2
150 DATA 1,2,3,4,5,6,7,8,9
160 DATA 4,6,8,7,2,3,3,3,1
170 DIM L(5,9)
180 FOR I = 1 TO 5
190  FOR J = 1 TO 9
200   READ L(I,J)
210  NEXT J
220 NEXT I
230 FOR I = 1 TO 5
240  LET G = F
250  LET P = T
260  LET C = 0
270  FOR J = T TO 9
280   IF L(I,J) = 3 THEN 300
290   IF L(I,J) <> 3 THEN 330
300   LET C = C + 1
310   LET G = T
320   GOTO 390
330   IF G = T THEN 360
340   LET G = F
350   GOTO 390
360   IF C <> 3 THEN 380
370   GOTO 390
380   LET P = F
390  NEXT J
400  PRINT I; "   ";
410  IF C = 3 THEN 430
420  GOTO 440
430  IF P = T THEN 460
440  IF C <> 3 THEN 480
450  IF P <> T THEN 480
460  PRINT "TRUE"
470  GOTO 490
480  PRINT "FALSE"
490 NEXT I
500 END
Output:
Similar to FreeBASIC entry.

MSX Basic

Works with: MSX BASIC version any
100 CLS
110 false = 0 : true = 1
120 DATA 9,3,3,3,2,1,7,8,5
130 DATA 5,2,9,3,3,7,8,4,1
140 DATA 1,4,3,6,7,3,8,3,2
150 DATA 1,2,3,4,5,6,7,8,9
160 DATA 4,6,8,7,2,3,3,3,1
170 DIM lis(5,9)
180 FOR i = 1 TO 5
190  FOR j = 1 TO 9
200   READ lis(i,j)
210  NEXT j
220 NEXT i
230 FOR i = 1 TO 5
240  go = false
250  pass = true
260  c = 0
270  FOR j = true TO 9
280   IF lis(i,j) = 3 THEN c = c+1 : go = true ELSE GOSUB 340 : go = false
290  NEXT j
300  PRINT i;"   ";
310  IF c = 3 AND pass = true THEN PRINT "true" ELSE PRINT "false"
320 NEXT i
330 END
340 IF go = true AND c <> 3 THEN pass = false
350 RETURN
Output:
Similar to FreeBASIC entry.

PureBasic

OpenConsole()

Dim lista.i(5, 9)
Define.b go, pass
Define.i i, j, c

For i = 1 To ArraySize(lista())
  For j = 1 To ArraySize(lista(),2)
    Read.i lista(i,j)
  Next j
Next i

For i = 1 To ArraySize(lista())
  go = #False
  pass = #True
  c = 0
  For j = 1 To ArraySize(lista(),2)
    If lista(i, j) = 3:
      c + 1
      go = #True
    Else
      If go = #True And c <> 3: 
        pass = #False 
      EndIf
      go = #False
    EndIf
  Next j
  Print(Str(i) + #TAB$)
  If c = 3 And pass = #True:
    PrintN("True")
  Else 
    PrintN("False")
  EndIf
Next i

PrintN(#CRLF$ + "--- terminado, pulsa RETURN---"): Input()
CloseConsole()

DataSection
  Data.i 9,3,3,3,2,1,7,8,5
  Data.i 5,2,9,3,3,7,8,4,1
  Data.i 1,4,3,6,7,3,8,3,2
  Data.i 1,2,3,4,5,6,7,8,9
  Data.i 4,6,8,7,2,3,3,3,1
EndDataSection
Output:
Similar to FreeBASIC entry.

QBasic

Works with: QBasic version 1.1
Works with: QuickBasic version 4.5
CONST False = 0: True = NOT False

DATA 9,3,3,3,2,1,7,8,5
DATA 5,2,9,3,3,7,8,4,1
DATA 1,4,3,6,7,3,8,3,2
DATA 1,2,3,4,5,6,7,8,9
DATA 4,6,8,7,2,3,3,3,1
DIM lista(1 TO 5, 1 TO 9) AS INTEGER
FOR i = 1 TO UBOUND(lista)
    FOR j = 1 TO UBOUND(lista, 2)
        READ lista(i, j)
    NEXT j
NEXT i

FOR i = 1 TO UBOUND(lista)
    go = False
    pass = True
    c = 0
    FOR j = 1 TO UBOUND(lista, 2)
        IF lista(i, j) = 3 THEN
            c = c + 1
            go = True
        ELSE
            IF go = True AND c <> 3 THEN pass = False
            go = False
        END IF
    NEXT j
    PRINT i; "   ";
    IF c = 3 AND pass THEN PRINT "True" ELSE PRINT "False"
NEXT i
Output:
Similar to FreeBASIC entry.

Quite BASIC

The GW-BASIC solution works without any changes.

True BASIC

DIM lista(5, 9)
DATA 9, 3, 3, 3, 2, 1, 7, 8, 5
DATA 5, 2, 9, 3, 3, 7, 8, 4, 1
DATA 1, 4, 3, 6, 7, 3, 8, 3, 2
DATA 1, 2, 3, 4, 5, 6, 7, 8, 9
DATA 4, 6, 8, 7, 2, 3, 3, 3, 1
FOR i = 1 TO UBOUND(lista,1)
    FOR j = 1 TO UBOUND(lista,2)
        READ lista(i, j)
    NEXT j
NEXT i

FOR i = 1 TO UBOUND(lista,1)
    LET go = 0
    LET pass = 1
    LET c = 0
    FOR j = 1 TO UBOUND(lista,2)
        IF lista(i, j) = 3 THEN
           LET c = c + 1
           LET go = 1
        ELSE
           IF go = 1 AND c <> 3 THEN LET pass = 0
           LET go = 0
        END IF
    NEXT j
    PRINT i; "   ";
    IF c = 3 AND pass <> 0 THEN PRINT "True" ELSE PRINT "False"
NEXT i
END
Output:
Similar to FreeBASIC entry.

Yabasic

dim lista(5, 9)
data 9,3,3,3,2,1,7,8,5
data 5,2,9,3,3,7,8,4,1
data 1,4,3,6,7,3,8,3,2
data 1,2,3,4,5,6,7,8,9
data 4,6,8,7,2,3,3,3,1

for i = 1 to arraysize(lista(),1)
    for j = 1 to arraysize(lista(),2)
        read lista(i,j)
    next j
next i

for i = 1 to arraysize(lista(),1)
	go = false
	pass = true
	c = 0
	for j = 1 to arraysize(lista(),2)
		if lista(i, j) = 3 then
			c = c + 1
			go = true
        else
			if go = true and c <> 3  pass = false
			go = false
        end if
    next j
	print i, "   ";
	if c = 3 and pass then print "True" else print "False" : fi
next i
Output:
Similar to FreeBASIC entry.

C

#include <stdio.h>
#include <stdbool.h>

bool three_3s(const int *items, size_t len) {
    int threes = 0;    
    while (len--) 
        if (*items++ == 3)
            if (threes<3) threes++;
            else return false;
        else if (threes != 0 && threes != 3) 
            return false;
    return true;
}

void print_list(const int *items, size_t len) {
    while (len--) printf("%d ", *items++);
}

int main() {
    int lists[][9] = {
        {9,3,3,3,2,1,7,8,5},
        {5,2,9,3,3,6,8,4,1},
        {1,4,3,6,7,3,8,3,2},
        {1,2,3,4,5,6,7,8,9},
        {4,6,8,7,2,3,3,3,1}
    };
    
    size_t list_length = sizeof(lists[0]) / sizeof(int);
    size_t n_lists = sizeof(lists) / sizeof(lists[0]);
    
    for (size_t i=0; i<n_lists; i++) {
        print_list(lists[i], list_length);
        printf("-> %s\n", three_3s(lists[i], list_length) ? "true" : "false");
    }
    
    return 0;
}
Output:
9 3 3 3 2 1 7 8 5 -> true
5 2 9 3 3 6 8 4 1 -> false
1 4 3 6 7 3 8 3 2 -> false
1 2 3 4 5 6 7 8 9 -> false
4 6 8 7 2 3 3 3 1 -> true

CLU

% See if a sequence has three consecutive 3s in it
% Works for any type that can be iterated over 
three_3s = proc [T: type] (seq: T) returns (bool)
           where T has elements: itertype (T) yields (int)
    threes: int := 0
    
    for n: int in T$elements(seq) do
        if n=3 then
            if threes<3 then threes := threes + 1
            else return(false)
            end
        else
            if threes~=0 & threes~=3 then 
                return(false) 
            end
        end
    end
    return(true)
end three_3s

start_up = proc () 
    si = sequence[int]
    ssi = sequence[si]
    
    lists: ssi := ssi$[
        si$[9,3,3,3,2,1,7,8,5],
        si$[5,2,9,3,3,6,8,4,1],
        si$[1,4,3,6,7,3,8,3,2],
        si$[1,2,3,4,5,6,7,8,9],
        si$[4,6,8,7,2,3,3,3,1]
    ]
    
    po: stream := stream$primary_output()
    for list: si in ssi$elements(lists) do
        for i: int in si$elements(list) do
            stream$puts(po, int$unparse(i) || " ")
        end
        if three_3s[si](list) then  
            stream$putl(po, "-> true")
        else
            stream$putl(po, "-> false")
        end
    end
end start_up
Output:
9 3 3 3 2 1 7 8 5 -> true
5 2 9 3 3 6 8 4 1 -> false
1 4 3 6 7 3 8 3 2 -> false
1 2 3 4 5 6 7 8 9 -> false
4 6 8 7 2 3 3 3 1 -> true

Delphi

Works with: Delphi version 6.0


var ThreeList: array [0..4,0..8] of integer = (
	(9,3,3,3,2,1,7,8,5),
	(5,2,9,3,3,7,8,4,1),
	(1,4,3,6,7,3,8,3,2),
	(1,2,3,4,5,6,7,8,9),
	(4,6,8,7,2,3,3,3,1));


function CountThrees(TA: array of integer): integer;
{Count the number threes in array}
var I,Cnt: integer;
begin
Result:=0;
for I:=0 to High(TA) do
 if TA[I]=3 then
	begin
	Inc(Result);
	if Result=3 then exit;
	end
 else Result:=0;
end;


procedure TestThreeArrays(Memo: TMemo);
var I,J: integer;
var B: boolean;
var S: string;
begin
for I:=0 to High(ThreeList) do
 	begin
 	S:='';
 	for J:=0 to High(ThreeList[I]) do
		begin
		if J>0 then S:=S+',';
		S:=S+IntToStr(ThreeList[I][J])
	  	end;
 	if CountThrees(ThreeList[I])=3 then S:=S+' True'
 	else S:=S+' False';
 	Memo.Lines.Add(S);
 	end;
end;
Output:
9,3,3,3,2,1,7,8,5 True
5,2,9,3,3,7,8,4,1 False
1,4,3,6,7,3,8,3,2 False
1,2,3,4,5,6,7,8,9 False
4,6,8,7,2,3,3,3,1 True

Draco

proc nonrec three_adjacent([*]int arr) bool:
    word i, n;
    i := 0;
    n := 0;
    while i<dim(arr,1) 
    and (arr[i]=3 or n=0 or n=3) 
    and n<=3 do
        if arr[i]=3 then n := n+1 fi;
        i := i+1
    od;
    i=dim(arr,1) and n=3
corp

proc nonrec main() void:
    [5][9]int list = (
        (9,3,3,3,2,1,7,8,5),
        (5,2,9,3,3,7,8,4,1),
        (1,4,3,6,7,3,8,3,2),
        (1,2,3,4,5,6,7,8,9),
        (4,6,8,7,2,3,3,3,1)
    );
    
    word i, j;
    for i from 0 upto 4 do
        for j from 0 upto 8 do write(list[i][j]:2) od;
        writeln(" -> ", 
                if three_adjacent(list[i]) then "true" else "false" fi)
    od
corp
Output:
 9 3 3 3 2 1 7 8 5 -> true
 5 2 9 3 3 7 8 4 1 -> false
 1 4 3 6 7 3 8 3 2 -> false
 1 2 3 4 5 6 7 8 9 -> false
 4 6 8 7 2 3 3 3 1 -> true

F#

Translation of: OCaml
let has_adjacent n x =
  let rec loop c = function
     h :: t when h = x -> loop (c+1) t
    |_ :: t -> c = n || loop 0 t
    |_ -> c = n
  in loop 0
[[9;3;3;3;2;1;7;8;5];[5;2;9;3;3;7;8;4;1];[1;4;3;6;7;3;8;3;2];[1;2;3;4;5;6;7;8;9];[4;6;8;7;2;3;3;3;1]]|>List.iter((has_adjacent 3 3)>>printfn "%A")
Output:
true
false
false
false
true

Factor

Works with: Factor version 0.99 2022-04-03
USING: formatting generalizations kernel math.statistics
sequences.extras ;

: adjacent? ( seq -- ? )
    [ 3 = ] arg-where differences V{ 1 1 } = ;

{ 9 3 3 3 2 1 7 8 5 }
{ 5 2 9 3 3 7 8 4 1 }
{ 1 4 3 6 7 3 8 3 2 }
{ 1 2 3 4 5 6 7 8 9 }
{ 4 6 8 7 2 3 3 3 1 }

[ dup adjacent? "%u -> %u\n" printf ] 5 napply
Output:
{ 9 3 3 3 2 1 7 8 5 } -> t
{ 5 2 9 3 3 7 8 4 1 } -> f
{ 1 4 3 6 7 3 8 3 2 } -> f
{ 1 2 3 4 5 6 7 8 9 } -> f
{ 4 6 8 7 2 3 3 3 1 } -> t

A somewhat simpler implementation without the fancy statistics and generalizations vocabs.

USING: io kernel sequences ;
{
    { 9 3 3 3 2 1 7 8 5 }
    { 5 2 9 3 3 7 8 4 1 }
    { 1 4 3 6 7 3 8 3 2 }
    { 1 2 3 4 5 6 7 8 9 }
    { 4 6 8 7 2 3 3 3 1 }
}
[
    [ [ 3 = ] count 3 = ]
    [ { 3 3 3 } subseq-of? ]
    bi and "true" "false" ? print
] each
Output:
true
false
false
false
true

FreeBASIC

dim as integer list(1 to 5, 1 to 9) = {_
     {9,3,3,3,2,1,7,8,5}, {5,2,9,3,3,7,8,4,1},_
     {1,4,3,6,7,3,8,3,2}, {1,2,3,4,5,6,7,8,9},_
     {4,6,8,7,2,3,3,3,1}}
     
dim as boolean go, pass
dim as integer i, j, c

for i = 1 to 5
    go = false
    pass = true
    c = 0
    for j = 1 to 9
        if list(i, j) = 3 then
            c+=1
            go = true
        else
            if go = true and c<>3 then pass=false
            go = false
        end if
    next j
    print i;"   ";
    if c = 3 and pass then print true else print false
next i
Output:

1   true
2   false
3   false
4   false
5   true

FutureBasic

include "NSLog.incl"

local fn ThreeAdjacentThrees
  NSUInteger i, j
  
  CFMutableArrayRef lists = fn MutableArrayNew
  MutableArrayInsertObjectAtIndex( lists, @"9,3,3,3,2,1,7,8,5", 0 )
  MutableArrayInsertObjectAtIndex( lists, @"5,2,9,3,3,7,8,4,1", 1 )
  MutableArrayInsertObjectAtIndex( lists, @"1,4,3,6,7,3,8,3,2", 2 )
  MutableArrayInsertObjectAtIndex( lists, @"1,2,3,4,5,6,7,8,9", 3 )
  MutableArrayInsertObjectAtIndex( lists, @"4,6,8,7,2,3,3,3,1", 4 )
  
  for i = 0 to len(lists) -1
    CFArrayRef tempArr = fn StringComponentsSeparatedByString( lists[i], @"," )
    NSUInteger counter = 0, elements = len(tempArr) -1
    for j = 0 to elements
      if ( counter == 3 ) then NSLog( @"%@:  TRUE — contains 3 adjacent 3s.", lists[i] )
      if ( counter != 3 ) and ( j == elements )
        NSLog( @"%@: FALSE — doesn't contain 3 adjacent 3s.", lists[i] )
      end if
      if fn StringIsEqual( tempArr[j], @"3" ) ==  NO then counter = 0 : continue
      if fn StringIsEqual( tempArr[j], @"3" ) == YES then counter++   : continue
    next
  next
end fn

fn ThreeAdjacentThrees

HandleEvents
Output:
9,3,3,3,2,1,7,8,5:  TRUE — contains 3 adjacent 3s.
9,3,3,3,2,1,7,8,5: FALSE — doesn't contain 3 adjacent 3s.
5,2,9,3,3,7,8,4,1: FALSE — doesn't contain 3 adjacent 3s.
1,4,3,6,7,3,8,3,2: FALSE — doesn't contain 3 adjacent 3s.
1,2,3,4,5,6,7,8,9: FALSE — doesn't contain 3 adjacent 3s.
4,6,8,7,2,3,3,3,1:  TRUE — contains 3 adjacent 3s.


Go

package main

import "fmt"

func main() {
    lists := [][]int{
        {9, 3, 3, 3, 2, 1, 7, 8, 5},
        {5, 2, 9, 3, 3, 7, 8, 4, 1},
        {1, 4, 3, 6, 7, 3, 8, 3, 2},
        {1, 2, 3, 4, 5, 6, 7, 8, 9},
        {4, 6, 8, 7, 2, 3, 3, 3, 1},
        {3, 3, 3, 1, 2, 4, 5, 1, 3},
        {0, 3, 3, 3, 3, 7, 2, 2, 6},
        {3, 3, 3, 3, 3, 4, 4, 4, 4},
    }
    for d := 1; d <= 4; d++ {
        fmt.Printf("Exactly %d adjacent %d's:\n", d, d)
        for _, list := range lists {
            var indices []int
            for i, e := range list {
                if e == d {
                    indices = append(indices, i)
                }
            }
            adjacent := false
            if len(indices) == d {
                adjacent = true
                for i := 1; i < len(indices); i++ {
                    if indices[i]-indices[i-1] != 1 {
                        adjacent = false
                        break
                    }
                }
            }
            fmt.Printf("%v -> %t\n", list, adjacent)
        }
        fmt.Println()
    }
}
Output:
Exactly 1 adjacent 1's:
[9 3 3 3 2 1 7 8 5] -> true
[5 2 9 3 3 7 8 4 1] -> true
[1 4 3 6 7 3 8 3 2] -> true
[1 2 3 4 5 6 7 8 9] -> true
[4 6 8 7 2 3 3 3 1] -> true
[3 3 3 1 2 4 5 1 3] -> false
[0 3 3 3 3 7 2 2 6] -> false
[3 3 3 3 3 4 4 4 4] -> false

Exactly 2 adjacent 2's:
[9 3 3 3 2 1 7 8 5] -> false
[5 2 9 3 3 7 8 4 1] -> false
[1 4 3 6 7 3 8 3 2] -> false
[1 2 3 4 5 6 7 8 9] -> false
[4 6 8 7 2 3 3 3 1] -> false
[3 3 3 1 2 4 5 1 3] -> false
[0 3 3 3 3 7 2 2 6] -> true
[3 3 3 3 3 4 4 4 4] -> false

Exactly 3 adjacent 3's:
[9 3 3 3 2 1 7 8 5] -> true
[5 2 9 3 3 7 8 4 1] -> false
[1 4 3 6 7 3 8 3 2] -> false
[1 2 3 4 5 6 7 8 9] -> false
[4 6 8 7 2 3 3 3 1] -> true
[3 3 3 1 2 4 5 1 3] -> false
[0 3 3 3 3 7 2 2 6] -> false
[3 3 3 3 3 4 4 4 4] -> false

Exactly 4 adjacent 4's:
[9 3 3 3 2 1 7 8 5] -> false
[5 2 9 3 3 7 8 4 1] -> false
[1 4 3 6 7 3 8 3 2] -> false
[1 2 3 4 5 6 7 8 9] -> false
[4 6 8 7 2 3 3 3 1] -> false
[3 3 3 1 2 4 5 1 3] -> false
[0 3 3 3 3 7 2 2 6] -> false
[3 3 3 3 3 4 4 4 4] -> true

Haskell

import Data.Bifunctor (bimap)
import Data.List (span)

nnPeers :: Int -> [Int] -> Bool
nnPeers n xs =
  let p x = n == x
   in uncurry (&&) $
        bimap
          (p . length)
          (not . any p)
          (span p $ dropWhile (not . p) xs)

--------------------------- TEST -------------------------
main :: IO ()
main =
  putStrLn $
    unlines $
      fmap
        (\xs -> show xs <> " -> " <> show (nnPeers 3 xs))
        [ [9, 3, 3, 3, 2, 1, 7, 8, 5],
          [5, 2, 9, 3, 3, 7, 8, 4, 1],
          [1, 4, 3, 6, 7, 3, 8, 3, 2],
          [1, 2, 3, 4, 5, 6, 7, 8, 9],
          [4, 6, 8, 7, 2, 3, 3, 3, 1]
        ]
Output:
[9,3,3,3,2,1,7,8,5] -> True
[5,2,9,3,3,7,8,4,1] -> False
[1,4,3,6,7,3,8,3,2] -> False
[1,2,3,4,5,6,7,8,9] -> False
[4,6,8,7,2,3,3,3,1] -> True

J

For the given test cases:

lists=: >cutLF{{)n
 9 3 3 3 2 1 7 8 5
 5 2 9 3 3 7 8 4 1
 1 4 3 6 7 3 8 3 2
 1 2 3 4 5 6 7 8 9
 4 6 8 7 2 3 3 3 1
}}

   (,.~ (;:'false true')>@{~'3 3 3' +./@E.&".]) lists 
true  9 3 3 3 2 1 7 8 5
false 5 2 9 3 3 7 8 4 1
false 1 4 3 6 7 3 8 3 2
false 1 2 3 4 5 6 7 8 9
true  4 6 8 7 2 3 3 3 1

However, for example, it's not clear what the result should be for an argument of 3 3 3 3 3 3 3 3 3.

JavaScript

(() => {
    "use strict";

    // ------- N INSTANCES OF N AND ALL CONTIGUOUS -------

    // nnPeers :: Int -> [Int] -> Bool
    const nnPeers = n =>
        // True if xs contains exactly n instances of n
        // and the instances are all contiguous.
        xs => {
            const
                p = x => n === x,
                mbi = xs.findIndex(p);

            return -1 !== mbi ? (() => {
                const
                    rest = xs.slice(mbi),
                    sample = rest.slice(0, n);

                return n === sample.length && (
                    sample.every(p) && (
                        !rest.slice(n).some(p)
                    )
                );
            })() : false;
        };

    // ---------------------- TEST -----------------------
    const main = () => [
            [9, 3, 3, 3, 2, 1, 7, 8, 5],
            [5, 2, 9, 3, 3, 7, 8, 4, 1],
            [1, 4, 3, 6, 7, 3, 8, 3, 2],
            [1, 2, 3, 4, 5, 6, 7, 8, 9],
            [4, 6, 8, 7, 2, 3, 3, 3, 1]
        ]
        .map(
            xs => `${JSON.stringify(xs)} -> ${nnPeers(3)(xs)}`
        )
        .join("\n");

    return main();
})();
Output:
[9,3,3,3,2,1,7,8,5] -> true
[5,2,9,3,3,7,8,4,1] -> false
[1,4,3,6,7,3,8,3,2] -> false
[1,2,3,4,5,6,7,8,9] -> false
[4,6,8,7,2,3,3,3,1] -> true

jq

Works with: jq

Works with gojq, the Go implementation of jq

The test cases, and the output, are exactly as for entry at #Wren.

Preliminaries

def count(s): reduce s as $x (0; .+1);

The task

def lists : [
    [9,3,3,3,2,1,7,8,5],
    [5,2,9,3,3,7,8,4,1],
    [1,4,3,6,7,3,8,3,2],
    [1,2,3,4,5,6,7,8,9],
    [4,6,8,7,2,3,3,3,1],
    [3,3,3,1,2,4,5,1,3],
    [0,3,3,3,3,7,2,2,6],
    [3,3,3,3,3,4,4,4,4]
];

def threeConsecutiveThrees:
  count(.[] == 3 // empty) == 3
  and index([3,3,3]);

"Exactly three adjacent 3's:",
(lists[] 
 | "\(.) -> \(threeConsecutiveThrees)")
Output:

As for #Wren.

Julia

function onlyconsecutivein(a::Vector{T}, lis::Vector{T}) where T
    return any(i -> a == lis[i:i+length(a)-1], 1:length(lis)-length(a)+1) &&
        all(count(x -> x == a[i], lis) == count(x -> x == a[i], a) for i in eachindex(a))
end
 
needle = [3, 3, 3]
for haystack in [
   [9,3,3,3,2,1,7,8,5],
   [5,2,9,3,3,7,8,4,1],
   [1,4,3,3,3,3,8,3,2],
   [1,2,3,4,5,6,7,8,9],
   [4,6,8,7,2,3,3,3,1]]
    println("$needle in $haystack: ", onlyconsecutivein(needle, haystack))
end

needle = [3, 2, 3]
for haystack in [
    [9,3,3,3,2,3,7,8,5],
    [5,6,9,1,3,2,3,4,1],
    [1,4,3,6,7,3,8,3,2],
    [1,2,3,4,5,6,7,8,9],
    [4,6,8,7,2,3,2,3,1]]
     println("$needle in $haystack: ", onlyconsecutivein(needle, haystack))
end
Output:
[3, 3, 3] in [9, 3, 3, 3, 2, 1, 7, 8, 5]: true
[3, 3, 3] in [5, 2, 9, 3, 3, 7, 8, 4, 1]: false
[3, 3, 3] in [1, 4, 3, 3, 3, 3, 8, 3, 2]: false
[3, 3, 3] in [1, 2, 3, 4, 5, 6, 7, 8, 9]: false
[3, 3, 3] in [4, 6, 8, 7, 2, 3, 3, 3, 1]: true
[3, 2, 3] in [9, 3, 3, 3, 2, 3, 7, 8, 5]: false
[3, 2, 3] in [5, 6, 9, 1, 3, 2, 3, 4, 1]: true
[3, 2, 3] in [1, 4, 3, 6, 7, 3, 8, 3, 2]: false
[3, 2, 3] in [1, 2, 3, 4, 5, 6, 7, 8, 9]: false
[3, 2, 3] in [4, 6, 8, 7, 2, 3, 2, 3, 1]: false

Mathematica / Wolfram Language

(# -> MemberQ[Partition[#, 3, 1], {3, 3, 3}]) & /@ {{9, 3, 3, 3, 2, 1,
     7, 8, 5}, {5, 2, 9, 3, 3, 7, 8, 4, 1}, {1, 4, 3, 6, 7, 3, 8, 3, 
    2}, {1, 2, 3, 4, 5, 6, 7, 8, 9}, {4, 6, 8, 7, 2, 3, 3, 3, 
    1}} // TableForm
Output:

{9,3,3,3,2,1,7,8,5}->True {5,2,9,3,3,7,8,4,1}->False {1,4,3,6,7,3,8,3,2}->False {1,2,3,4,5,6,7,8,9}->False {4,6,8,7,2,3,3,3,1}->True

Nim

const Lists = [[9, 3, 3, 3, 2, 1, 7, 8, 5],
               [5, 2, 9, 3, 3, 7, 8, 4, 1],
               [1, 4, 3, 6, 7, 3, 8, 3, 2],
               [1, 2, 3, 4, 5, 6, 7, 8, 9],
               [4, 6, 8, 7, 2, 3, 3, 3, 1]]

func contains3Adjacent3(s: openArray[int]): bool =
  if s.len < 3: return false
  var count = 0
  for i in 0..s.high:
    if s[i] == 3:
      inc count
      if count == 3: return true
    else:
      count = 0


for list in Lists:
  echo list, ": ", list.contains3Adjacent3()
Output:
[9, 3, 3, 3, 2, 1, 7, 8, 5]: true
[5, 2, 9, 3, 3, 7, 8, 4, 1]: false
[1, 4, 3, 6, 7, 3, 8, 3, 2]: false
[1, 2, 3, 4, 5, 6, 7, 8, 9]: false
[4, 6, 8, 7, 2, 3, 3, 3, 1]: true

OCaml

let has_adjacent n x =
  let rec loop c = function
    | h :: t when h = x -> loop (succ c) t
    | _ :: t -> c = n || loop 0 t
    | _ -> c = n
  in loop 0

let list = [
  [9; 3; 3; 3; 2; 1; 7; 8; 5];
  [5; 2; 9; 3; 3; 7; 8; 4; 1];
  [1; 4; 3; 6; 7; 3; 8; 3; 2];
  [1; 2; 3; 4; 5; 6; 7; 8; 9];
  [4; 6; 8; 7; 2; 3; 3; 3; 1]]

let () =
  List.iter (fun l -> Printf.printf " %B" (has_adjacent 3 3 l)) list
Output:
 true false false false true

Perl

Specific

#!/usr/bin/perl
 
use strict; # https://rosettacode.org/wiki/Exactly_three_adjacent_3_in_lists
use warnings;
 
my @lists = (
  [9,3,3,3,2,1,7,8,5],
  [5,2,9,3,3,7,8,4,1],
  [1,4,3,6,7,3,8,3,2],
  [1,2,3,4,5,6,7,8,9],
  [4,6,8,7,2,3,3,3,1]);
 
for my $ref ( @lists )
  {
  my @n = grep $ref->[$_] == 3, 0 .. $#$ref;
  print "@$ref => ",
    @n == 3 && $n[0] == $n[1] - 1 && $n[1] == $n[2] - 1 ? 'true' : 'false',
    "\n";
  }
Output:
9 3 3 3 2 1 7 8 5 => true
5 2 9 3 3 7 8 4 1 => false
1 4 3 6 7 3 8 3 2 => false
1 2 3 4 5 6 7 8 9 => false
4 6 8 7 2 3 3 3 1 => true

General

use strict;
use warnings;

my @lists = (
    [ < 9 3 3 3 2 1 7 8 5 > ],
    [ < 5 2 9 3 3 7 8 4 1 > ],
    [ < 1 4 3 6 7 3 8 3 2 > ],
    [ < 1 2 3 4 5 6 7 8 9 > ],
    [ < 4 6 8 7 2 3 3 3 1 > ],
    [ < 3 3 3 1 2 4 5 1 3 > ],
    [ < 0 3 9 3 3 7 2 2 6 > ],
    [ < 3 3 3 3 3 4 4 4 4 > ],
);

print ' 'x21 . '0x0 1x1 2x2 3x3 4x4' . "\n";
for my $ref ( @lists ) {
    print "@$ref: ";
    for my $n (0..4) {
        my @i = grep $ref->[$_] == $n, 0 .. $#$ref;
        print '   ', $n==0 && !@i || @i == $n && ($n==1 || ($n-1 == grep $i[$_-1]+1 == $i[$_], 1..$n-1)) ? 'Y' : 'N';
    }
    print "\n";
}
Output:
                     0x0 1x1 2x2 3x3 4x4
9 3 3 3 2 1 7 8 5:    Y   Y   N   Y   N
5 2 9 3 3 7 8 4 1:    Y   Y   N   N   N
1 4 3 6 7 3 8 3 2:    Y   Y   N   N   N
1 2 3 4 5 6 7 8 9:    Y   Y   N   N   N
4 6 8 7 2 3 3 3 1:    Y   Y   N   Y   N
3 3 3 1 2 4 5 1 3:    Y   N   N   N   N
0 3 9 3 3 7 2 2 6:    N   N   Y   N   N
3 3 3 3 3 4 4 4 4:    Y   N   N   N   Y

Phix

with javascript_semantics
procedure test(integer n, sequence s)
    sequence f = find_all(n,s)
    printf(1,"%v: %t\n",{s,length(f)=n and f[$]-f[1]=n-1})
end procedure

printf(1,"\nExactly %d adjacent %d's:\n",3)
papply(true,test,{3,{{9, 3, 3, 3, 2, 1, 7, 8, 5},
                     {5, 2, 9, 3, 3, 7, 8, 4, 1},
                     {1, 4, 3, 6, 7, 3, 8, 3, 2},
                     {1, 2, 3, 4, 5, 6, 7, 8, 9},
                     {4, 6, 8, 7, 2, 3, 3, 3, 1}}})
Output:

(Agrees with Raku and Wren with a for loop and the three extra tests)

Exactly 3 adjacent 3's:
{9,3,3,3,2,1,7,8,5}: true
{5,2,9,3,3,7,8,4,1}: false
{1,4,3,6,7,3,8,3,2}: false
{1,2,3,4,5,6,7,8,9}: false
{4,6,8,7,2,3,3,3,1}: true

Python

'''N instances of N and all contiguous'''

from itertools import dropwhile, takewhile


# nnPeers :: Int -> [Int] -> Bool
def nnPeers(n):
    '''True if xs contains exactly n instances of n
       and all instances are contiguous.
    '''
    def p(x):
        return n == x

    def go(xs):
        fromFirstMatch = list(dropwhile(
            lambda v: not p(v),
            xs
        ))
        ns = list(takewhile(p, fromFirstMatch))
        rest = fromFirstMatch[len(ns):]

        return p(len(ns)) and (
            not any(p(x) for x in rest)
        )

    return go


# ------------------------- TEST -------------------------
# main :: IO ()
def main():
    '''Tests for N=3'''
    print(
        '\n'.join([
            f'{xs} -> {nnPeers(3)(xs)}' for xs in [
                [9, 3, 3, 3, 2, 1, 7, 8, 5],
                [5, 2, 9, 3, 3, 7, 8, 4, 1],
                [1, 4, 3, 6, 7, 3, 8, 3, 2],
                [1, 2, 3, 4, 5, 6, 7, 8, 9],
                [4, 6, 8, 7, 2, 3, 3, 3, 1]
            ]
        ])
    )


# MAIN ---
if __name__ == '__main__':
    main()
Output:
[9, 3, 3, 3, 2, 1, 7, 8, 5] -> True
[5, 2, 9, 3, 3, 7, 8, 4, 1] -> False
[1, 4, 3, 6, 7, 3, 8, 3, 2] -> False
[1, 2, 3, 4, 5, 6, 7, 8, 9] -> False
[4, 6, 8, 7, 2, 3, 3, 3, 1] -> True

Quackery

Includes the extra test cases from the Raku and Wren solutions.

  [ [] swap witheach
      [ 3 = if
        [ i^ join ] ]
    dup size 3 != iff
      [ drop false ]
      done
    unpack
    1 - over != iff
      [ 2drop false ]
      done
    1 - = ]             is three-threes ( [ --> b )

  ' [ [ 9 3 3 3 2 1 7 8 5 ]
      [ 5 2 9 3 3 7 8 4 1 ]
      [ 1 4 3 6 7 3 8 3 2 ]
      [ 1 2 3 4 5 6 7 8 9 ]
      [ 4 6 8 7 2 3 3 3 1 ]
      [ 3 3 3 1 2 4 5 1 3 ]
      [ 0 3 3 3 3 7 2 2 6 ]
      [ 3 3 3 3 3 4 4 4 4 ] ]

   witheach
     [ dup echo sp
       three-threes iff
         [ say "true" ]
       else [ say "false" ]
       cr ]
Output:
[ 9 3 3 3 2 1 7 8 5 ] true
[ 5 2 9 3 3 7 8 4 1 ] false
[ 1 4 3 6 7 3 8 3 2 ] false
[ 1 2 3 4 5 6 7 8 9 ] false
[ 4 6 8 7 2 3 3 3 1 ] true
[ 3 3 3 1 2 4 5 1 3 ] false
[ 0 3 3 3 3 7 2 2 6 ] false
[ 3 3 3 3 3 4 4 4 4 ] false

Raku

Generalized

for 1 .. 4 -> $n {

    say "\nExactly $n {$n}s, and they are consecutive:";

    say .gist, ' ', lc (.Bag{$n} == $n) && ( so .rotor($n=>-($n - 1)).grep: *.all == $n ) for
    [9,3,3,3,2,1,7,8,5],
    [5,2,9,3,3,7,8,4,1],
    [1,4,3,6,7,3,8,3,2],
    [1,2,3,4,5,6,7,8,9],
    [4,6,8,7,2,3,3,3,1],
    [3,3,3,1,2,4,5,1,3],
    [0,3,3,3,3,7,2,2,6],
    [3,3,3,3,3,4,4,4,4]
}
Output:
Exactly 1 1s, and they are consecutive:
[9 3 3 3 2 1 7 8 5] true
[5 2 9 3 3 7 8 4 1] true
[1 4 3 6 7 3 8 3 2] true
[1 2 3 4 5 6 7 8 9] true
[4 6 8 7 2 3 3 3 1] true
[3 3 3 1 2 4 5 1 3] false
[0 3 3 3 3 7 2 2 6] false
[3 3 3 3 3 4 4 4 4] false

Exactly 2 2s, and they are consecutive:
[9 3 3 3 2 1 7 8 5] false
[5 2 9 3 3 7 8 4 1] false
[1 4 3 6 7 3 8 3 2] false
[1 2 3 4 5 6 7 8 9] false
[4 6 8 7 2 3 3 3 1] false
[3 3 3 1 2 4 5 1 3] false
[0 3 3 3 3 7 2 2 6] true
[3 3 3 3 3 4 4 4 4] false

Exactly 3 3s, and they are consecutive:
[9 3 3 3 2 1 7 8 5] true
[5 2 9 3 3 7 8 4 1] false
[1 4 3 6 7 3 8 3 2] false
[1 2 3 4 5 6 7 8 9] false
[4 6 8 7 2 3 3 3 1] true
[3 3 3 1 2 4 5 1 3] false
[0 3 3 3 3 7 2 2 6] false
[3 3 3 3 3 4 4 4 4] false

Exactly 4 4s, and they are consecutive:
[9 3 3 3 2 1 7 8 5] false
[5 2 9 3 3 7 8 4 1] false
[1 4 3 6 7 3 8 3 2] false
[1 2 3 4 5 6 7 8 9] false
[4 6 8 7 2 3 3 3 1] false
[3 3 3 1 2 4 5 1 3] false
[0 3 3 3 3 7 2 2 6] false
[3 3 3 3 3 4 4 4 4] true

Ring

see "working..." + nl

list = List(5)
list[1] = [9,3,3,3,2,1,7,8,5]
list[2] = [5,2,9,3,3,7,8,4,1]
list[3] = [1,4,3,6,7,3,8,3,2]
list[4] = [1,2,3,4,5,6,7,8,9]
list[5] = [4,6,8,7,2,3,3,3,1]

for n = 1 to 5
    good = 0
    cnt = 0
    len = len(list[n])
    for p = 1 to len
        if list[n][p] = 3
           good++
        ok
    next
    if good = 3
       for m = 1 to len-2   
           if list[n][m] = 3 and list[n][m+1] = 3 and list[n][m+2] = 3
              cnt++
           ok
       next
    ok
    showarray(list[n])
    if cnt = 1
       see " > " + "true" + nl
    else
       see " > " + "false" + nl
    ok
next

see "done..." + nl

func showArray(array)
     txt = ""
     see "["
     for n = 1 to len(array)
         txt = txt + array[n] + ","
     next
     txt = left(txt,len(txt)-1)
     txt = txt + "]"
     see txt
Output:
working...
[9,3,3,3,2,1,7,8,5] > true
[5,2,9,3,3,7,8,4,1] > false
[1,4,3,6,7,3,8,3,2] > false
[1,2,3,4,5,6,7,8,9] > false
[4,6,8,7,2,3,3,3,1] > true
done...

RPL

The program below creates a list of the positions of the number 3, then calculates the list of first differences, which must be equal to { 1 1 } if there are exactly 3 adjacent 3 in the input list.

≪ → list
  ≪ { } 1 list SIZE FOR j 
       IF list j GET 3 == THEN j + END NEXT
    IFERR ΔLIST { 1 1 } == THEN DROP 0 END
≫ ≫ 'ADJ3?' STO

≪ {{9,3,3,3,2,1,7,8,5}
   {5,2,9,3,3,7,8,4,1}
   {1,4,3,6,7,3,8,3,2}
   {1,2,3,4,5,6,7,8,9}
   {4,6,8,7,2,3,3,3,1}
   {3,3,3,1,2,4,5,1,3}
   {0,3,3,3,3,7,2,2,6}
   {3,3,3,3,3,4,4,4,4}} → cases
   ≪ { } 1 cases SIZE FOR j cases j GET ADJ3?’ + NEXT ≫ ≫ ‘TASK’ STO
Output:
1: { 1 0 0 0 1 0 0 0 }

Ruby

Using the Raku/Wren testset:

tests = [[9,3,3,3,2,1,7,8,5],
         [5,2,9,3,3,7,8,4,1],
         [1,4,3,6,7,3,8,3,2],
         [1,2,3,4,5,6,7,8,9],
         [4,6,8,7,2,3,3,3,1],
         [3,3,3,1,2,4,5,1,3],
         [0,3,3,3,3,7,2,2,6],
         [3,3,3,3,3,4,4,4,4]]

(1..4).each do |n|
  c = [n]*n
  puts "Contains exactly #{n} #{n}s, consecutive:"
  tests.each { |t| puts "#{t.inspect} : #{t.count(n)==n && t.each_cons(n).any?{|chunk| chunk == c }}" }
end
Output:
Contains exactly 1 1s, consecutive:
[9, 3, 3, 3, 2, 1, 7, 8, 5] : true
[5, 2, 9, 3, 3, 7, 8, 4, 1] : true
[1, 4, 3, 6, 7, 3, 8, 3, 2] : true
[1, 2, 3, 4, 5, 6, 7, 8, 9] : true
[4, 6, 8, 7, 2, 3, 3, 3, 1] : true
[3, 3, 3, 1, 2, 4, 5, 1, 3] : false
[0, 3, 3, 3, 3, 7, 2, 2, 6] : false
[3, 3, 3, 3, 3, 4, 4, 4, 4] : false
Contains exactly 2 2s, consecutive:
[9, 3, 3, 3, 2, 1, 7, 8, 5] : false
[5, 2, 9, 3, 3, 7, 8, 4, 1] : false
[1, 4, 3, 6, 7, 3, 8, 3, 2] : false
[1, 2, 3, 4, 5, 6, 7, 8, 9] : false
[4, 6, 8, 7, 2, 3, 3, 3, 1] : false
[3, 3, 3, 1, 2, 4, 5, 1, 3] : false
[0, 3, 3, 3, 3, 7, 2, 2, 6] : true
[3, 3, 3, 3, 3, 4, 4, 4, 4] : false
Contains exactly 3 3s, consecutive:
[9, 3, 3, 3, 2, 1, 7, 8, 5] : true
[5, 2, 9, 3, 3, 7, 8, 4, 1] : false
[1, 4, 3, 6, 7, 3, 8, 3, 2] : false
[1, 2, 3, 4, 5, 6, 7, 8, 9] : false
[4, 6, 8, 7, 2, 3, 3, 3, 1] : true
[3, 3, 3, 1, 2, 4, 5, 1, 3] : false
[0, 3, 3, 3, 3, 7, 2, 2, 6] : false
[3, 3, 3, 3, 3, 4, 4, 4, 4] : false
Contains exactly 4 4s, consecutive:
[9, 3, 3, 3, 2, 1, 7, 8, 5] : false
[5, 2, 9, 3, 3, 7, 8, 4, 1] : false
[1, 4, 3, 6, 7, 3, 8, 3, 2] : false
[1, 2, 3, 4, 5, 6, 7, 8, 9] : false
[4, 6, 8, 7, 2, 3, 3, 3, 1] : false
[3, 3, 3, 1, 2, 4, 5, 1, 3] : false
[0, 3, 3, 3, 3, 7, 2, 2, 6] : false
[3, 3, 3, 3, 3, 4, 4, 4, 4] : true

Sidef

func contains_n_consecutive_objs(arr, n, obj) {

    # In Sidef >= 3.99, we can also say:
    # arr.contains(n.of(obj)...)

    arr.each_cons(n, {|*a|
        if (a.all { _ == obj }) {
            return true
        }
    })

    return false
}

var lists = [
    [9,3,3,3,2,1,7,8,5],
    [5,2,9,3,3,7,8,4,1],
    [1,4,3,6,7,3,8,3,2],
    [1,2,3,4,5,6,7,8,9],
    [4,6,8,7,2,3,3,3,1],
]

lists.each {|list|
    say (list, " => ", contains_n_consecutive_objs(list, 3, 3))
}
Output:
[9, 3, 3, 3, 2, 1, 7, 8, 5] => true
[5, 2, 9, 3, 3, 7, 8, 4, 1] => false
[1, 4, 3, 6, 7, 3, 8, 3, 2] => false
[1, 2, 3, 4, 5, 6, 7, 8, 9] => false
[4, 6, 8, 7, 2, 3, 3, 3, 1] => true

V (Vlang)

Translation of: go
fn main() {
    lists := [
        [9, 3, 3, 3, 2, 1, 7, 8, 5],
        [5, 2, 9, 3, 3, 7, 8, 4, 1],
        [1, 4, 3, 6, 7, 3, 8, 3, 2],
        [1, 2, 3, 4, 5, 6, 7, 8, 9],
        [4, 6, 8, 7, 2, 3, 3, 3, 1],
        [3, 3, 3, 1, 2, 4, 5, 1, 3],
        [0, 3, 3, 3, 3, 7, 2, 2, 6],
        [3, 3, 3, 3, 3, 4, 4, 4, 4],
    ]
    for d := 1; d <= 4; d++ {
        println("Exactly $d adjacent $d's:")
        for list in lists {
            mut indices := []int{}
            for i, e in list {
                if e == d {
                    indices << i
                }
            }
            mut adjacent := false
            if indices.len == d {
                adjacent = true
                for i in 1..indices.len {
                    if indices[i]-indices[i-1] != 1 {
                        adjacent = false
                        break
                    }
                }
            }
            println("$list -> $adjacent")
        }
        println('')
    }
}
Output:
Exactly three adjacent 3's:
[9, 3, 3, 3, 2, 1, 7, 8, 5] -> true
[5, 2, 9, 3, 3, 7, 8, 4, 1] -> false
[1, 4, 3, 6, 7, 3, 8, 3, 2] -> false
[1, 2, 3, 4, 5, 6, 7, 8, 9] -> false
[4, 6, 8, 7, 2, 3, 3, 3, 1] -> true
[3, 3, 3, 1, 2, 4, 5, 1, 3] -> false
[0, 3, 3, 3, 3, 7, 2, 2, 6] -> false
[3, 3, 3, 3, 3, 4, 4, 4, 4] -> false

Wren

Library: Wren-seq
import "./seq" for Lst

var lists = [
    [9,3,3,3,2,1,7,8,5],
    [5,2,9,3,3,7,8,4,1],
    [1,4,3,6,7,3,8,3,2],
    [1,2,3,4,5,6,7,8,9],
    [4,6,8,7,2,3,3,3,1],
    [3,3,3,1,2,4,5,1,3],
    [0,3,3,3,3,7,2,2,6],
    [3,3,3,3,3,4,4,4,4]
]
System.print("Exactly three adjacent 3's:")
for (list in lists) {
    var condition = list.count { |n| n == 3 } == 3 && Lst.isSliceOf(list, [3, 3, 3])
    System.print("%(list) -> %(condition)")
}
Output:
Exactly three adjacent 3's:
[9, 3, 3, 3, 2, 1, 7, 8, 5] -> true
[5, 2, 9, 3, 3, 7, 8, 4, 1] -> false
[1, 4, 3, 6, 7, 3, 8, 3, 2] -> false
[1, 2, 3, 4, 5, 6, 7, 8, 9] -> false
[4, 6, 8, 7, 2, 3, 3, 3, 1] -> true
[3, 3, 3, 1, 2, 4, 5, 1, 3] -> false
[0, 3, 3, 3, 3, 7, 2, 2, 6] -> false
[3, 3, 3, 3, 3, 4, 4, 4, 4] -> false

Or, more generally, replacing everything after 'lists' with the following:

for (d in 1..4) {
    System.print("Exactly %(d) adjacent %(d)'s:")
    for (list in lists) {
        var condition = list.count { |n| n == d } == d && Lst.isSliceOf(list, [d] * d)
        System.print("%(list) -> %(condition)")
    }
    System.print()
}
Output:
Exactly 1 adjacent 1's:
[9, 3, 3, 3, 2, 1, 7, 8, 5] -> true
[5, 2, 9, 3, 3, 7, 8, 4, 1] -> true
[1, 4, 3, 6, 7, 3, 8, 3, 2] -> true
[1, 2, 3, 4, 5, 6, 7, 8, 9] -> true
[4, 6, 8, 7, 2, 3, 3, 3, 1] -> true
[3, 3, 3, 1, 2, 4, 5, 1, 3] -> false
[0, 3, 3, 3, 3, 7, 2, 2, 6] -> false
[3, 3, 3, 3, 3, 4, 4, 4, 4] -> false

Exactly 2 adjacent 2's:
[9, 3, 3, 3, 2, 1, 7, 8, 5] -> false
[5, 2, 9, 3, 3, 7, 8, 4, 1] -> false
[1, 4, 3, 6, 7, 3, 8, 3, 2] -> false
[1, 2, 3, 4, 5, 6, 7, 8, 9] -> false
[4, 6, 8, 7, 2, 3, 3, 3, 1] -> false
[3, 3, 3, 1, 2, 4, 5, 1, 3] -> false
[0, 3, 3, 3, 3, 7, 2, 2, 6] -> true
[3, 3, 3, 3, 3, 4, 4, 4, 4] -> false

Exactly 3 adjacent 3's:
[9, 3, 3, 3, 2, 1, 7, 8, 5] -> true
[5, 2, 9, 3, 3, 7, 8, 4, 1] -> false
[1, 4, 3, 6, 7, 3, 8, 3, 2] -> false
[1, 2, 3, 4, 5, 6, 7, 8, 9] -> false
[4, 6, 8, 7, 2, 3, 3, 3, 1] -> true
[3, 3, 3, 1, 2, 4, 5, 1, 3] -> false
[0, 3, 3, 3, 3, 7, 2, 2, 6] -> false
[3, 3, 3, 3, 3, 4, 4, 4, 4] -> false

Exactly 4 adjacent 4's:
[9, 3, 3, 3, 2, 1, 7, 8, 5] -> false
[5, 2, 9, 3, 3, 7, 8, 4, 1] -> false
[1, 4, 3, 6, 7, 3, 8, 3, 2] -> false
[1, 2, 3, 4, 5, 6, 7, 8, 9] -> false
[4, 6, 8, 7, 2, 3, 3, 3, 1] -> false
[3, 3, 3, 1, 2, 4, 5, 1, 3] -> false
[0, 3, 3, 3, 3, 7, 2, 2, 6] -> false
[3, 3, 3, 3, 3, 4, 4, 4, 4] -> true

XPL0

func Check(L);  \Return 'true' if three adjacent 3's
int  L, C, I, J;
def  Size = 9;  \number of items in each List
[C:= 0;
for I:= 0 to Size-1 do
    if L(I) = 3 then [C:= C+1;  J:= I];
if C # 3 then return false;     \must have exactly three 3's
return L(J-1)=3 & L(J-2)=3;     \the 3's must be adjacent
];

int List(5+1), I;
[List(1):= [9,3,3,3,2,1,7,8,5];
 List(2):= [5,2,9,3,3,7,8,4,1];
 List(3):= [1,4,3,6,7,3,8,3,2];
 List(4):= [1,2,3,4,5,6,7,8,9];
 List(5):= [4,6,8,7,2,3,3,3,1];
 for I:= 1 to 5 do
     [IntOut(0, I);
     Text(0, if Check(List(I)) then " true" else " false");
     CrLf(0);
     ];
]
Output:
1 true
2 false
3 false
4 false
5 true