Exactly three adjacent 3 in lists
- 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
AutoHotkey
<lang 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</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>
- 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>
- 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
Draco
<lang 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</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
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
Go
<lang 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() }
}</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
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 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
- 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()</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...
Ruby
Using the Raku/Wren testset: <lang ruby>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 </lang>
- 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
Wren
<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