このディレクトリの索引

http://pc12.2ch.net/test/read.cgi/tech/1245853701/162 
# [1] 授業単元:数値計算  
# [2] 問題文(含コード&リンク):の連立1次方程式の解をガウスの消去法用いて解くプログラムを作成しなさい。  
#    (この行列を使用してください  
# {{10,-9,0,0,0,0,0,0},
# {-9,17,-8,0,0,0,0,0},
# {0,-8,17,-9,0,0,0,0},
# {0,0-9,13,-4,0,0,0},
# {0,0,0,-4,12,-8,0,0},
# {0,0,0,0,-8,10,-2,0},
# {0,0,0,0,0,-2,2,7}}
% 以下の定義では必ずしもこの問題に必要としない行列処理の述語定義も含んで
% います。

問題の行列([[10,-9,0,0,0,0,0,0],
            [-9,17,-8,0,0,0,0,0],
            [0,-8,17,-9,0,0,0,0],
            [0,0-9,13,-4,0,0,0],
            [0,0,0,-4,12,-8,0,0],
            [0,0,0,0,-8,10,-2,0],
            [0,0,0,0,0,-2,2,7]]).


t310(_解ならび) :-
        問題の行列(_問題の行列),
        既約ガウス行列に変形(_問題の行列,_既約ガウス行列),
        findall(X,(member(L,_既約ガウス行列),last(L,X)),_解ならび).


ガウス行列(_,[]) :- !.
ガウス行列(L,[_行|R]) :-
        append(L,_,_行),
        要素がゼロ以外に出会うまで(_行,P1,_),
        ガウス行列([0|P1],R).

ガウス行列(_,[]) :- !.
ガウス行列(L,[_行|R]) :-
        append(L,_,_行),
        要素がゼロ以外に出会うまで(_行,P1,_),
        ガウス行列([0|P1],R).

ガウス行列(_行列) :-
        ガウス行列([],_行列).


% *** user: 'ガウス行列に変形' / 7 ***
'ガウス行列に変形'(N,M,Len,_,_行列,_行列,[]) :-
        M > Len,!.
'ガウス行列に変形'(N,M,Len,0,_行列1,X,UL) :-
        list_nth(M,_行列1,_行1),
        list_nth(N,_行1,B),
        \+(B = 0),
        '行の置換'(N,M,_行列1,_行列2),
        M2 is N + 1,
        'ガウス行列に変形'(N,M2,Len,B,_行列2,X,UL),!.
'ガウス行列に変形'(N,M,Len,0,_行列1,X,UL) :-
        list_nth(M,_行列1,_行1),
        list_nth(N,_行1,B),
        B = 0,
        M2 is N + 1,
        'ガウス行列に変形'(N,M2,Len,0,_行列1,X,UL),!.
'ガウス行列に変形'(N,M,Len,A,_行列1,X,[(-1)|R]) :-
        list_nth(M,_行列1,_行1),
        list_nth(N,_行1,0),
        M2 is M + 1,
        'ガウス行列に変形'(N,M2,Len,A,_行列1,X,R),!.
'ガウス行列に変形'(N,M,Len,A,_行列1,X,[N1|R]) :-
        list_nth(M,_行列1,_行1),
        list_nth(N,_行1,B),
        '最小公倍数'(N2 * A,N1 * B,_),
        N1 >= 0,!,
        '行基本変形'(N1 # M - N2 # N,_行列1,_行列2),
        M2 is M + 1,
        'ガウス行列に変形'(N,M2,Len,A,_行列2,X,R),!.
'ガウス行列に変形'(N,M,Len,A,_行列1,X,[N3|R]) :-
        list_nth(M,_行列1,_行1),
        list_nth(N,_行1,B),
        '最小公倍数'(N2 * A,N1 * B,_),
        N1 < 0,!,
        N3 is N1 * (-1),
        '行基本変形'(N3 # M + N2 # N,_行列1,_行列2),
        M2 is M + 1,
        'ガウス行列に変形'(N,M2,Len,A,_行列2,X,R),!.

% *** user: 'ガウス行列に変形' / 6 ***
'ガウス行列に変形'(N,M,Len,_,_行列,_行列) :-
        M > Len,!.
'ガウス行列に変形'(N,M,Len,0,_行列1,X) :-
        list_nth(M,_行列1,_行1),
        list_nth(N,_行1,B),
        \+(B = 0),
        '行の置換'(N,M,_行列1,_行列2),
        M2 is N + 1,
        'ガウス行列に変形'(N,M2,Len,B,_行列2,X),!.
'ガウス行列に変形'(N,M,Len,0,_行列1,X) :-
        list_nth(M,_行列1,_行1),
        list_nth(N,_行1,B),
        B = 0,
        M2 is N + 1,
        'ガウス行列に変形'(N,M2,Len,0,_行列1,X),!.
'ガウス行列に変形'(N,M,Len,A,_行列1,X) :-
        list_nth(M,_行列1,_行1),
        list_nth(N,_行1,0),
        M2 is M + 1,
        'ガウス行列に変形'(N,M2,Len,A,_行列1,X),!.
'ガウス行列に変形'(N,M,Len,A,_行列1,X) :-
        list_nth(M,_行列1,_行1),
        list_nth(N,_行1,B),
        '最小公倍数'(N2 * A,N1 * B,_),
        '行基本変形'(N1 # M - N2 # N,_行列1,_行列2),
        M2 is M + 1,
        'ガウス行列に変形'(N,M2,Len,A,_行列2,X),!.

% *** user: ガウス行列に変形 / 5 ***
ガウス行列に変形(N,Len,X,X,[]) :-
        N >= Len,!.
ガウス行列に変形(N,Len,_行列1,X,UL) :-
        list_nth(N,_行列1,_行),
        list_nth(N,_行,A),
        M is N + 1,
        ガウス行列に変形(N,M,Len,A,_行列1,_行列2,UL1),
        N2 is N + 1,
        ガウス行列に変形(N2,Len,_行列2,X,UL2),
        append(UL1,UL2,UL).

% *** user: ガウス行列に変形 / 4 ***
ガウス行列に変形(N,Len,X,X) :-
        N >= Len,!.
ガウス行列に変形(N,Len,_行列1,X) :-
        list_nth(N,_行列1,_行),
        list_nth(N,_行,A),
        M is N + 1,
        ガウス行列に変形(N,M,Len,A,_行列1,_行列2),
        N2 is N + 1,
        ガウス行列に変形(N2,Len,_行列2,X).

% *** user: ガウス行列に変形 / 3 ***
ガウス行列に変形(_行列,_ガウス行列,UL) :-
        length(_行列,Len),
        ガウス行列に変形(1,Len,_行列,_ガウス行列,UL).

% *** user: ガウス行列に変形 / 2 ***
ガウス行列に変形(_行列,_ガウス行列) :-
        length(_行列,Len),
        ガウス行列に変形(1,Len,_行列,_ガウス行列).

既約ガウス行列に変形(_ガウス行列,_既約ガウス行列) :-
        length(_ガウス行列,Len),
        既約ガウス行列に変形(Len,_ガウス行列,G1),
        既約ガウス行列に変形の二(1,Len,G1,_既約ガウス行列).

% *** user: '既約ガウス行列に変形' / 5 ***
'既約ガウス行列に変形'(N,0,_,_行列,_行列) :- !.
'既約ガウス行列に変形'(N,M,A,_行列1,_行列) :-
        list_nth(M,_行列1,_行1),
        list_nth(N,_行1,0),
        M2 is M - 1,
        '既約ガウス行列に変形'(N,M2,A,_行列1,_行列).
'既約ガウス行列に変形'(N,M,A,_行列1,_行列) :-
        list_nth(M,_行列1,_行1),
        list_nth(N,_行1,B),
        \+(B = 0),
/*
        '行基本変形3の適用'(A,B,M,N,_行列1,_行列2),
*/
        '最小公倍数'(N2 * A,N1 * B,_),
        '行基本変形'(N1 # M - N2 # N,_行列1,_行列2),

        M2 is M - 1,
        '既約ガウス行列に変形'(N,M2,A,_行列2,_行列).

% *** user: '既約ガウス行列に変形' / 3 ***
'既約ガウス行列に変形'(1,_既約ガウス行列,_既約ガウス行列) :- !.
'既約ガウス行列に変形'(N,_ガウス行列,_既約ガウス行列) :-
        list_nth(N,_ガウス行列,L0),
        '最初に現れる0ではない要素・位置'(1,L0,_列,Y),
        M is N - 1,
        list_nth(M,_ガウス行列,L),
        '既約ガウス行列に変形'(_列,M,N,Y,_ガウス行列,G1),
        N2 is N - 1,
        '既約ガウス行列に変形'(N2,G1,_既約ガウス行列),!.

% *** user: '既約ガウス行列に変形' / 2 ***
既約ガウス行列に変形(_行列,_既約ガウス行列) :-
        \+(ガウス行列(_行列)),
        ガウス行列に変形(_行列,_ガウス行列),
        既約ガウス行列に変形(_ガウス行列,_既約ガウス行列),!.

既約ガウス行列に変形(_ガウス行列,_既約ガウス行列) :-
        length(_ガウス行列,Len),
        既約ガウス行列に変形(Len,_ガウス行列,G1),
        既約ガウス行列に変形の二(1,Len,G1,_既約ガウス行列).

% *** user: '既約ガウス行列に変形の二' / 4 ***
既約ガウス行列に変形の二(N,Len,_既約ガウス行列,_既約ガウス行列) :-
        N > Len,!.
既約ガウス行列に変形の二(N,Len,G,_既約ガウス行列) :-
        list_nth(N,G,_行),
        list_nth(N,_行,A),
        行基本変形(1 / A # N,G,G1),
        N2 is N + 1,
        既約ガウス行列に変形の二(N2,Len,G1,_既約ガウス行列).

% *** user: 行基本変形3の適用 / 7 ***
行基本変形3の適用(A,B,M,N,_行列1,_行列2,N2) :-
        B >= 0,
        A2 is abs(A),
        B2 is abs(B),
        最小公倍数(N1 * A2,N2 * B2,_),
        行基本変形(N2#M-N1#N,_行列1,_行列2),!.
行基本変形3の適用(A,B,M,N,_行列1,_行列2,N2) :-
        B < 0,
        A2 is abs(A),
        B2 is abs(B),
        最小公倍数(N1 * A2,N2 * B2,_),
        行基本変形(N2#M+N1#N,_行列1,_行列2),!.

% *** user: 行基本変形3の適用 / 6 ***
行基本変形3の適用(A,B,M,N,_行列1,_行列2) :-
        B >= 0,
        A2 is abs(A),
        B2 is abs(B),
        最小公倍数(N1 * A2,N2 * B2,_),
        行基本変形(N2#M-N1#N,_行列1,_行列2),!.
行基本変形3の適用(A,B,M,N,_行列1,_行列2) :-
        B < 0,
        A2 is abs(A),
        B2 is abs(B),
        最小公倍数(N1 * A2,N2 * B2,_),
        行基本変形(N2#M+N1#N,_行列1,_行列2),!.

% *** user: 行基本変形 / 3 ***
行基本変形(_行列式,_行列,X) :-
        atom(_行列式),
        \+(_行列式 = []),
        & 行列式変換#2.pro,
        行列式述語変換(_行列式,P),
        行基本変形(P,_行列,X),!.
行基本変形([],_行列,[]) :- !.
行基本変形([N|R1],_行列,[L|R2]) :-
        !,
        list_nth(N,_行列,L),
        行基本変形(R1,_行列,R2),!.
'行基本変形'(# _行目1 # _行目2,_行列,X) :-
        list_nth(_行目1,_行列,_行1),
        list_nth(_行目2,_行列,_行2),
        ならびの位置指定置換(_行目2,_行1,_行列,_行列1),
        ならびの位置指定置換(_行目1,_行2,_行列1,X),!.
行基本変形(_乗数1 # _行目1 + _乗数2 # _行目2,_行列,X) :-
        !,
        list_nth(_行目2,_行列,_行2),
        list_nth(_行目1,_行列,_行1),
        findall(U,(member(A,_行1) , U is A * _乗数1),_乗算された行1),
        findall(W,(member(B,_行2) , W is B * _乗数2),_乗算された行2),
        型推論加算([_乗算された行1,_乗算された行2],_加算された行),
        replace_nth(1,_行目1,_加算された行,_行列,X),!.
行基本変形(_乗数1 # _行目1 - _乗数2 # _行目2,_行列,X) :-
        !,
        _乗数3 is -1 * _乗数2,
        行基本変形(_乗数1 # _行目1 + _乗数3 #  _行目2,_行列,X),!.
行基本変形( # _行目1 + _乗数 # _行目2,_行列,X) :-
        !,
        list_nth(_行目2,_行列,_行2),
        list_nth(_行目1,_行列,_行1),
        findall(U,(member(A,_行2) , U is A * _乗数),_乗算された行),
        型推論加算([_乗算された行,_行1],_加算された行),
        replace_nth(1,_行目1,_加算された行,_行列,X),!.
行基本変形( # _行目1 - _乗数 # _行目2,_行列,X) :-
        !,
        _乗数2 is -1 * _乗数,
        行基本変形( # _行目1 + _乗数2 * _行目2,_行列,X),!.
行基本変形( # _行目1 + _乗数 / _除数 * _行目2,_行列,X) :-
        integer(_除数),
        !,
        list_nth(_行目2,_行列,_行2),
        list_nth(_行目1,_行列,_行1),
        findall(U,(member(A,_行2) , U is A * _乗数 // _除数),_除算された行),
        型推論加算([_行1,_除算された行],_加算された行),
        replace_nth(1,_行目1,_加算された行,_行列,X),!.
行基本変形( # _行目1 + _乗数 / _除数 # _行目2,_行列,X) :-
        \+(integer(_除数)),
        !,
        list_nth(_行目2,_行列,_行2),
        list_nth(_行目1,_行列,_行1),
        findall(U,(member(A,_行2) , U is A * _乗数 / _除数),_除算された行),
        型推論加算([_行1,_除算された行],_加算された行),
        replace_nth(1,_行目1,_加算された行,_行列,X),!.
行基本変形( # _行目1 - _乗数 / _除数 # _行目2,_行列,X) :-
        !,
        _除数2 is -1 * _除数,
        行基本変形( # _行目1 + _乗数 / _除数2 * _行目2,_行列,X),!.
行基本変形(_乗数 / _除数 # _行目,_行列,X) :-
        integer(_除数),
        !,
        list_nth(_行目,_行列,_行1),
        findall(X,(member(A,_行1) , X is A * _乗数 // _除数),_行2),
        replace_nth(1,_行目,_行2,_行列,X),!.
行基本変形(_乗数 / _除数 # _行目,_行列,X) :-
        \+(integer(_除数)),
        !,
        list_nth(_行目,_行列,_行1),
        findall(X,(member(A,_行1) , X is A * _乗数 / _除数),_行2),
        replace_nth(1,_行目,_行2,_行列,X),!.
行基本変形(_乗数 # _行目,_行列,X) :-
        !,
        list_nth(_行目,_行列,_行1),
        findall(X,(member(A,_行1) , X is A * _乗数),_行2),
        replace_nth(1,_行目,_行2,_行列,X),!.

% *** user: 行基本変形 / 5 ***
行基本変形(*,_乗数,_行目,_行列,X) :-
        行基本変形(*,_乗数,1,_行目,_行列,X).

% *** user: 行基本変形 / 6 ***
行基本変形(*,_乗数,_行目,_行目,[_行1|R1],[_行2|R1]) :-
        findall(X,(member(A,_行1) , X is A * _乗数),_行2) .
行基本変形(*,_乗数,M,_行目,[_行|R1],[_行|R2]) :-
        M2 is M + 1,
        行基本変形(*,_乗数,M2,_行目,R1,R2).

% *** user: 正方行列の行列式の値 / 2 ***
正方行列の行列式の値(_正方行列,_行列式の値) :-
        ガウス行列に変形(_正方行列,X,Y),
        '行列式|C|の値'(X,Z1),
        ならびの積(Y,Z2),
        _行列式の値 is Z1 // Z2.

% *** user: ならびの積 / 2 ***
ならびの積([A],A) :- !.
ならびの積([A|R],X) :-
        ならびの積(R,Y),
        X is A * Y.

% *** user: '行列式|C|の値' / 2 ***
'行列式|C|の値'(_行列,_値) :-
        length(_行列,Len),
        findall(U,(for(1,N,Len) , list_nth(N,_行列,_行) , list_nth(N,_行,U)),L),
        ならびの積(L,_値).

要素がゼロ以外に出会うまで([A|R],[],[A|R]) :-
        \+((A = 0;A=0.0)),!.
要素がゼロ以外に出会うまで([0|R],[0|R1],R2) :-
        要素がゼロ以外に出会うまで(R,R1,R2).
要素がゼロ以外に出会うまで([0.0|R],[0.0|R1],R2) :-
        要素がゼロ以外に出会うまで(R,R1,R2).

最初に現れる0ではない要素・位置(Nth,[X|_],Nth,X) :- \+((X = 0;X=0.0)),!.
最初に現れる0ではない要素・位置(Mth,[0|R],Nth,X) :-
        Mth_2 is Mth + 1,
        最初に現れる0ではない要素・位置(Mth_2,R,Nth,X).
最初に現れる0ではない要素・位置(Mth,[0.0|R],Nth,X) :-
        Mth_2 is Mth + 1,
        最初に現れる0ではない要素・位置(Mth_2,R,Nth,X).

% *** user: ならびの位置指定置換 / 4 ***
ならびの位置指定置換(1,A,[_|R],[A|R]) :-
        !.
ならびの位置指定置換(N,A,[B|R1],[B|R2]) :-
        N1 is N - 1,
        ならびの位置指定置換(N1,A,R1,R2) .

最小公倍数(N1 * A,B,C) :-
        integer(B),
        最小公倍数(A,B,C),
        N1 is C // A,!.
最小公倍数(A,N2 * B,C) :-
        integer(A),
        最小公倍数(A,B,C),
        N2 is C // B,!.
最小公倍数(N1 * A,N2 * B,C) :-
        最小公倍数(A,B,C),
        N1 is C // A,
        N2 is C // B,!.
最小公倍数(A,B,X) :-
        integer(A),
        integer(B),
        最大公約数をユークリッドの互除法で求める(A,B,C),
        X is A * B // C.

最小公倍数([N1 * A|R],X) :-
         findall(U,member(_ * U,[N1 * A|R]),L1),
         最小公倍数(L1,X),
         最小公倍数_2([N1 * A|R],X),!.
最小公倍数([A,B],X) :-
        最小公倍数(A,B,X),!.
最小公倍数([A|R],X) :-
        最小公倍数(R,B),
        最小公倍数(A,B,X),!.

最小公倍数_2([],_) :- !.
最小公倍数_2([N * A|R],Y) :-
        N is Y // A,
        最小公倍数_2(R,Y),!.
最小公倍数_2([A|R],Y) :-
        integer(A),
        最小公倍数_2(R,Y),!.

最大公約数をユークリッドの互除法で求める(M,N,N) :-
        0 is M mod N,!.
最大公約数をユークリッドの互除法で求める(M,N,X) :-
        Mod is M mod N,
        最大公約数をユークリッドの互除法で求める(N,Mod,X).