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

<lang 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’)</lang>
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

<lang asm> 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</lang>

Output:
true false false false true

Ada

<lang 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;</lang>

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. <lang algol68>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</lang>

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

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

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

<lang AWK>

  1. 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)

} </lang>

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

C

<lang c>#include <stdio.h>

  1. 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;

}</lang>

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

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

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

F#

<lang fsharp> // Exactly three adjacent 3 in lists. Nigel Galloway: December 8th., 2021 let 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]] n|>List.iter(fun n->printfn "%A" (n|>List.windowed 3|>List.exists(fun(n::g::l::_)->n=3 && g=3 && l=3))) </lang>

Output:
true
false
false
false
true

FreeBASIC

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

Output:


1   true
2   false
3   false
4   false
5   true

Haskell

<lang 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]
       ]</lang>
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

JavaScript

<lang 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();

})();</lang>

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 <lang jq>def count(s): reduce s as $x (0; .+1);</lang> The task <lang jq>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)")

</lang>

Output:

As for #Wren.

Julia

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

</lang>

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

<lang Mathematica>(# -> 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</lang>
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

Perl

Specific

<lang perl>#!/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";
 }</lang>
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

<lang perl>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";

}</lang>

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

<lang python>N instances of N and all contiguous

from itertools import dropwhile, takewhile


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


  1. ------------------------- TEST -------------------------
  2. 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]
           ]
       ])
   )


  1. MAIN ---

if __name__ == '__main__': 

   main()</lang>
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

Raku

Generalized <lang perl6>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]

}</lang>

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

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

</lang>

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

Wren

Library: Wren-seq

<lang ecmascript>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)")

}</lang>

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: <lang ecmascript>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()

}</lang>

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

<lang 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);
    ];

]</lang>

Output:
1 true
2 false
3 false
4 false
5 true
Retrieved from "https://rosettacode.org/wiki/Exactly_three_adjacent_3_in_lists?oldid=318255"