オフラインどう書く参考問題(第14回)

問題はこちら->http://nabetani.sakura.ne.jp/hena/ord14crosscircle/
考え方は、新しく弦を引くときにできる交点は、
各文字ごとの弦の下の点の数と上の点の数の積を合計したものになるということです。
これは素朴な考え方と思いますが、実装はメモリを無駄に使っているでしょうか。
具体的には、文字の入力ごとに、headが文字に対応した数で、
その後0-9,A-Z,a-zのそれまでの出現回数を示す62個の要素を持ったリストを作ります。
それとともに、弦が作れれば、そのリストから、すべての弦について、
弦の下の点の数（弦のもう一方の端点をヘッドとするリストのそれぞれの値）と、
弦の上の数（最新のリストのそれぞれの値から先ほどの数を引いたもの）の積を求め、
合計を計算します。
弦を作ったのと同じ文字間では弦の下の点の数が実際より1多くなりますので補正します。

```Prolog
%swi-Prolog  version 7.4.2
%start.
%:-initialization(start).   %for ideone

cal(M,N,Z):-Z is (N-M)*M.

calc(_,L1,L2,N):-maplist(cal,L1,L2,L3),foldl(plus,L3,0,N).

sol([],_,_,N,N).
sol([[H|_]|T],Y,X,N,NR):-H=\=X,!,sol(T,Y,X,N,NR).
sol([[_|L]|T],Y,X,N0,NR):-calc(_,L,Y,N1),N is N0+N1,sol(T,Y,X,N,NR).

solve([],_,N,N).
solve([X|T],L,N0,NR):-
     last(L,[_|YT]),sol(L,YT,X,0,R),nth1(X,YT,V,YT1),N is R+N0-(V*(V-1) div 2),  %X同士の補正
     V1 is V+1,nth1(X,L1,V1,YT1),append(L,[[X|L1]],L2),solve(T,L2,N,NR).
      
solve([C|S],N):-
     LN is C-1,length(L1,LN),maplist(=(0),L1),LN1 is 62-C,length(L2,LN1),maplist(=(0),L2),
     append(L1,[1|L2],L),solve(S,[[C|L]],0,N).
      
start:-str(S),split_string(S,"\s\n","\s",L),go(L),!.

go([]):-!.
go([_,B,C|T]):-
       atom_chars(B,L),maplist(cha,L,L1),solve(L1,N),number_chars(N1,C),
       (N==N1,Str="good ";Str=" bad "),write(" "),write(Str),writeln(N),go(T).
       
cha(C,N):-atom_codes(C,N1),N1<58,!,N is N1 - 47.
cha(C,N):-atom_codes(C,N1),N1<91,!,N is N1 - 54.
cha(C,N):-atom_codes(C,N1),N is N1 - 60.
      
str("0    aabbca1bcb         14
1       111ZZZ  0
2       v       0
3       ww      0
4       xxx     0
5       yyyy    1
6       zzzzz   5
7       abcdef  0
8       abcaef  0
9       abbaee  0
10      abcacb  2
11      abcabc  3
12      abcdabcd        6
13      abcadeabcade    23
14      abcdeedcba      0
15      abcdeaedcba     8
16      abcdeaedcbad    16
17      QQQQXXXX        2
18      QwQQmQXmXXwX    14
19      111222333       0
20      aaAAaA  4
21      121232313       12
22      1ab1b   1
23      abcdefbadcfe    12
24      abxcdefbadcfex  14
25      dtnwtkt         0
26      mvubvpp         0
27      moggscd         0
28      kzkjzpkw        2
29      fbifybre        1
30      rrrfjryki       1
31      wrbbdwsdwtx     2
32      vvucugvxbvgx    9
33      ojkjzyasjwbfjj  5
34      ggffyuxnkyypifff        5
35      vcgtcqlwrepwvkkogl      4
36      xeqtmmgppwcjpcisogxbs   4
37      lukltpeucrqfvcupnpxwmoj         6
38      zpzswlkkoqwwndwpfdpkhtzgtn      31
39      bkfeflagfvluelududqjcvfyvytfw   45
40      rvqbhfmcjjqlpqzulzerxgyowiwrfkmhw       26
41      qyxvpdtoeexbqsethwjwmqszcxxjnsdoeaet    144
42      rjmsgmswhcolmpbhmpncziymydyalrcnevsrespj        133
43      oxetnyjzjbysnwktfwzndlejfndsqeetsnjvsicyjehd    395
44      wzvddnddzogywcqxbyvagbzmsmtcmrrlbnebmvhaemjouaqim       219
45      karhphxcxqgsyorhusbumbqzocuzvnwzwcpxgsksrviihxrgsrhji   461
46      oxgbononhqdxzmkysgijwvxljpaazmgkurkpffeuwywwuyxhyfkicgyzyc      441
47      sdgsrddwsrwqthhdvhrjhgtxwgurgyiygtktgtughtogzaqmcafkljgpniddsvb         1077
48      qemhecchkgzhxmdcsltwhpoyhkapckkkzosmklcvzkiiucrvzzznmhjfcdumuflavxik    1711
49      ffqmsirwpxrzfkbvmmfeptkbhnrvfcywthkwkbycmayhhkgvuyecbwwofwthlmzruphrcujwhr      2440").
```
上のプログラムでは、無駄に大きなリストを使っているようですので、別の解法を考えました。
基本的には上のプロフラムと同じです。
弦を作る文字の前の文字列と間に挟まれた文字列をリストの形でcol/5で取り出し、
両方の文字列に含まれるそれぞれの文字に関して、
弦の上の文字数と下の文字数をcal/3でかけて足し合わせます。
最後にすべての弦に関して、solveのfoldlで足し合わせます。
solve/2のfindallのなかみがとても長くなっています。
上のプログラムに比べると遅いです。

```prolog
col(L,N11,N21,R1,R2):-col1(L,N11,[],[_|T],R1),col1(T,N21,[],_,R2).

col1(L1,0,L2,L1,L2).
col1([H|T],N,L2,R1,R2):-N1 is N-1,col1(T,N1,[H|L2],R1,R2).

cal(R1,R2,V):-
     findall(V3,(sort(R1,L),member(X,L),include(=(X),R1,L1),include(=(X),R2,L2),
     length(L1,V1),length(L2,V2),V3 is V1*V2),V4),foldl(plus,V4,0,V).
     
find(L,N11,N21):-nth1(N2,L,X),N2>3,nth1(N1,L,X),N1<N2-1,
     N11 is N1-1,N21 is N2-N11-2.

solve(L,Sum):-
     findall(Sum1,(find(L,N11,N21),col(L,N11,N21,R1,R2),cal(R1,R2,Sum1)),SL),
     foldl(plus,SL,0,Sum).
     
start:-str(S),split_string(S,"\s\n","\s",L),go(L),!.

go([]):-!.
go([_,B,C|T]):-
     atom_chars(B,L),maplist(cha,L,L1),solve(L1,N),number_chars(N1,C),
     (N==N1,Str="good ";Str=" bad "),write(" "),write(Str),writeln(N),go(T).
       
cha(C,N):-atom_codes(C,N1),N1<58,!,N is N1 - 47.
cha(C,N):-atom_codes(C,N1),N1<91,!,N is N1 - 54.
cha(C,N):-atom_codes(C,N1),N is N1 - 60.
```