Skip to content

Instantly share code, notes, and snippets.

View msakai's full-sized avatar

Masahiro Sakai msakai

View GitHub Profile
-- |
--
-- * [Secant method](https://en.wikipedia.org/wiki/Secant_method)
--
-- * [割線法](https://ja.wikipedia.org/wiki/%E5%89%B2%E7%B7%9A%E6%B3%95)
module SecantMethod where
secantMethod :: (Eq a, Fractional a) => (a -> a) -> a -> a -> [a]
secantMethod f x0 x1 = map fst xs
where
/*
NY Times の記事 "Dead Lay Out in Bucha for Weeks, Refuting Russian Claim, Satellite Images Show - The New York Times"
https://www.nytimes.com/2022/04/04/world/europe/bucha-ukraine-bodies.html
での「ロシア占領中の3月19日時点の衛星画像で死体が確認できる」と言う主張に対して、
「OSINT/GEOINTによって撮影時刻は4月1日11:57(UTC)である」と言う反論がなされている。
- ロシア語: https://t.me/rybar/30599
- 英訳: https://t.me/realCRP/4200
- 日本語訳: https://t.me/wakeupjapancomeon/1605
-- Fisher–Yates shuffle algorithm
-- https://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle#Modern_method
--
-- Note that mwc-random provides functions for permuting vectors.
-- https://hackage.haskell.org/package/mwc-random-0.14.0.0/docs/System-Random-MWC-Distributions.html#g:5
--
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE BangPatterns #-}
module Shufle
( shuffleVector
{-# LANGUAGE FlexibleContexts, GADTs, TypeFamilies #-}
class T a where
type Config a
getConfig :: a -> Config a
data D where
T :: T a => a -> D
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module ProximalGradientMethod where
import Data.Foldable
import Data.Reflection (Reifies)
import Numeric.AD
import Numeric.AD.Mode.Reverse
import Numeric.AD.Internal.Reverse (Tape)
{-# LANGUAGE FlexibleContexts #-}
import Control.Exception
import qualified Data.Vector.Generic as VG
import Numeric.LinearAlgebra
eulerMethod :: Fractional a => (a -> a -> a) -> a -> a -> a -> a
eulerMethod f h t y = y + h * f t y
-- https://ja.wikipedia.org/wiki/%E3%83%AB%E3%83%B3%E3%82%B2%EF%BC%9D%E3%82%AF%E3%83%83%E3%82%BF%E6%B3%95
{-# LANGUAGE BangPatterns #-}
import Control.Exception
-- crt [(3,2), (5,3), (7,2)] == 23
crt :: [(Integer, Integer)] -> Integer
crt xs = assert (all (\(n, a) -> ret `mod` n == a) xs) $ ret
where
ret = foldl add 0 [m' `mul` a `mul` t | (n, a) <- xs, let m' = m `div` n, let (d, t, _) = exgcd m' (- n), assert (d == 1) True]
m = product [n | (n, a) <- xs]
{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
import Test.QuickCheck
import qualified Test.QuickCheck.Monadic as QM
import qualified Z3.Monad as Z3
{-
a x + b y = n d where d = gcd(a,b) の解は必ず
(x, y) = (n x0 + b/d k, n y0 - a/d k)
の形で書けることを示したい。

Keybase proof

I hereby claim:

  • I am msakai on github.
  • I am msakai (https://keybase.io/msakai) on keybase.
  • I have a public key ASDrKkF7omBH58cR0sbmFTS_5TDhq_tjLEVi0wWi2IFfNgo

To claim this, I am signing this object: