Задачки - погодная машина Санта-Клауса!

@ct0r · Регистрация: 19.08.2012

Студворк — интернет-сервис помощи студентам

Может, кто-то уже слышал/делал задачки с http://adventofcode.com/

Как по мне, так они достаточно хороши, чтобы начать знакомиться с новым языком...
Для кого-то этим новым может быть С++

В этой теме. если есть желание, можно обсудить что-то или выложить свое решение (без разницы на чем).

А вот мой код к первым четырем:

1)

Bash
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
defmodule Task1 do
  def solve(path) do
    File.open!(path)
    |> IO.stream(1)
    |> Enum.reduce(
         0,
         fn(ch, acc) ->
           case ch do
             "(" -> acc + 1
             ")" -> acc - 1
             _ -> acc
           end
         end
       )
  end
end
 
defmodule Task1_1 do
  def solve(path) do
    File.stream!(path, [], 1)
    |> Enum.reduce_while(
         {0, 0},
         fn(ch, {acc, pos}) ->
           new_acc = case ch do
             "(" -> acc + 1
             ")" -> acc - 1
             _ -> acc
           end
           if new_acc == -1 do
             {:halt, {:ok, pos + 1}}
           else
             {:cont, {new_acc, pos + 1}}
           end
         end
       )
  end
end
 
{:ok, result} = Task1_1.solve("input.txt")
IO.puts(result)

2)

Bash
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
defmodule Task2 do
  def parse(stream) do
    stream
    |> Enum.map(
         fn(line) ->
           line
           |> String.trim_trailing("\n")
           |> String.split("x")
           |> Enum.map(&String.to_integer/1)
         end
       )
  end
 
  def solve(dims, tf) do
    dims |> Enum.reduce(0, fn([l, w, h], acc) -> acc + tf.(l, w, h) end)
  end
end
 
tfs = [
  fn(l, w, h) -> 2 * (l * w + l * h + w * h) + Enum.min([l * w, l * h, w * h]) end,
  fn(l, w, h) -> l * w * h + 2 * Enum.min([l + w, l + h, w + h]) end
]
 
dims = File.open!("input.txt") |> IO.binstream(:line) |> Task2.parse
for f <- tfs, do: dims |> Task2.solve(f)
|> IO.puts

3)

Bash
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
defmodule Task3 do
  def solve(stream) do
    stream
    |> Enum.reduce(
         {{0, 0}, MapSet.new |> MapSet.put({0, 0}), {0, 0}},
         fn(ch, {{x, y}, visited, coords}) ->
           new_coords = case ch do
             "^" -> {x, y + 1}
             ">" -> {x + 1, y}
             "<" -> {x - 1, y}
             "v" -> {x, y - 1}
           end
           {coords, MapSet.put(visited, new_coords), new_coords}
         end
       )
    |> elem(1)
    |> MapSet.size
  end
end
 
File.stream!("input.txt", [], 1) |> Task3.solve |> IO.puts

4)

Bash
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
defmodule Task4 do
  def not_mined?(data) do
    case Base.encode16(:erlang.md5(data), case: :lower) do
      "000000" <> _ -> false
      _ -> true
    end
  end
 
  def solve(prefix) do
    Stream.iterate(0, &(&1 + 1))
    |> Stream.drop_while(
         fn(n) ->
           prefix <> Integer.to_string(n)
           |> Task4.not_mined?
         end
       )
    |> Enum.at(0)
  end
end
 
"ckczppom" |> Task4.solve |> IO.puts

@_Ivana · 20.09.2016, 03:50

1)

Haskell
1
main = print . sum . map (\x -> if x=='(' then 1 else -1) $ s

2)

Haskell
1
2
3
4
5
6
7
8
9
parse :: String -> [Int]
parse = map read . words . map (\x -> if x=='x' then ' ' else x)
 
f [a,b,c] = 2 * sum l + minimum l where l = [a*b, b*c, a*c]
 
main = do
    h <- openFile "2.txt" ReadMode
    hGetContents h >>= print . sum . map (f . parse) . words
    hClose h

3)

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
task = length . nub . foldr f [(0,0)] where
    f x a = d x (head a) : a
    d '^' (x,y) = (x, y+1) 
    d '>' (x,y) = (x+1, y) 
    d '<' (x,y) = (x-1, y) 
    d 'v' (x,y) = (x, y-1) 
    d _   h     = h
 
main = do
    h <- openFile "3.txt" ReadMode
    hGetContents h >>= print . task
    hClose h

4) Чета лениво было разбираться как руками МД5 считать - заюзал готовый пакет

Haskell
1
2
3
4
task s = L.findIndex (L.isPrefixOf "00000") . L.map f $ [0..] where
    f i = show . md5 . pack $ s ++ show i
 
main = print $ task "bgvyzdsv"

5)

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
p1   = (>=3) . length . filter (flip elem ("aeiou" :: String))
p2   = any (>1) . map length . group
p3 s = not . any (flip isInfixOf s) $ ["ab", "cd", "pq", "xy"]
 
nice s = p1 s && p2 s && p3 s
 
task = length . filter nice . words
 
main = do
    h <- openFile "5.txt" ReadMode
    hGetContents h >>= print . task
    hClose h

Добавлено через 19 часов 56 минут
6) Ниче так задачка.

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
f a s = g (parse . dropWhile (=="turn") . words $ s) a where
    parse [cmd, ld, _, ru] = (cmd, (l, d, r, u)) where
        [(l,d),(r,u)] = map (\x -> read ('(' : x ++ ")") :: (Int,Int)) [ld,ru]
 
g (cmd, r) a | cmd == "off" = ar
             | cmd == "on"  = r : ar
             | otherwise    = foldr (\r rs -> rs >>= rests r) [r] a ++ ar
    where ar = a >>= rests r
 
rests (l1, d1, r1, u1) rect2@(l2, d2, r2, u2)
    | r1 < l2 || l1 > r2 || u1 < d2 || d1 > u2 = [rect2]
    | otherwise = concat [ru, rd, rl, rr] where
 
        ru = rectOrNull (u1 < u2) (l2, u1+1, r2, u2)
        rd = rectOrNull (d1 > d2) (l2, d2, r2, d1-1)
        rl = rectOrNull (l1 > l2) (l2, max d2 d1, l1-1, min u2 u1)
        rr = rectOrNull (r1 < r2) (r1+1, max d2 d1, r2, min u2 u1)
        rectOrNull p r | p = [r] | otherwise = []
 
task = sum . map (\(l,d,r,u) -> (r-l+1)*(u-d+1)) . foldl' f [] . lines
 
main = do
    h <- openFile "6.txt" ReadMode
    hGetContents h >>= print . task
    hClose h

Добавлено через 2 часа 9 минут
7) Ради Санты можно и почитерствовать

Пишем такой кот:

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
rewrite hr hw = do
    l <- hGetLine hr
    if l/="end" then do
        hPutStr hw $ convert l ++ "\n"
        rewrite hr hw
    else return ()
 
convert s = var ++ " = " ++ intercalate " " l where
    (l, [_, var]) = span (/= "->") . map replOp . words $ s
 
replOp op = case op of
    "AND"    -> "`and16`"
    "OR"     -> "`or16`"
    "NOT"    -> "not16"
    "LSHIFT" -> "`lshift16`"
    "RSHIFT" -> "`rshift16`"
    "->"     -> "->"
    x        -> if isDigit (head x) then x else '_' : x
 
main = do
    hr <- openFile "7.txt" ReadMode
    hw <- openFile "71.txt" WriteMode
    rewrite hr hw
    hClose hr
    hClose hw

- он нам переконвертирует входной файл вида

Code
1
2
3
4
5
6
7
af AND ah -> ai
NOT lk -> ll
hz RSHIFT 1 -> is
NOT go -> gp
du OR dt -> dv
x RSHIFT 5 -> aa
........

в файл вида

Code
1
2
3
4
5
6
7
_ai = _af `and16` _ah
_ll = not16 _lk
_is = _hz `rshift16` 1
_gp = not16 _go
_dv = _du `or16` _dt
_aa = _x `rshift16` 5
.....

который мы копируем прямо в хаскельный кот

, дописываем тривиальные обертки

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
and16 :: Word16 -> Word16 -> Word16
and16 = (.&.)
 
or16 :: Word16 -> Word16 -> Word16
or16 = (.|.)
 
not16 :: Word16 -> Word16
not16 = complement
 
lshift16 :: Word16 -> Int -> Word16
lshift16 = shiftL
 
rshift16 :: Word16 -> Int -> Word16
rshift16 = shiftR
 
main = print _a
 
_ai = _af `and16` _ah
_ll = not16 _lk
_is = _hz `rshift16` 1
_gp = not16 _go
_dv = _du `or16` _dt
_aa = _x `rshift16` 5
.....

компилируем, запускаем и получаем результат

При конвертации пришлось учесть, что в хаскеле функции нельзя называть с заглавных букв, инфиксные функции надо заключать в обратные апострофы и нельзя заводить зарезервированные имена переменных типа "do" - поэтому добавил подчеркивания

Зато порядок деклараций неважен! Как говорил один пропессор - Декларативное рулит! (С)

Добавлено через 37 минут
8)

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
f n [] = n - 2
f n (c:cx) = f (n+1) $ if c=='\\' then (g cx) else cx
 
g [] = []
g (c:cx) = if c=='x' then drop 2 cx else cx
 
task s = a - b where
    ls = lines s
    a = sum . map length $ ls
    b = sum . map (f 0) $ ls
 
main = do
    h <- openFile "8.txt" ReadMode
    hGetContents h >>= print . task
    hClose h

Добавлено через 1 час 39 минут
9)

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
dist m (x:xs) = fst $ L.foldr f (0, x) xs where
 
    f x2 (r, x1) = (r + d12 x1 x2, x2)
 
    d12 x1 x2 = case M.lookup (x1, x2) m of
        Just x -> x
        Nothing -> case M.lookup (x2, x1) m of
            Just x -> x
            Nothing -> 0
 
f pl = L.minimum . L.map (dist m) . permutations . L.nub $ l1 ++ l2 where
    m = M.fromList pl
    (l1, l2) = unzip . L.map fst $ pl
 
parse = (\[a, _, b, _, r] -> ((a,b), read r :: Int)) . words
 
task = f . L.map parse . lines
 
main = do
    h <- openFile "9.txt" ReadMode
    hGetContents h >>= print . task
    hClose h

Добавлено через 22 минуты
10)

Haskell
1
2
3
f = ((\x -> show (length x) ++ [head x]) =<<) . group
 
main = print . length . (!!40) . iterate f $ "3113322113"

@ct0r · 20.09.2016, 17:51 **[ТС]**

_Ivana, а на хаскеле нельзя попроще сделать 7?

Вот у меня так, особенности такие:
0) Как только меняется файл input.txt, это вызывает перекомпиляцию.
1) Никакой ручной работы или других файлов.
2) Читаем файл input.txt, в каждой строке заменяем все операции, к идентификаторам добавляем _. Генерируем все необходимые функции.
3) Есть кэш, который позволяет не считать одни и те же значения много раз.
4) Вторая часть тоже решена.

Bash
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
defmodule Cache do
  use Bitwise
 
  def start_link() do
    Agent.start_link(&Map.new/0, name: __MODULE__)
  end
 
  def add(key, value_fn) do
    result = Agent.get(__MODULE__, &(&1)) |> Map.get_lazy(key, value_fn) |> Bitwise.band(0xFFFF)
    Agent.update(__MODULE__, &(Map.put_new(&1, key, result)))
    result
  end
 
  def force_update(key, value) do
    Agent.update(__MODULE__, &(Map.put(&1, key, value)))
  end
 
  def clear() do
    Agent.update(__MODULE__, fn(_cache) -> Map.new end)
  end
end
 
defmodule Task7 do
  use Bitwise
  @external_resource wire_path = Path.join([__DIR__, "input.txt"])
 
  for line <- File.stream!(wire_path, [], :line) do
    [rest, name] = line |> String.split("->") |> Enum.map(&String.strip(&1))
    name_atom = (name <> "_") |> String.to_atom()
    body =
      rest
      |> String.replace("RSHIFT", ">>>")
      |> String.replace("LSHIFT", "<<<")
      |> String.replace("OR", "|||")
      |> String.replace("AND", "&&&")
      |> String.replace("NOT", "~~~")
      |> String.replace(~r/([a-z]+)/, "\\1_")
      |> Code.string_to_quoted!()
    def unquote(name_atom)() do
      Cache.add(unquote(name), fn() -> unquote(body) end)
    end
  end
end
 
Cache.start_link()
result1 = Task7.a_()
Cache.clear()
Cache.force_update("b", result1)
result2 = Task7.a_()
IO.puts("#{result1} and #{result2}")

@_Ivana · 22.09.2016, 01:46

ct0r, может и можно, через темплейты (которые я не курил), внешние сценарии компиляции и т.п. Но по-моему то что я привел - и так проще некуда

Был бы входной файл сразу в нужном формате - вообще почти ничего делать не надо было бы. Хотя можно и по-нормальному решить, через собственный парсер-вычислитель

Добавлено через 1 час 25 минут
11)

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
inc [] = []
inc (c:cs) | c=='z' = 'a' : inc cs
           | otherwise = succ c : cs
 
valid s = p1 && p2 && p3 where
    l = map fromEnum s
    p1 = any id $ zipWith3 (\c b a -> b-a==1 && c-b==1) l (tail l) (tail.tail $ l)
    p2 = not . any (flip elem ("iol" :: String)) $ s
    lg = map length . group $ s
    p3 = any (>=4) lg || ((>=2) . length . filter (>=2) $ lg)
 
main = print . reverse. until valid inc . inc . reverse $ "hepxcrrq"

Добавлено через 22 минуты
12)

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
insSp l z = go where
    go [] = []
    go (c:cs) | elem c l  = c:z:go cs
              | otherwise = c:go cs
 
readNum s | null ds = 0
          | otherwise = read ds :: Int where ds = takeWhile (\c -> isDigit c || c=='-') s
 
task = sum . map readNum . words . insSp ("[,:" :: String) '\n'
 
main = do
    h <- openFile "12.txt" ReadMode
    hGetContents h >>= print . task
    hClose h

Добавлено через 2 часа 6 минут
12.2) Если первая часть прокатила нахаляву - просто банально вставил переводы строк перед числами в линейный текст и сложил, то для второй части таки пришлось покурить JSON, библиотеки для его парсинга и разобраться с типами получаемых значений... То есть, пришлось дорисовать остаток совы. Хотя выглядит лаконично, думаю можно еще ужать кот при желании, поискав готовые комбинаторы:

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
task = fmap f . decode
 
f (JSArray l)                = sum $ map f l
f (JSRational _ r)           = numerator r
f (JSObject v) | any isRed l = 0
               | otherwise   = sum $ map (f.snd) l where l = fromJSObject v
f _ = 0
 
isRed (_, JSString js) = fromJSString js == "red"
isRed _ = False
 
main = do
    h <- openFile "12.txt" ReadMode
    hGetContents h >>= print . task
    hClose h

Добавлено через 7 минут
ЗЫ и как это всегда бывает с мощовыми haskell-ными абстракциями, после их покурки предыдущий велосипедный кот (первого варианта) становится короче и элегантнее

12)

Haskell
1
2
3
4
5
6
task = fmap f . decode
 
f (JSArray l)      = sum . map f $ l
f (JSRational _ r) = numerator r
f (JSObject v)     = sum . map (f.snd) . fromJSObject $ v
f _                = 0

Добавлено через 38 минут
13) очень похоже на задачу 9

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
f pl = L.maximum . L.map happiness . permutations . L.nub . $ l1 ++ l2 where
    (l1, l2) = unzip . L.map fst $ pl
    happiness l = sum . L.map d . zip l $ tail l ++ [head l]
    d (a,b) = M.findWithDefault 0 (a,b) m + M.findWithDefault 0 (b,a) m
    m = M.fromList pl
 
parse = (\[a, _, gl, n, _,_,_,_,_,_, b] -> ((a,init b), getGl gl n)) . words
 
getGl "gain" n = read n :: Int
getGl "lose" n = negate $ read n :: Int
 
task = f . L.map parse . lines
 
main = do
    h <- openFile "13.txt" ReadMode
    hGetContents h >>= print . task
    hClose h

Добавлено через 15 минут
14)

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
trace n (a, v, tv, tr) = (sum . take n . cycle $ replicate tv v ++ replicate tr 0, a)
 
parse = (\[a, _,_, v, _,_, tv, _,_,_,_,_,_, tr, _] -> (a, ri v, ri tv, ri tr)) . words
 
ri n = read n :: Int
 
task = maximum . map (trace 2503 . parse) . lines
 
main = do
    h <- openFile "14.txt" ReadMode
    hGetContents h >>= print . task
    hClose h

Добавлено через 1 час 19 минут
15) Тупорылый убогий частный брутфорс вместо не то что красивого Симплекс-метода, а хоть чего-нибудь не столь корявого... Что называется, квик анд дёрти:

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
g ks = product . map (max 0 . sum . zipWith (*) ks)
 
f l = maximum [g [a,b,c,100-a-b-c] l | a<-[0..100], b<-[0..100-a], c<-[0..100-a-b]]
 
parse = (\[_,_,c,_,d,_,f,_,t,_,l] -> map (\n -> read (init n) :: Int) [c,d,f,t]) . words
 
task = f . transpose . map parse . lines
 
main = do
    h <- openFile "15.txt" ReadMode
    hGetContents h >>= print . task
    hClose h

Добавлено через 19 часов 25 минут
16)

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
f = L.filter (L.all id . M.elems . intersectionWith (==) m . snd)
 
p (a:b:xs) = (drp ':' a, read (drp ',' b) :: Int) : p xs
p _ = []
 
drp c = L.filter (/=c)
 
m = M.fromList . p . words $ "children: 3, cats: 7, samoyeds: 2, pomeranians: 3,\
    \ akitas: 0, vizslas: 0, goldfish: 5, trees: 3, cars: 2, perfumes: 1"
 
parse = (\([_,n], l) -> (read (drp ':' n) :: Int, M.fromList $ p l)) . splitAt 2 . words
 
task = f . L.map parse . lines
 
main = do
    h <- openFile "16.txt" ReadMode
    hGetContents h >>= print . task
    hClose h

Добавлено через 1 час 8 минут
17)

Haskell
1
2
3
4
5
6
go [] = [[]]
go (x:xs) = r ++ map (x:) r where r = go xs
 
task = length . filter ((==150) . sum) . go
 
main = print $ task [50,44,11,49,42,46,18,32,26,40,21,7,18,43,10,47,36,24,22,40]

Добавлено через 1 час 24 минуты
18) Конвеевская Жизнь, убого на списках, без сетов/мапов/арраев/векторов/комонад... Тормоза за счет l!!r!!c как минимум... Но ответы дает, а что еще Николаю надо

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
n = 100
ps = zipWith (\r -> map ((,) r)) [0..] $ replicate n [0..n-1]
 
rule l (r,c) | l!!r!!c == '#' = if elem nbs [3,4] then '#' else '.'
             | otherwise      = if nbs == 3 then '#' else '.'
    where
        nbs = length . filter (=='#') $ dd r l >>= dd c
        dd c = take (2 + c - max (c-1) 0) . drop (c-1)
 
step l = map (map (rule l)) ps
 
task = length . filter (=='#') . unlines . (!!n) . iterate step . lines
 
main = do
    h <- openFile "18.txt" ReadMode
    hGetContents h >>= print . task
    hClose h

Добавлено через 46 минут
19)

Haskell
1
2
3
4
5
6
7
8
9
replace (old, new) = filter (not . null) . map r . zip (inits s) $ tails s where
    r (a, b) = if isPrefixOf old b then a ++ new ++ drop (length old) b else []
 
task = length . nub . (replace =<<) . map ((\[a,_,b] -> (a,b)) . words) . lines
 
main = do
    h <- openFile "19.txt" ReadMode
    hGetContents h >>= print . task
    hClose h

@_Ivana · 23.09.2016, 22:47

19.2 пока ниасилил

20) 776160. И не спрашивайте как я это получил

Добавлено через 31 минуту
20.2) 786240

@ct0r · 23.09.2016, 23:18 **[ТС]**

_Ivana, меня пока подзадолбало на эликсире писать, сейчас тоже парочку на хаскеле бабахну

@_Ivana · 24.09.2016, 04:54

Эз фо ми, там парочка парочке рознь

Некоторые я вполне мог и на своем Лискрипте написать, а для некоторых тяжелая артиллерия в виде haskell весьма кстати.

Добавлено через 21 минуту
21)

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
ds = [[8,4,0],[10,5,0],[25,6,0],[40,7,0],[74,8,0]]
 
as = [[13,0,1],[31,0,2],[53,0,3],[75,0,4],[102,0,5],[0,0,0]]
 
rs = [[25,1,0],[50,2,0],[100,3,0],[20,0,1],[40,0,2],[80,0,3],[0,0,0]]
 
boss = (104,(8,1))
 
vars = [v [d,a,r1,r2] | d<-ds, a<-as, r1<-rs, r2<-rs, r1<=r2]
 
v = (\[c,d,a] -> (c,(100,(d,a)))) . foldr (zipWith (+)) [0,0,0]
 
fight me = go False me boss where
    go f m@(mp,(md,ma)) (bp,(bd,ba))
        | mp <= 0   = f
        | otherwise = go (not f) (bp - max 1 (md-ba), (bd,ba)) m
 
main = print . minimum . filter (snd) . map (fmap fight) $ vars

Добавлено через 4 часа 47 минут
22) Наконец-то пошли задачки, в которых удобно использовать свои доморощенные примитивные типы... А по сути - простой поиск в ширину с отсечениями, ~~так его~~...

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
data Spell = Missile | Drain | Shield | Poison | Recharge deriving (Show, Eq, Ord)
 
data G = G { hit :: Int, armor :: Int, mana :: Int, spendingmana :: Int,
             bosshit :: Int, effects :: [(Spell, Int)] } deriving (Show, Eq, Ord)
 
app1effect e g = case e of
    Shield   -> g {armor = 7}
    Poison   -> g {bosshit = bosshit g - 3}
    Recharge -> g {mana = mana g + 101}
 
appeffects g = newg { effects = filter ((>0).snd) . map (fmap pred) $ effects newg }
    where newg = foldr app1effect (g {armor = 0}) . map fst $ effects g
 
mystep g s = case s of
    Missile  -> cost 53  $ g { bosshit = bosshit g - 4 }
    Drain    -> cost 73  $ g { hit = hit g + 2, bosshit = bosshit g - 2 }
    Shield   -> cost 113 $ g { effects = (Shield,   6) : effects g }
    Poison   -> cost 173 $ g { effects = (Poison,   6) : effects g }
    Recharge -> cost 229 $ g { effects = (Recharge, 5) : effects g }
    where
        cost n g = g { mana = mana g - n, spendingmana = spendingmana g + n }
 
bossstep g = g { hit = hit g - (max 1 $ bossDamage - armor g) }
 
myturns g = if null gs then [g {hit = 0}] else gs where
 
    gs = filter ((>=0).mana) . map (mystep g) $
 
        [Missile, Drain, Shield, Poison, Recharge] \\ map fst (effects g)
 
turns = cycle [map appeffects, (myturns =<<), map appeffects, map bossstep]
 
task _      r [] = r
task (t:ts) r gs = task ts newr gplayneed where
 
    (gfin, gplay) = partition (\g -> hit g <= 0 || bosshit g <= 0) $ t gs
 
    newr = minimum . (r:) . map spendingmana . filter ((<=0).bosshit) $ gfin
 
    gplayneed = filter ((<newr).spendingmana) gplay
 
bossHit = 51
bossDamage = 9
 
main = print . task turns (maxBound :: Int) $ [G 50 0 500 0 bossHit []]

Добавлено через 7 минут
22.2) дописываем одну функцию и добавляем ее в цепочку итераций

Haskell
1
2
3
lose1hit g = g { hit = hit g - 1 }
 
turns = cycle [map lose1hit, map appeffects, (myturns =<<), map appeffects, map bossstep]

@ct0r · 24.09.2016, 05:17 **[ТС]**

_Ivana, 8-ая задача, обе части сразу:

Haskell
1
2
3
4
5
6
7
8
9
goSolve [] r = r
goSolve ('\\':'\\':xs)    (r1, r2) = goSolve xs (r1 + 1, r2 + 2)
goSolve ('\\':'"':xs)     (r1, r2) = goSolve xs (r1 + 1, r2 + 2)
goSolve ('\\':'x':_:_:xs) (r1, r2) = goSolve xs (r1 + 3, r2 + 1)
goSolve (x:xs) r = goSolve xs r
 
solve s = goSolve s (2 * linesCount, 4 * linesCount) where linesCount = length $ lines s
 
main = solve <$> readFile "input.txt" >>= print

@_Ivana · 25.09.2016, 01:32

ct0r, красиво, особенно однострочный мэйн, а не как у меня по-лоховски

Добавлено через 12 часов 52 минуты
23.1) вторую часть пока не посчитал - этот алгоритм тормозит

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
data Cmd = Hlf Char | Tpl Char | Inc Char | Jmp Int | Jie Char Int | Jio Char Int
    deriving (Show, Eq, Ord)
 
readcmd = go . words . filter (not . flip elem ("+,"::String)) where
    go (cmd : x@(a:_) : y) = case cmd of
        "hlf" -> Hlf a
        "tpl" -> Tpl a
        "inc" -> Inc a
        "jmp" -> Jmp xi
        "jie" -> Jie a yi
        "jio" -> Jio a yi
        where
            xi = read x::Int
            yi = read (head y)::Int
 
task l = go . M.fromList .zip "abi" $ [0,0,0] where
 
    program = M.fromList . zip [0..] . map readcmd . lines $ l
 
    go m = case M.lookup (m M.! 'i') program of
        Nothing  -> m
        Just cmd -> go $ run m cmd
 
    run m cmd = case cmd of
        Hlf x   -> op x (`div`2)
        Tpl x   -> op x (*3)
        Inc x   -> op x (+1)
        Jmp x   -> M.adjust (+x) 'i' m
        Jie x y -> M.adjust (if even (m M.! x) then (+y) else (+1)) 'i' m
        Jio x y -> M.adjust (if m M.! x == 1   then (+y) else (+1)) 'i' m
        where
            op x f = M.adjust (+1) 'i' . M.adjust f x $ m
 
main = task <$> readFile "23.txt" >>= print

24) все тот же поиск в ширину с отсечениями...

Haskell
1
2
3
4
5
6
7
8
9
10
11
task l = minimum . map (\v -> (length v, product v)) . go . map (:[]) $ l where
 
    s = sum l `div` 3
 
    go vs | null r    = go $ vs >>= f
          | otherwise = r
        where
            r = filter ((==s) . sum) vs
            f v = map (:v) (filter (< head v) l)
 
main = task . map (\x -> read x::Integer) . lines <$> readFile "24.txt" >>= print

Добавлено через 30 минут
25) Пишет, для полного счастья не хватает трех нерешенных на предыдущих этапах задач... Я оставил на потом их вторые части - буду думать над ними.

Haskell
1
2
3
4
5
6
7
go r c x | r==2981 && c==3075 = x
         | r==1      = go (c+1) 1     $! (f x)
         | otherwise = go (r-1) (c+1) $! (f x)
 
f x = x * 252533 `rem` 33554393
 
main = print $ go 1 1 20151125

Добавлено через 44 минуты
UPD пара задачек решилась - в одной забыл отличия правой и левой сверток, алгоритм придумал с левой, а в кот влепил правую (она типа кошернее в ленивых языках

), и пока все было коммутативно и пофиг с какого конца сворачивать, все работало, а во второй части стало не пофиг, но все отлично продолжало компилироваться и выдавать результат, только не тот

Вот она хваленая строжайшая статическая типизация и "компилируется - значит работает" (С)

Всегда найдется возможность для незаметного на первый взгляд бага, который появляется при безобиднейшей казалось бы доработке алгоритма.
В другой задаче все проще - я из лени типы не пишу, оставляю компилятору на автовывод, так по умолчанию он целые числа выводит как безразмерные, но упоминание любой функции, работающей с индексами чего-либо автоматом кастит-сужает все связанные с этой переменной другие тоже к ограниченным интам - со всеми радостями в виде залезания в отрицательные значения при переполнении и т.п. Я думал алгоритм тормозит, а он просто в минусах валялся

ЗЫ отладка на haskell конечно немного отличается от обычных земных языков - точки останова если и поставишь, то явно не в коде в блокноте

, отладочную печать если и выведешь - то не факт что порядок будет ожидаемый

В общем, занятно, тренирует мозги писать функции, нагребающие и вываливающие вместе с результатом кучу отладочной инфы...

Все решено, геймова

You fill the weather machine with fifty stars. It comes to life! Snow begins to fall.

Было весьма занимательно, хотя мне не понравилось, как я решил некоторые задачки.

ЗЫ ct0r, предложу вам алаверды - задачки отсюда http://www.codewars.com/ Я там даже несколько своих задачек поместил, в разделе по хаскелю

И хотя их так и не вывели из статуса беты, мне они нравятся. Да и остальные там неплохие есть весьма, правда их мало на фоне вала среднего уровня.

@_Ivana · 03.12.2016, 10:47

Тут эта... По ссылке из первого поста новый раунд 2016 начался вчера...

Добавлено через 46 минут
1)

Haskell
1
2
3
4
5
6
7
8
9
10
rot 'L' (i,j) = (-j,i)
rot 'R' (i,j) = (j,-i)
 
move n (x, y, (i,j)) = (x+n*i, y+n*j, (i,j))
 
f (x, y, v) (d:l) = move (read l::Int) (x, y, rot d v)
 
task = (\(x,y,_) -> abs x + abs y) . foldl' f (0,0,(0,1))
 
main = task . words . filter (/=',') <$> readFile "1.txt" >>= print

Добавлено через 24 минуты
2)

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
mov i 'L' | i `mod` 3 == 1 = i | otherwise = i-1
mov i 'R' | i `mod` 3 == 0 = i | otherwise = i+1
mov i 'U' | i <= 3 = i | otherwise = i-3
mov i 'D' | i >= 7 = i | otherwise = i+3
 
movpath :: Int -> String -> Int
movpath p s = foldl' mov p s
 
f a@(x:_) p = movpath x p : a
 
task = (>>= show) . tail . reverse . foldl' f [5]
 
main = task . lines <$> readFile "2.txt" >>= print

Добавлено через 10 часов 16 минут
3)

Haskell
1
2
3
valid s = a + b > c where [a,b,c] = sort . map (\x -> read x::Int) . words $ s
 
main = length . filter valid . lines <$> getContents >>= print

@_Ivana · 06.12.2016, 21:40

4)

Haskell
1
2
3
4
5
6
7
8
f = take 5 . map snd . sort . map (\x -> (100-length x, head x)) . group . sort . filter (/='-')
 
g (a, (b, c)) | '[' : f a ++ "]" == c = read b :: Int
              | otherwise = 0
 
h = g . fmap (span isDigit) . break isDigit
 
main = sum . map h . lines <$> readFile "4.txt" >>= print

Добавлено через 20 часов 44 минуты
5)

Haskell
1
2
main = print . map (!!5) . take 8 . filter ((=="00000").take 5)
    . map (show . md5 . BS.pack . ("uqwqemis"++) . show) $ [1..]

Добавлено через 23 часа 20 минут
6)

Haskell
1
2
main = map (snd . maximum . map (\x -> (length x, head x)) . group . sort)
    . transpose . lines <$> readFile "6.txt" >>= print

@_Ivana · 08.12.2016, 00:06

7)

Haskell
1
2
3
4
5
6
7
8
9
valid s = any (\x -> any (isInfixOf x) is) $ os >>= c3s where
    l = words . map (\c -> if elem c ("[]"::String) then ' ' else c) $ s
    (os, is) = (\(a,b) -> (map snd a, map snd b)) . partition (even . fst) . zip [0..] $ l
 
    c3s t@(a:b:c:cs) | a==c && a/=b = [b,a,b] : c3s (tail t)
                     | otherwise = c3s (tail t)
    c3s _ = []
 
main = length . filter valid . lines <$> readFile "7.txt" >>= print

@_Ivana · 09.12.2016, 14:37

8)

Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
rows = 6
cols = 50
field = replicate rows $ replicate cols 0
 
act s | cmd == "rect" = rect x y
      | rc  == "row"  = row xy n
      | otherwise     = column xy n where
    (cmd:ps) = words s
    (rc:xys:_:ns:_) = ps
    n = read ns::Int
    xy = read (drop 2 xys)::Int
    [x,y] = map (\x -> read x::Int) . words . map (\x -> if x=='x' then ' ' else x) . head $ ps
 
rect x y f = map (\r -> replicate x 1 ++ drop x r) (take y f) ++ drop y f
 
mov l y n f = take y f ++ (take l . drop (l-n) . cycle $ f!!y) : drop (y+1) f
 
row = mov cols
 
column x n = transpose . mov rows x n . transpose
 
task = sum . map sum . foldl' (flip act) field
 
main = task . lines <$> readFile "8.txt" >>= print

8.2) Красиво закодировано

Haskell
1
2
3
4
5
6
7
8
9
10
task = map (map (\i -> if i==0 then ' ' else '@')) . foldl (flip act) field
 
main = task . lines <$> readFile "8.txt" >>= mapM putStrLn
 
@@@@   @@ @  @ @@@  @  @  @@  @@@  @    @   @  @@ 
   @    @ @  @ @  @ @ @  @  @ @  @ @    @   @   @ 
  @     @ @@@@ @  @ @@   @    @  @ @     @ @    @ 
 @      @ @  @ @@@  @ @  @    @@@  @      @     @ 
@    @  @ @  @ @ @  @ @  @  @ @    @      @  @  @ 
@@@@  @@  @  @ @  @ @  @  @@  @    @@@@   @   @@

Добавлено через 14 часов 1 минуту
9)

Haskell
1
2
3
4
5
6
7
8
f [] = []
f s@(c:cs) | c=='('    = (concat . replicate (read ns::Int) . take l $ t) ++ f (drop l t)
           | otherwise = c : f cs where
    (ps, _:t ) = span (/=')') cs
    (ls, _:ns) = span (/='x') ps
    l = read ls::Int
 
main = length . f . filter (not . isSpace) <$> getContents >>= print

Добавлено через 10 минут
9.2) Действительно, нам результирующая строка в памяти не нужна - сразу считаем ее длину:

Haskell
1
2
3
4
5
6
7
8
f [] = 0
f s@(c:cs) | c=='('    = (read n::Int) * f ss + f st
           | otherwise = 1 + f cs where
    (ps, _:t) = span (/=')') cs
    (l,  _:n) = span (/='x') ps
    (ss, st ) = splitAt (read l::Int) t
 
main = f . filter (not . isSpace) <$> getContents >>= print

@_Ivana · 01.12.2021, 02:18

Тут эта... По ссылке из первого поста новый раунд 2021 начнется скоро...

Новые блоги и статьи Все статьи Все блоги /
PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Access VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .
Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .

@_Ivana 4949 / 2289 / 287 Регистрация: 01.03.2013 Сообщений: 5,984 Записей в блоге: 32
	23.09.2016, 22:47
	19.2 пока ниасилил 20) 776160. И не спрашивайте как я это получил Добавлено через 31 минуту 20.2) 786240 0

@ct0r Игогошка! 1801 / 708 / 44 Регистрация: 19.08.2012 Сообщений: 1,367
	23.09.2016, 23:18 [ТС]
	_Ivana, меня пока подзадолбало на эликсире писать, сейчас тоже парочку на хаскеле бабахну 0

@_Ivana 4949 / 2289 / 287 Регистрация: 01.03.2013 Сообщений: 5,984 Записей в блоге: 32
	01.12.2021, 02:18
	Тут эта... По ссылке из первого поста новый раунд 2021 начнется скоро... 0